home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Programmer'…arterly (Limited Edition) / Visual_Basic_Programmers_Journal_VB-CD_Quarterly_Limited_Edition_1995.iso / code / ch27code / frmmain.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-07-30  |  14.6 KB  |  393 lines
  1. VERSION 4.00
  2. Begin VB.Form frmMain 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "Using Other OLE Objects Demonstration"
  5.    ClientHeight    =   3990
  6.    ClientLeft      =   1020
  7.    ClientTop       =   1755
  8.    ClientWidth     =   5370
  9.    Height          =   4680
  10.    Icon            =   "frmmain.frx":0000
  11.    Left            =   960
  12.    LinkTopic       =   "Form1"
  13.    ScaleHeight     =   3990
  14.    ScaleWidth      =   5370
  15.    Top             =   1125
  16.    Width           =   5490
  17.    Begin VB.PictureBox Toolbar 
  18.       Align           =   1  'Align Top
  19.       Appearance      =   0  'Flat
  20.       BackColor       =   &H00C0C0C0&
  21.       ForeColor       =   &H80000008&
  22.       Height          =   465
  23.       Left            =   0
  24.       Negotiate       =   -1  'True
  25.       ScaleHeight     =   435
  26.       ScaleWidth      =   5340
  27.       TabIndex        =   2
  28.       Top             =   0
  29.       Width           =   5370
  30.       Begin VB.Image imgTools 
  31.          Height          =   330
  32.          Index           =   11
  33.          Left            =   4500
  34.          Picture         =   "frmmain.frx":030A
  35.          Stretch         =   -1  'True
  36.          Top             =   45
  37.          Visible         =   0   'False
  38.          Width           =   360
  39.       End
  40.       Begin VB.Image imgTools 
  41.          Height          =   330
  42.          Index           =   10
  43.          Left            =   1980
  44.          Picture         =   "frmmain.frx":0494
  45.          Stretch         =   -1  'True
  46.          Tag             =   "Terminates this application"
  47.          Top             =   45
  48.          Width           =   360
  49.       End
  50.       Begin VB.Image imgTools 
  51.          Height          =   330
  52.          Index           =   9
  53.          Left            =   4140
  54.          Picture         =   "frmmain.frx":061E
  55.          Stretch         =   -1  'True
  56.          Top             =   45
  57.          Visible         =   0   'False
  58.          Width           =   360
  59.       End
  60.       Begin VB.Image imgTools 
  61.          Height          =   330
  62.          Index           =   8
  63.          Left            =   1530
  64.          Picture         =   "frmmain.frx":07A8
  65.          Stretch         =   -1  'True
  66.          Tag             =   "Opens a Video for Windows 1.1 OLE Example"
  67.          Top             =   45
  68.          Width           =   360
  69.       End
  70.       Begin VB.Image imgTools 
  71.          Height          =   330
  72.          Index           =   7
  73.          Left            =   3780
  74.          Picture         =   "frmmain.frx":0932
  75.          Stretch         =   -1  'True
  76.          Top             =   45
  77.          Visible         =   0   'False
  78.          Width           =   360
  79.       End
  80.       Begin VB.Image imgTools 
  81.          Height          =   330
  82.          Index           =   6
  83.          Left            =   1170
  84.          Picture         =   "frmmain.frx":0ABC
  85.          Stretch         =   -1  'True
  86.          Tag             =   "Opens a Sound Recorder Example"
  87.          Top             =   45
  88.          Width           =   360
  89.       End
  90.       Begin VB.Image imgTools 
  91.          Height          =   330
  92.          Index           =   5
  93.          Left            =   3420
  94.          Picture         =   "frmmain.frx":0C46
  95.          Stretch         =   -1  'True
  96.          Top             =   45
  97.          Visible         =   0   'False
  98.          Width           =   360
  99.       End
  100.       Begin VB.Image imgTools 
  101.          Height          =   330
  102.          Index           =   4
  103.          Left            =   810
  104.          Picture         =   "frmmain.frx":0DD0
  105.          Stretch         =   -1  'True
  106.          Tag             =   "Opens a Project 4.0 Example"
  107.          Top             =   45
  108.          Width           =   360
  109.       End
  110.       Begin VB.Image imgTools 
  111.          Height          =   330
  112.          Index           =   3
  113.          Left            =   3060
  114.          Picture         =   "frmmain.frx":0F5A
  115.          Stretch         =   -1  'True
  116.          Top             =   45
  117.          Visible         =   0   'False
  118.          Width           =   360
  119.       End
  120.       Begin VB.Image imgTools 
  121.          Height          =   330
  122.          Index           =   2
  123.          Left            =   450
  124.          Picture         =   "frmmain.frx":10E4
  125.          Stretch         =   -1  'True
  126.          Tag             =   "Opens a PowerPoint 4.0 Example"
  127.          Top             =   45
  128.          Width           =   360
  129.       End
  130.       Begin VB.Image imgTools 
  131.          Height          =   330
  132.          Index           =   1
  133.          Left            =   2700
  134.          Picture         =   "frmmain.frx":126E
  135.          Stretch         =   -1  'True
  136.          Top             =   45
  137.          Visible         =   0   'False
  138.          Width           =   360
  139.       End
  140.       Begin VB.Image imgTools 
  141.          Height          =   330
  142.          Index           =   0
  143.          Left            =   90
  144.          Picture         =   "frmmain.frx":13F8
  145.          Stretch         =   -1  'True
  146.          Tag             =   "Opens a Paintbrush Example"
  147.          Top             =   45
  148.          Width           =   360
  149.       End
  150.       Begin VB.Image imgHold 
  151.          Height          =   315
  152.          Left            =   5040
  153.          Top             =   45
  154.          Visible         =   0   'False
  155.          Width           =   360
  156.       End
  157.    End
  158.    Begin VB.PictureBox StatusBar 
  159.       Align           =   2  'Align Bottom
  160.       Appearance      =   0  'Flat
  161.       BackColor       =   &H00C0C0C0&
  162.       ForeColor       =   &H80000008&
  163.       Height          =   420
  164.       Left            =   0
  165.       ScaleHeight     =   390
  166.       ScaleWidth      =   5340
  167.       TabIndex        =   0
  168.       Top             =   3570
  169.       Width           =   5370
  170.       Begin VB.Label lblStatus 
  171.          BackStyle       =   0  'Transparent
  172.          Caption         =   "Ready"
  173.          Height          =   240
  174.          Left            =   90
  175.          TabIndex        =   1
  176.          Top             =   90
  177.          Width           =   5505
  178.       End
  179.    End
  180.    Begin VB.Menu mnuFile 
  181.       Caption         =   "&File"
  182.       Begin VB.Menu mnuFileItems 
  183.          Caption         =   "E&xit"
  184.          Index           =   1
  185.       End
  186.    End
  187.    Begin VB.Menu mnuView 
  188.       Caption         =   "&View"
  189.       Begin VB.Menu mnuViewItems 
  190.          Caption         =   "&Paintbrush 3.1"
  191.          Index           =   1
  192.          Shortcut        =   ^P
  193.       End
  194.       Begin VB.Menu mnuViewItems 
  195.          Caption         =   "Po&werPoint 4.0"
  196.          Index           =   2
  197.          Shortcut        =   ^W
  198.       End
  199.       Begin VB.Menu mnuViewItems 
  200.          Caption         =   "Pro&ject 4.0"
  201.          Index           =   3
  202.          Shortcut        =   ^J
  203.       End
  204.       Begin VB.Menu mnuViewItems 
  205.          Caption         =   "&Sound Recorder 3.1"
  206.          Index           =   4
  207.          Shortcut        =   ^S
  208.       End
  209.       Begin VB.Menu mnuViewItems 
  210.          Caption         =   "&Video for Windows 1.1"
  211.          Index           =   5
  212.          Shortcut        =   ^V
  213.       End
  214.    End
  215. Attribute VB_Name = "frmMain"
  216. Attribute VB_Creatable = False
  217. Attribute VB_Exposed = False
  218. '*********************************************************************
  219. ' FRMMAIN.FRM: This is the main interface for the application that
  220. '              "looks" like a MDI Parent, but it's actually a normal
  221. '              VB form.
  222. '*********************************************************************
  223. Option Explicit
  224. '*********************************************************************
  225. ' Maximize the form to fit the screen.
  226. '*********************************************************************
  227. Private Sub Form_Load()
  228.     BackColor = vb3DFace
  229.     Toolbar.BackColor = vb3DFace
  230.     StatusBar.BackColor = vb3DFace
  231.     WindowState = 2
  232. End Sub
  233. '*********************************************************************
  234. ' Reset the status bar to Ready.
  235. '*********************************************************************
  236. Private Sub Form_MouseMove(Button%, Shift%, x!, y!)
  237.     UpdateStatus lblStatus
  238. End Sub
  239. '*********************************************************************
  240. ' Prevent the user from resizing the form.
  241. '*********************************************************************
  242. Private Sub Form_Resize()
  243.     If WindowState = 0 Then Form_Load
  244. End Sub
  245. '*********************************************************************
  246. ' Unload Everything.
  247. '*********************************************************************
  248. Private Sub Form_Unload(Cancel As Integer)
  249.     End
  250. End Sub
  251. '*********************************************************************
  252. ' Handle File Exit.
  253. '*********************************************************************
  254. Private Sub mnuFileItems_Click(Index As Integer)
  255.     Unload Me
  256. End Sub
  257. '*********************************************************************
  258. ' Handle View Submenu.
  259. '*********************************************************************
  260. Private Sub mnuViewItems_Click(Index As Integer)
  261.     With frmObject
  262.         Select Case Index
  263.             Case 1
  264.                 .Display .olePaint
  265.             Case 2
  266.                 .Display .olePowerPoint
  267.             Case 3 '
  268.                 .Display .oleProject
  269.             Case 4
  270.                 .Display .oleSound
  271.             Case 5
  272.                 On Error Resume Next
  273.                 .oleVideo.CreateEmbed App.Path & "\sample.avi"
  274.                 If Err Then
  275.                     MsgBox "Err = " & Format(Err) & ": " & Error, vbCritical
  276.                     Unload frmObject
  277.                 End If
  278.                 .Display .oleVideo
  279.         End Select
  280.     End With
  281. End Sub
  282. '*********************************************************************
  283. ' Saves the button image in imgHold, and inserts the down picture.
  284. '*********************************************************************
  285. Private Sub imgTools_MouseDown(Index%, Button%, Shift%, x!, y!)
  286.     imgHold.Picture = imgTools(Index).Picture
  287.     imgTools(Index).Picture = imgTools(Index + 1).Picture
  288. End Sub
  289. '*********************************************************************
  290. ' Updates the status bar.
  291. '*********************************************************************
  292. Private Sub imgTools_MouseMove(Index%, Button%, Shift%, x!, y!)
  293.     UpdateStatus lblStatus, imgTools(Index).Tag
  294. End Sub
  295. '*********************************************************************
  296. ' Restores the graphic, and processes toolbar clicks.
  297. '*********************************************************************
  298. Private Sub imgTools_MouseUp(Index%, Button%, Shift%, x!, y!)
  299.     '*****************************************************************
  300.     ' Restore the toolbar picture.
  301.     '*****************************************************************
  302.     imgTools(Index).Picture = imgHold.Picture
  303.     '*****************************************************************
  304.     ' Execute the appropriate toolbar action.
  305.     '*****************************************************************
  306.     Select Case Index
  307.         Case 0 'Paintbrush
  308.             mnuViewItems_Click 1
  309.         Case 2 'PowerPoint
  310.             mnuViewItems_Click 2
  311.         Case 4 'Project
  312.             mnuViewItems_Click 3
  313.         Case 6 'Sound
  314.             mnuViewItems_Click 4
  315.         Case 8 'Video for Windows
  316.             mnuViewItems_Click 5
  317.         Case 10 'Exit
  318.             Unload Me
  319.     End Select
  320. End Sub
  321. '*********************************************************************
  322. ' Adds a 3D effect to a picture box.
  323. '*********************************************************************
  324. Private Sub HighlightBar(Bar As PictureBox)
  325.     Bar.Line (0, 5)-(Bar.ScaleWidth, 5), vb3DHighlight
  326.     Bar.Line (0, Bar.ScaleHeight - 15)-(Bar.ScaleWidth, _
  327.                         Bar.ScaleHeight - 15), vb3DShadow
  328. End Sub
  329. '*********************************************************************
  330. ' Adds a 3D border around a control.
  331. '*********************************************************************
  332. Private Sub Highlight(Object As Control)
  333. Const HORIZONTAL_OFFSET = 50
  334. Const VERTICAL_OFFSET = 70
  335.     '*****************************************************************
  336.     ' Top
  337.     '*****************************************************************
  338.     StatusBar.Line (Object.Left - HORIZONTAL_OFFSET, _
  339.                    Object.Top - HORIZONTAL_OFFSET)- _
  340.                    (Object.Width, _
  341.                    Object.Top - HORIZONTAL_OFFSET), _
  342.                    vb3DShadow
  343.     '*****************************************************************
  344.     ' Left
  345.     '*****************************************************************
  346.     StatusBar.Line (Object.Left - HORIZONTAL_OFFSET, _
  347.                    Object.Top - HORIZONTAL_OFFSET)- _
  348.                    (Object.Left - HORIZONTAL_OFFSET, _
  349.                    Object.Height + VERTICAL_OFFSET), _
  350.                    vb3DShadow
  351.     '*****************************************************************
  352.     ' Bottom
  353.     '*****************************************************************
  354.     StatusBar.Line (Object.Left - HORIZONTAL_OFFSET, _
  355.                    Object.Height + VERTICAL_OFFSET)- _
  356.                    (Object.Width, _
  357.                    Object.Height + VERTICAL_OFFSET), _
  358.                    vb3DHighlight
  359.     '*****************************************************************
  360.     ' Right
  361.     '*****************************************************************
  362.     StatusBar.Line (Object.Width, _
  363.                     Object.Top - HORIZONTAL_OFFSET)- _
  364.                    (Object.Width, _
  365.                    Object.Height + VERTICAL_OFFSET + 15), _
  366.                    vb3DHighlight
  367. End Sub
  368. '*********************************************************************
  369. ' Generic update status bar routine.
  370. '*********************************************************************
  371. Public Sub UpdateStatus(StatusBar As Label, Optional StatusText)
  372.     StatusBar = IIf(IsMissing(StatusText), "Ready", StatusText)
  373. End Sub
  374. '*********************************************************************
  375. ' Adds a 3D appearance to the status bar.
  376. '*********************************************************************
  377. Private Sub StatusBar_Paint()
  378.     HighlightBar StatusBar
  379.     Highlight lblStatus
  380. End Sub
  381. '*********************************************************************
  382. ' Reset the StatusBar to Ready.
  383. '*********************************************************************
  384. Private Sub Toolbar_MouseMove(Button%, Shift%, x As Single, y As Single)
  385.     UpdateStatus lblStatus
  386. End Sub
  387. '*********************************************************************
  388. ' Adds a 3D appearance to the toolbar.
  389. '*********************************************************************
  390. Private Sub Toolbar_Paint()
  391.     HighlightBar Toolbar
  392. End Sub
  393.