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 / ch26code / mdiole.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-08-01  |  14.1 KB  |  333 lines
  1. VERSION 4.00
  2. Begin VB.MDIForm mdiOLE 
  3.    BackColor       =   &H00C0C0C0&
  4.    Caption         =   "OLE Container Control Example"
  5.    ClientHeight    =   6150
  6.    ClientLeft      =   285
  7.    ClientTop       =   885
  8.    ClientWidth     =   9030
  9.    Height          =   6840
  10.    Icon            =   "MDIOLE.frx":0000
  11.    Left            =   225
  12.    LinkTopic       =   "MDIForm1"
  13.    Top             =   255
  14.    Width           =   9150
  15.    Begin VB.PictureBox StatusBar 
  16.       Align           =   2  'Align Bottom
  17.       Appearance      =   0  'Flat
  18.       BackColor       =   &H00C0C0C0&
  19.       ForeColor       =   &H80000008&
  20.       Height          =   420
  21.       Left            =   0
  22.       ScaleHeight     =   390
  23.       ScaleWidth      =   9000
  24.       TabIndex        =   1
  25.       Top             =   5730
  26.       Width           =   9030
  27.       Begin VB.Label lblStatus 
  28.          BackStyle       =   0  'Transparent
  29.          Caption         =   "Ready"
  30.          Height          =   240
  31.          Left            =   90
  32.          TabIndex        =   2
  33.          Top             =   90
  34.          Width           =   5505
  35.       End
  36.    End
  37.    Begin VB.PictureBox Toolbar 
  38.       Align           =   1  'Align Top
  39.       Appearance      =   0  'Flat
  40.       BackColor       =   &H00C0C0C0&
  41.       ForeColor       =   &H80000008&
  42.       Height          =   420
  43.       Left            =   0
  44.       Negotiate       =   -1  'True
  45.       ScaleHeight     =   390
  46.       ScaleWidth      =   9000
  47.       TabIndex        =   0
  48.       Top             =   0
  49.       Width           =   9030
  50.       Begin VB.Image imgTools 
  51.          Height          =   330
  52.          Index           =   3
  53.          Left            =   1260
  54.          Picture         =   "MDIOLE.frx":030A
  55.          Top             =   45
  56.          Visible         =   0   'False
  57.          Width           =   360
  58.       End
  59.       Begin VB.Image imgTools 
  60.          Height          =   330
  61.          Index           =   2
  62.          Left            =   495
  63.          Picture         =   "MDIOLE.frx":0494
  64.          Tag             =   "Displays information about the linked OLE object"
  65.          Top             =   45
  66.          Width           =   360
  67.       End
  68.       Begin VB.Image imgHold 
  69.          Height          =   315
  70.          Left            =   3195
  71.          Top             =   45
  72.          Visible         =   0   'False
  73.          Width           =   360
  74.       End
  75.       Begin VB.Image imgTools 
  76.          Height          =   330
  77.          Index           =   1
  78.          Left            =   900
  79.          Picture         =   "MDIOLE.frx":061E
  80.          Top             =   45
  81.          Visible         =   0   'False
  82.          Width           =   360
  83.       End
  84.       Begin VB.Image imgTools 
  85.          Height          =   330
  86.          Index           =   0
  87.          Left            =   90
  88.          Picture         =   "MDIOLE.frx":07A8
  89.          Tag             =   "Terminates this application"
  90.          Top             =   45
  91.          Width           =   360
  92.       End
  93.    End
  94.    Begin VB.Menu mnuFile 
  95.       Caption         =   "&File"
  96.       NegotiatePosition=   1  'Left
  97.       Begin VB.Menu mnuFileItems 
  98.          Caption         =   "E&xit"
  99.          Index           =   1
  100.       End
  101.    End
  102. Attribute VB_Name = "mdiOLE"
  103. Attribute VB_Creatable = False
  104. Attribute VB_Exposed = False
  105. '*********************************************************************
  106. ' MDIOLE.FRM - MDI Parent Form.
  107. '*********************************************************************
  108. Option Explicit
  109. Private StartedExcel As Long
  110. '*********************************************************************
  111. ' Saves the button image in imgHold, and inserts the down picture.
  112. '*********************************************************************
  113. Private Sub imgTools_MouseDown(Index As Integer, Button As Integer, _
  114.                            Shift As Integer, X As Single, Y As Single)
  115.     imgHold.Picture = imgTools(Index).Picture
  116.     imgTools(Index).Picture = imgTools(Index + 1).Picture
  117. End Sub
  118. '*********************************************************************
  119. ' Updates the status bar.
  120. '*********************************************************************
  121. Private Sub imgTools_MouseMove(Index As Integer, Button As Integer, _
  122.                            Shift As Integer, X As Single, Y As Single)
  123.     UpdateStatus lblStatus, imgTools(Index).Tag
  124. End Sub
  125. '*********************************************************************
  126. ' Restores the graphic, and processes toolbar clicks.
  127. '*********************************************************************
  128. Private Sub imgTools_MouseUp(Index As Integer, Button As Integer, _
  129.                          Shift As Integer, X As Single, Y As Single)
  130.     '*****************************************************************
  131.     ' Restore the toolbar picture.
  132.     '*****************************************************************
  133.     imgTools(Index).Picture = imgHold.Picture
  134.     '*****************************************************************
  135.     ' Execute the appropriate toolbar action.
  136.     '*****************************************************************
  137. Select Case Index
  138.     Case 0 ' Hand
  139.         Unload Me
  140.     Case 2 ' Question Mark
  141.         '*************************************************************
  142.         ' Bring up the splash form again, because the first OLE
  143.         ' Automation call will require Excel to be started. After
  144.         ' it is started, any subsequent calls will be peformed
  145.         ' as fast as they would be in a native Excel macro.
  146.         '*************************************************************
  147.         frmSplash.lblMessage = _
  148.         "Gathering OLE Automation information from Excel...Please Wait!"
  149.         frmSplash.Show
  150.         frmSplash.Refresh
  151.         '*************************************************************
  152.         ' Load the info dialog, and start printing to it.
  153.         '*************************************************************
  154.         Load frmInfo
  155.         '*************************************************************
  156.         ' NOTE: Using the OLE Container's Object property, you can
  157.         '       execute OLE Automation statements on the object in
  158.         '       the control.
  159.         '*************************************************************
  160.         ' Using 2 .Parent properties, allows you to access Excel's
  161.         ' Application object.
  162.         '*************************************************************
  163.         PrintMessage "Application Name:", _
  164.             ActiveForm.Excel(0).Object.Parent.Parent.Name & " " & _
  165.             ActiveForm.Excel(0).Object.Parent.Parent.Version
  166.         
  167.         PrintMessage "Operating System:", _
  168.             ActiveForm.Excel(0).Object.Parent.Parent.OperatingSystem
  169.         
  170.         PrintMessage "Organization Name:", _
  171.             ActiveForm.Excel(0).Object.Parent.Parent.OrganizationName
  172.         '*************************************************************
  173.         ' By default, the Object property points to a Worksheet.
  174.         '*************************************************************
  175.         PrintMessage "Range(""A2""):", _
  176.             ActiveForm.Excel(0).Object.Range("A2")
  177.         '*************************************************************
  178.         ' Using 1 call to Parent, allows you to access Excel's
  179.         ' Workbook object.
  180.         '*************************************************************
  181.         PrintMessage "Read Only:", _
  182.             ActiveForm.Excel(0).Object.Parent.ReadOnly
  183.         
  184.         PrintMessage "Saved:", _
  185.             ActiveForm.Excel(0).Object.Parent.Saved
  186.         
  187.         PrintMessage "Sheet Name:", _
  188.             ActiveForm.Excel(0).Object.Name
  189.         
  190.         PrintMessage "Workbook Author:", _
  191.             ActiveForm.Excel(0).Object.Parent.Author
  192.         
  193.         PrintMessage "Workbook Name:", _
  194.             ActiveForm.Excel(0).Object.Parent.Name
  195.         '*************************************************************
  196.         ' Make sure all activity is complete, before unloading the
  197.         ' the splash.
  198.         '*************************************************************
  199.         DoEvents
  200.         Unload frmSplash
  201.         '*************************************************************
  202.         ' Display the information to the user.
  203.         '*************************************************************
  204.         frmInfo.Show 1
  205. End Select
  206. End Sub
  207. '*********************************************************************
  208. ' Print the formatted string to frmInfo.
  209. '*********************************************************************
  210. Private Sub PrintMessage(Item As String, Result As Variant)
  211. Dim LeftStr As String * 20, RightStr As String * 30
  212.     LeftStr = Item
  213.     RightStr = Result
  214.     frmInfo.Print LeftStr & RightStr
  215. End Sub
  216. '*********************************************************************
  217. ' Prepares the application for use.
  218. '*********************************************************************
  219. Private Sub MDIForm_Load()
  220. Dim XLPath$
  221.     '*****************************************************************
  222.     ' Always use the system defined backcolor.
  223.     '*****************************************************************
  224.     BackColor = vb3DFace
  225.     StatusBar.BackColor = vb3DFace
  226.     Toolbar.BackColor = vb3DFace
  227.     '*****************************************************************
  228.     ' If necessary, start Excel to prevent annoying message boxes.
  229.     '*****************************************************************
  230.     XLPath = GetINI("Microsoft Excel", "cbtlocation", _
  231.              "c:\excel\excelcbt", "excel5.ini")
  232.     XLPath = Left(XLPath, Len(XLPath) - 8) & "excel.exe"
  233.     StartedExcel = StartServer("XLMAIN", XLPath)
  234.     WindowState = 2 'Maximized
  235.     frmExcel.Show
  236.     Arrange vbTileHorizontal
  237. End Sub
  238. '*********************************************************************
  239. ' Updates the status bar with the default text.
  240. '*********************************************************************
  241. Private Sub MDIForm_MouseMove(Button As Integer, Shift As Integer, _
  242.                                             X As Single, Y As Single)
  243.     UpdateStatus lblStatus
  244. End Sub
  245. '*********************************************************************
  246. ' If you had to start Excel, then close it. Otherwise, leave it alone.
  247. '*********************************************************************
  248. Private Sub MDIForm_Unload(Cancel As Integer)
  249.     If StartedExcel <> False Then
  250.         CloseApp StartedExcel
  251.     End If
  252. End Sub
  253. '*********************************************************************
  254. ' Terminates the application.
  255. '*********************************************************************
  256. Private Sub mnuFileItems_Click(Index As Integer)
  257.     Unload Me
  258. End Sub
  259. '*********************************************************************
  260. ' Updates the status bar with the default text.
  261. '*********************************************************************
  262. Private Sub StatusBar_MouseMove(Button As Integer, Shift As Integer, _
  263.                                              X As Single, Y As Single)
  264.     UpdateStatus lblStatus
  265. End Sub
  266. '*********************************************************************
  267. ' Adds a 3D appearance to the status bar.
  268. '*********************************************************************
  269. Private Sub StatusBar_Paint()
  270.     HighlightBar StatusBar
  271.     Highlight lblStatus
  272. End Sub
  273. '*********************************************************************
  274. ' Updates the status bar with the default text.
  275. '*********************************************************************
  276. Private Sub Toolbar_MouseMove(Button As Integer, Shift As Integer, _
  277.                                             X As Single, Y As Single)
  278.     UpdateStatus lblStatus
  279. End Sub
  280. '*********************************************************************
  281. ' Adds a 3D appearance to the toolbar.
  282. '*********************************************************************
  283. Private Sub Toolbar_Paint()
  284.     HighlightBar Toolbar
  285. End Sub
  286. '*********************************************************************
  287. ' Adds a 3D effect to a picture box.
  288. '*********************************************************************
  289. Private Sub HighlightBar(Bar As PictureBox)
  290.     Bar.Line (0, 5)-(Bar.ScaleWidth, 5), vb3DHighlight
  291.     Bar.Line (0, Bar.ScaleHeight - 15)-(Bar.ScaleWidth, _
  292.                         Bar.ScaleHeight - 15), vb3DShadow
  293. End Sub
  294. '*********************************************************************
  295. ' Adds a 3D border around a control.
  296. '*********************************************************************
  297. Private Sub Highlight(Object As Control)
  298. Const HORIZONTAL_OFFSET = 50
  299. Const VERTICAL_OFFSET = 70
  300.     '*****************************************************************
  301.     ' Top
  302.     '*****************************************************************
  303.     StatusBar.Line (Object.Left - HORIZONTAL_OFFSET, _
  304.                    Object.Top - HORIZONTAL_OFFSET)- _
  305.                    (Object.Width, _
  306.                    Object.Top - HORIZONTAL_OFFSET), _
  307.                    vb3DShadow
  308.     '*****************************************************************
  309.     ' Left
  310.     '*****************************************************************
  311.     StatusBar.Line (Object.Left - HORIZONTAL_OFFSET, _
  312.                    Object.Top - HORIZONTAL_OFFSET)- _
  313.                    (Object.Left - HORIZONTAL_OFFSET, _
  314.                    Object.Height + VERTICAL_OFFSET), _
  315.                    vb3DShadow
  316.     '*****************************************************************
  317.     ' Bottom
  318.     '*****************************************************************
  319.     StatusBar.Line (Object.Left - HORIZONTAL_OFFSET, _
  320.                    Object.Height + VERTICAL_OFFSET)- _
  321.                    (Object.Width, _
  322.                    Object.Height + VERTICAL_OFFSET), _
  323.                    vb3DHighlight
  324.     '*****************************************************************
  325.     ' Right
  326.     '*****************************************************************
  327.     StatusBar.Line (Object.Width, _
  328.                     Object.Top - HORIZONTAL_OFFSET)- _
  329.                    (Object.Width, _
  330.                    Object.Height + VERTICAL_OFFSET + 15), _
  331.                    vb3DHighlight
  332. End Sub
  333.