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 / listings / 26lst06.txt < prev    next >
Text File  |  1995-08-01  |  8KB  |  166 lines
  1. '*********************************************************************
  2. ' FRMEXCEL.FRM - MDI Child form with a OLE container control.
  3. '*********************************************************************
  4. Option Explicit
  5. '*********************************************************************
  6. ' The RECT and GetClientRect decs are required for PositionFrame.
  7. '*********************************************************************
  8. #If Win32 Then
  9. Private Type RECT
  10.     rLEFT As Long
  11.     rTOP As Long
  12.     rWIDTH As Long
  13.     rHEIGHT As Long
  14. End Type
  15. Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, _
  16.     lpRect As RECT)
  17. #Else
  18. Private Type RECT
  19.     rLEFT As Integer
  20.     rTOP As Integer
  21.     rWIDTH As Integer
  22.     rHEIGHT As Integer
  23. End Type
  24. Private Declare Sub GetClientRect Lib "User" (ByVal hWnd As Integer, _
  25.     lpRect As RECT)
  26. #End If
  27. '*********************************************************************
  28. ' Gets the client area of a frame, and sizes an object to it.
  29. '*********************************************************************
  30. Private Sub PositionFrame(SourceFrame As Frame, ChildObject As Control)
  31. Dim Client As RECT, X As RECT
  32.     GetClientRect SourceFrame.hWnd, Client
  33.     X.rLEFT = (Client.rLEFT * Screen.TwipsPerPixelX) + 50
  34.     X.rTOP = (Client.rTOP * Screen.TwipsPerPixelY) + 150
  35.     X.rWIDTH = (Client.rWIDTH * Screen.TwipsPerPixelX) - 90
  36.     X.rHEIGHT = (Client.rHEIGHT * Screen.TwipsPerPixelY) - 190
  37.     ScaleMode = vbTwips
  38.     ChildObject.Move X.rLEFT, X.rTOP, X.rWIDTH, X.rHEIGHT
  39.     ScaleMode = vbPixels
  40. End Sub
  41. '*********************************************************************
  42. ' Inializes this form instance. This code is also called everytime
  43. ' a new form is created.
  44. '*********************************************************************
  45. Private Sub Form_Load()
  46.     '*****************************************************************
  47.     ' Establishing links takes a few minutes, so give the user
  48.     ' something to look at.
  49.     '*****************************************************************
  50.     frmSplash.lblMessage = "Establishing links with Excel...Please Wait."
  51.     frmSplash.Show
  52.     frmSplash.Refresh
  53.     '*****************************************************************
  54.     ' Always create your recreate links in case the program has been
  55.     ' moved. In a real program, you should NEVER hardcode your links.
  56.     '*****************************************************************
  57.     Excel(0).CreateLink App.Path & "\" & "SAMPLE.XLS!R1C1:R5C5"
  58.     Excel(1).CreateLink App.Path & "\" & "SAMPLE.XLS!Pie"
  59.     '*****************************************************************
  60.     ' Call DoEvents to process the links, and to prevent the splash
  61.     ' screen from disappearing prematurely.
  62.     '*****************************************************************
  63.     DoEvents
  64.     Unload frmSplash
  65. End Sub
  66. '*********************************************************************
  67. ' Updates the status bar with the default text.
  68. '*********************************************************************
  69. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
  70.                                              X As Single, Y As Single)
  71.     UpdateStatus mdiOLE.lblStatus
  72. End Sub
  73. '*********************************************************************
  74. ' This proceedure controls the tab redrawing to handle switching.
  75. '*********************************************************************
  76. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _
  77.                                             X As Single, Y As Single)
  78. Dim res%
  79.     res = Abs(DrawTabs(Me, X, Y) - 1)
  80.     If res < 2 Then Tabs(res).ZOrder
  81. End Sub
  82. '*********************************************************************
  83. ' Repositon the frames and resize the tabs.
  84. '*********************************************************************
  85. Private Sub Form_Resize()
  86. Dim ActivateTab!
  87.     '*****************************************************************
  88.     ' When the form is resized, the tabs must be rescaled to fit.
  89.     '*****************************************************************
  90.     SetupTabs Me, 2
  91.     '*****************************************************************
  92.     ' Position the OLE Containers to fit inside the frames.
  93.     '*****************************************************************
  94.     PositionFrame Tabs(0), Excel(0)
  95.     PositionFrame Tabs(1), Excel(1)
  96.     '*****************************************************************
  97.     ' SetupTabs will make the first tab active. Determine which
  98.     ' tab should be active, and MouseUp it.
  99.     '*****************************************************************
  100.     ActivateTab = IIf(ActiveIndex = 0, 10, ((ScaleWidth - 2) / 2) + 100)
  101.     Form_MouseUp 0, 0, ActivateTab, 20
  102. End Sub
  103. '*********************************************************************
  104. ' Automatically saves any changes to the data.
  105. '*********************************************************************
  106. Private Sub Form_Unload(Cancel As Integer)
  107.     Excel(0).Object.Parent.RunAutoMacros (xlAutoClose)
  108. End Sub
  109. '*********************************************************************
  110. ' Handles clicks from the File Submenu.
  111. '*********************************************************************
  112. Private Sub mnuFileItems_Click(Index As Integer)
  113.     On Error Resume Next
  114.     Select Case Index
  115.         Case 1 'New
  116.             If ExcelWindows <= MAX_WINDOWS Then
  117.                 ExcelWindows = ExcelWindows + 1
  118.                 '*****************************************************
  119.                 ' Create a new form, and set its caption.
  120.                 '*****************************************************
  121.                 Excels(ExcelWindows - 1).Caption = "Excel -" _
  122.                                                 & Str$(ExcelWindows + 1)
  123.                 '*****************************************************
  124.                 ' Remove the caption from both frames.
  125.                 '*****************************************************
  126.                 Excels(ExcelWindows - 1).Tabs(0) = ""
  127.                 Excels(ExcelWindows - 1).Tabs(1) = ""
  128.             End If
  129.         Case 3 'Exit
  130.             Unload mdiOLE
  131.     End Select
  132. End Sub
  133. '*********************************************************************
  134. ' Handles clicks from the Object Submenu.
  135. '*********************************************************************
  136. Private Sub mnuObjectItems_Click(Index As Integer)
  137.     Select Case Index
  138.         Case 1 'Update Links
  139.             Excel(0).Update
  140.             Excel(1).Update
  141.         Case 2 'Close Object
  142.             Excel(ActiveIndex).Close
  143.     End Select
  144. End Sub
  145. '*********************************************************************
  146. ' Updates the status bar.
  147. '*********************************************************************
  148. Private Sub Excel_MouseMove(Index As Integer, Button As Integer, _
  149.                            Shift As Integer, X As Single, Y As Single)
  150.     UpdateStatus mdiOLE!lblStatus, Excel(Index).Tag
  151. End Sub
  152. '*********************************************************************
  153. ' Handles clicks from the Window Submenu.
  154. '*********************************************************************
  155. Private Sub mnuWindowItems_Click(Index As Integer)
  156.     mdiOLE.Arrange Index - 1
  157. End Sub
  158. '*********************************************************************
  159. ' Set the ActiveIndex. This isn't foolproof, but it works for this
  160. ' demonstration. In the "real world," this wouldn't be enough.
  161. '*********************************************************************
  162. Private Sub Tabs_MouseMove(Index As Integer, Button As Integer, _
  163.                            Shift As Integer, X As Single, Y As Single)
  164.     ActiveIndex = Index
  165. End Sub
  166.