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 / frmexcel.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1995-08-01  |  11.1 KB  |  278 lines
  1. VERSION 4.00
  2. Begin VB.Form frmExcel 
  3.    AutoRedraw      =   -1  'True
  4.    BackColor       =   &H00C0C0C0&
  5.    Caption         =   "Excel"
  6.    ClientHeight    =   4110
  7.    ClientLeft      =   1050
  8.    ClientTop       =   1755
  9.    ClientWidth     =   7590
  10.    Height          =   4800
  11.    Icon            =   "frmexcel.frx":0000
  12.    Left            =   990
  13.    LinkTopic       =   "Form1"
  14.    MDIChild        =   -1  'True
  15.    ScaleHeight     =   4110
  16.    ScaleWidth      =   7590
  17.    Top             =   1125
  18.    Visible         =   0   'False
  19.    Width           =   7710
  20.    Begin VB.Frame Tabs 
  21.       Caption         =   "Chart View"
  22.       Height          =   3705
  23.       Index           =   1
  24.       Left            =   540
  25.       TabIndex        =   2
  26.       Top             =   270
  27.       Width           =   6900
  28.       Begin VB.OLE Excel 
  29.          Class           =   "Excel.Sheet.5"
  30.          Height          =   3345
  31.          Index           =   1
  32.          Left            =   135
  33.          SizeMode        =   1  'Stretch
  34.          SourceDoc       =   "d:\book\submit\chpx4\code\sample.xls"
  35.          TabIndex        =   3
  36.          Tag             =   "Double click to edit this chart in Excel"
  37.          Top             =   270
  38.          Width           =   6675
  39.       End
  40.    End
  41.    Begin VB.Frame Tabs 
  42.       Caption         =   "Data View"
  43.       Height          =   3705
  44.       Index           =   0
  45.       Left            =   45
  46.       TabIndex        =   0
  47.       Top             =   135
  48.       Width           =   6900
  49.       Begin VB.OLE Excel 
  50.          Class           =   "Excel.Sheet.5"
  51.          Height          =   3345
  52.          Index           =   0
  53.          Left            =   90
  54.          SourceDoc       =   "d:\book\submit\chpx4\code\sample.xls"
  55.          TabIndex        =   1
  56.          Tag             =   "Double click to edit this data in Excel"
  57.          Top             =   270
  58.          Width           =   6720
  59.       End
  60.    End
  61.    Begin VB.Menu mnuFile 
  62.       Caption         =   "&File"
  63.       NegotiatePosition=   1  'Left
  64.       Begin VB.Menu mnuFileItems 
  65.          Caption         =   "&New"
  66.          Index           =   1
  67.       End
  68.       Begin VB.Menu mnuFileItems 
  69.          Caption         =   "-"
  70.          Index           =   2
  71.       End
  72.       Begin VB.Menu mnuFileItems 
  73.          Caption         =   "E&xit"
  74.          Index           =   3
  75.       End
  76.    End
  77.    Begin VB.Menu mnuObject 
  78.       Caption         =   "&Object"
  79.       NegotiatePosition=   2  'Middle
  80.       Begin VB.Menu mnuObjectItems 
  81.          Caption         =   "&Update Links"
  82.          Index           =   1
  83.       End
  84.       Begin VB.Menu mnuObjectItems 
  85.          Caption         =   "&Close Object"
  86.          Index           =   2
  87.       End
  88.    End
  89.    Begin VB.Menu mnuWindow 
  90.       Caption         =   "&Window"
  91.       NegotiatePosition=   3  'Right
  92.       WindowList      =   -1  'True
  93.       Begin VB.Menu mnuWindowItems 
  94.          Caption         =   "&Cascade"
  95.          Index           =   1
  96.       End
  97.       Begin VB.Menu mnuWindowItems 
  98.          Caption         =   "Tile &Horizontal"
  99.          Index           =   2
  100.       End
  101.       Begin VB.Menu mnuWindowItems 
  102.          Caption         =   "Tile &Vertical"
  103.          Index           =   3
  104.       End
  105.       Begin VB.Menu mnuWindowItems 
  106.          Caption         =   "&Arrange Icons"
  107.          Index           =   4
  108.       End
  109.    End
  110. Attribute VB_Name = "frmExcel"
  111. Attribute VB_Creatable = False
  112. Attribute VB_Exposed = False
  113. '*********************************************************************
  114. ' FRMEXCEL.FRM - MDI Child form with a OLE container control.
  115. '*********************************************************************
  116. Option Explicit
  117. '*********************************************************************
  118. ' The RECT and GetClientRect decs are required for PositionFrame.
  119. '*********************************************************************
  120. #If Win32 Then
  121. Private Type RECT
  122.     rLEFT As Long
  123.     rTOP As Long
  124.     rWIDTH As Long
  125.     rHEIGHT As Long
  126. End Type
  127. Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, _
  128.     lpRect As RECT)
  129. #Else
  130. Private Type RECT
  131.     rLEFT As Integer
  132.     rTOP As Integer
  133.     rWIDTH As Integer
  134.     rHEIGHT As Integer
  135. End Type
  136. Private Declare Sub GetClientRect Lib "User" (ByVal hWnd As Integer, _
  137.     lpRect As RECT)
  138. #End If
  139. '*********************************************************************
  140. ' Gets the client area of a frame, and sizes an object to it.
  141. '*********************************************************************
  142. Private Sub PositionFrame(SourceFrame As Frame, ChildObject As Control)
  143. Dim Client As RECT, X As RECT
  144.     GetClientRect SourceFrame.hWnd, Client
  145.     X.rLEFT = (Client.rLEFT * Screen.TwipsPerPixelX) + 50
  146.     X.rTOP = (Client.rTOP * Screen.TwipsPerPixelY) + 150
  147.     X.rWIDTH = (Client.rWIDTH * Screen.TwipsPerPixelX) - 90
  148.     X.rHEIGHT = (Client.rHEIGHT * Screen.TwipsPerPixelY) - 190
  149.     ScaleMode = vbTwips
  150.     ChildObject.Move X.rLEFT, X.rTOP, X.rWIDTH, X.rHEIGHT
  151.     ScaleMode = vbPixels
  152. End Sub
  153. '*********************************************************************
  154. ' Inializes this form instance. This code is also called everytime
  155. ' a new form is created.
  156. '*********************************************************************
  157. Private Sub Form_Load()
  158.     '*****************************************************************
  159.     ' Establishing links takes a few minutes, so give the user
  160.     ' something to look at.
  161.     '*****************************************************************
  162.     frmSplash.lblMessage = "Establishing links with Excel...Please Wait."
  163.     frmSplash.Show
  164.     frmSplash.Refresh
  165.     '*****************************************************************
  166.     ' Always create your recreate links in case the program has been
  167.     ' moved. In a real program, you should NEVER hardcode your links.
  168.     '*****************************************************************
  169.     Excel(0).CreateLink App.Path & "\" & "SAMPLE.XLS!R1C1:R5C5"
  170.     Excel(1).CreateLink App.Path & "\" & "SAMPLE.XLS!Pie"
  171.     '*****************************************************************
  172.     ' Call DoEvents to process the links, and to prevent the splash
  173.     ' screen from disappearing prematurely.
  174.     '*****************************************************************
  175.     DoEvents
  176.     Unload frmSplash
  177. End Sub
  178. '*********************************************************************
  179. ' Updates the status bar with the default text.
  180. '*********************************************************************
  181. Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
  182.                                              X As Single, Y As Single)
  183.     UpdateStatus mdiOLE.lblStatus
  184. End Sub
  185. '*********************************************************************
  186. ' This proceedure controls the tab redrawing to handle switching.
  187. '*********************************************************************
  188. Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _
  189.                                             X As Single, Y As Single)
  190. Dim res%
  191.     res = Abs(DrawTabs(Me, X, Y) - 1)
  192.     If res < 2 Then Tabs(res).ZOrder
  193. End Sub
  194. '*********************************************************************
  195. ' Repositon the frames and resize the tabs.
  196. '*********************************************************************
  197. Private Sub Form_Resize()
  198. Dim ActivateTab!
  199.     '*****************************************************************
  200.     ' When the form is resized, the tabs must be rescaled to fit.
  201.     '*****************************************************************
  202.     SetupTabs Me, 2
  203.     '*****************************************************************
  204.     ' Position the OLE Containers to fit inside the frames.
  205.     '*****************************************************************
  206.     PositionFrame Tabs(0), Excel(0)
  207.     PositionFrame Tabs(1), Excel(1)
  208.     '*****************************************************************
  209.     ' SetupTabs will make the first tab active. Determine which
  210.     ' tab should be active, and MouseUp it.
  211.     '*****************************************************************
  212.     ActivateTab = IIf(ActiveIndex = 0, 10, ((ScaleWidth - 2) / 2) + 100)
  213.     Form_MouseUp 0, 0, ActivateTab, 20
  214. End Sub
  215. '*********************************************************************
  216. ' Automatically saves any changes to the data.
  217. '*********************************************************************
  218. Private Sub Form_Unload(Cancel As Integer)
  219.     Excel(0).Object.Parent.RunAutoMacros (xlAutoClose)
  220. End Sub
  221. '*********************************************************************
  222. ' Handles clicks from the File Submenu.
  223. '*********************************************************************
  224. Private Sub mnuFileItems_Click(Index As Integer)
  225.     On Error Resume Next
  226.     Select Case Index
  227.         Case 1 'New
  228.             If ExcelWindows <= MAX_WINDOWS Then
  229.                 ExcelWindows = ExcelWindows + 1
  230.                 '*****************************************************
  231.                 ' Create a new form, and set its caption.
  232.                 '*****************************************************
  233.                 Excels(ExcelWindows - 1).Caption = "Excel -" _
  234.                                                 & Str$(ExcelWindows + 1)
  235.                 '*****************************************************
  236.                 ' Remove the caption from both frames.
  237.                 '*****************************************************
  238.                 Excels(ExcelWindows - 1).Tabs(0) = ""
  239.                 Excels(ExcelWindows - 1).Tabs(1) = ""
  240.             End If
  241.         Case 3 'Exit
  242.             Unload mdiOLE
  243.     End Select
  244. End Sub
  245. '*********************************************************************
  246. ' Handles clicks from the Object Submenu.
  247. '*********************************************************************
  248. Private Sub mnuObjectItems_Click(Index As Integer)
  249.     Select Case Index
  250.         Case 1 'Update Links
  251.             Excel(0).Update
  252.             Excel(1).Update
  253.         Case 2 'Close Object
  254.             Excel(ActiveIndex).Close
  255.     End Select
  256. End Sub
  257. '*********************************************************************
  258. ' Updates the status bar.
  259. '*********************************************************************
  260. Private Sub Excel_MouseMove(Index As Integer, Button As Integer, _
  261.                            Shift As Integer, X As Single, Y As Single)
  262.     UpdateStatus mdiOLE!lblStatus, Excel(Index).Tag
  263. End Sub
  264. '*********************************************************************
  265. ' Handles clicks from the Window Submenu.
  266. '*********************************************************************
  267. Private Sub mnuWindowItems_Click(Index As Integer)
  268.     mdiOLE.Arrange Index - 1
  269. End Sub
  270. '*********************************************************************
  271. ' Set the ActiveIndex. This isn't foolproof, but it works for this
  272. ' demonstration. In the "real world," this wouldn't be enough.
  273. '*********************************************************************
  274. Private Sub Tabs_MouseMove(Index As Integer, Button As Integer, _
  275.                            Shift As Integer, X As Single, Y As Single)
  276.     ActiveIndex = Index
  277. End Sub
  278.