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 >
Wrap
Visual Basic Form
|
1995-08-01
|
11KB
|
278 lines
VERSION 4.00
Begin VB.Form frmExcel
AutoRedraw = -1 'True
BackColor = &H00C0C0C0&
Caption = "Excel"
ClientHeight = 4110
ClientLeft = 1050
ClientTop = 1755
ClientWidth = 7590
Height = 4800
Icon = "frmexcel.frx":0000
Left = 990
LinkTopic = "Form1"
MDIChild = -1 'True
ScaleHeight = 4110
ScaleWidth = 7590
Top = 1125
Visible = 0 'False
Width = 7710
Begin VB.Frame Tabs
Caption = "Chart View"
Height = 3705
Index = 1
Left = 540
TabIndex = 2
Top = 270
Width = 6900
Begin VB.OLE Excel
Class = "Excel.Sheet.5"
Height = 3345
Index = 1
Left = 135
SizeMode = 1 'Stretch
SourceDoc = "d:\book\submit\chpx4\code\sample.xls"
TabIndex = 3
Tag = "Double click to edit this chart in Excel"
Top = 270
Width = 6675
End
End
Begin VB.Frame Tabs
Caption = "Data View"
Height = 3705
Index = 0
Left = 45
TabIndex = 0
Top = 135
Width = 6900
Begin VB.OLE Excel
Class = "Excel.Sheet.5"
Height = 3345
Index = 0
Left = 90
SourceDoc = "d:\book\submit\chpx4\code\sample.xls"
TabIndex = 1
Tag = "Double click to edit this data in Excel"
Top = 270
Width = 6720
End
End
Begin VB.Menu mnuFile
Caption = "&File"
NegotiatePosition= 1 'Left
Begin VB.Menu mnuFileItems
Caption = "&New"
Index = 1
End
Begin VB.Menu mnuFileItems
Caption = "-"
Index = 2
End
Begin VB.Menu mnuFileItems
Caption = "E&xit"
Index = 3
End
End
Begin VB.Menu mnuObject
Caption = "&Object"
NegotiatePosition= 2 'Middle
Begin VB.Menu mnuObjectItems
Caption = "&Update Links"
Index = 1
End
Begin VB.Menu mnuObjectItems
Caption = "&Close Object"
Index = 2
End
End
Begin VB.Menu mnuWindow
Caption = "&Window"
NegotiatePosition= 3 'Right
WindowList = -1 'True
Begin VB.Menu mnuWindowItems
Caption = "&Cascade"
Index = 1
End
Begin VB.Menu mnuWindowItems
Caption = "Tile &Horizontal"
Index = 2
End
Begin VB.Menu mnuWindowItems
Caption = "Tile &Vertical"
Index = 3
End
Begin VB.Menu mnuWindowItems
Caption = "&Arrange Icons"
Index = 4
End
End
Attribute VB_Name = "frmExcel"
Attribute VB_Creatable = False
Attribute VB_Exposed = False
'*********************************************************************
' FRMEXCEL.FRM - MDI Child form with a OLE container control.
'*********************************************************************
Option Explicit
'*********************************************************************
' The RECT and GetClientRect decs are required for PositionFrame.
'*********************************************************************
#If Win32 Then
Private Type RECT
rLEFT As Long
rTOP As Long
rWIDTH As Long
rHEIGHT As Long
End Type
Private Declare Sub GetClientRect Lib "user32" (ByVal hWnd As Long, _
lpRect As RECT)
#Else
Private Type RECT
rLEFT As Integer
rTOP As Integer
rWIDTH As Integer
rHEIGHT As Integer
End Type
Private Declare Sub GetClientRect Lib "User" (ByVal hWnd As Integer, _
lpRect As RECT)
#End If
'*********************************************************************
' Gets the client area of a frame, and sizes an object to it.
'*********************************************************************
Private Sub PositionFrame(SourceFrame As Frame, ChildObject As Control)
Dim Client As RECT, X As RECT
GetClientRect SourceFrame.hWnd, Client
X.rLEFT = (Client.rLEFT * Screen.TwipsPerPixelX) + 50
X.rTOP = (Client.rTOP * Screen.TwipsPerPixelY) + 150
X.rWIDTH = (Client.rWIDTH * Screen.TwipsPerPixelX) - 90
X.rHEIGHT = (Client.rHEIGHT * Screen.TwipsPerPixelY) - 190
ScaleMode = vbTwips
ChildObject.Move X.rLEFT, X.rTOP, X.rWIDTH, X.rHEIGHT
ScaleMode = vbPixels
End Sub
'*********************************************************************
' Inializes this form instance. This code is also called everytime
' a new form is created.
'*********************************************************************
Private Sub Form_Load()
'*****************************************************************
' Establishing links takes a few minutes, so give the user
' something to look at.
'*****************************************************************
frmSplash.lblMessage = "Establishing links with Excel...Please Wait."
frmSplash.Show
frmSplash.Refresh
'*****************************************************************
' Always create your recreate links in case the program has been
' moved. In a real program, you should NEVER hardcode your links.
'*****************************************************************
Excel(0).CreateLink App.Path & "\" & "SAMPLE.XLS!R1C1:R5C5"
Excel(1).CreateLink App.Path & "\" & "SAMPLE.XLS!Pie"
'*****************************************************************
' Call DoEvents to process the links, and to prevent the splash
' screen from disappearing prematurely.
'*****************************************************************
DoEvents
Unload frmSplash
End Sub
'*********************************************************************
' Updates the status bar with the default text.
'*********************************************************************
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
UpdateStatus mdiOLE.lblStatus
End Sub
'*********************************************************************
' This proceedure controls the tab redrawing to handle switching.
'*********************************************************************
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _
X As Single, Y As Single)
Dim res%
res = Abs(DrawTabs(Me, X, Y) - 1)
If res < 2 Then Tabs(res).ZOrder
End Sub
'*********************************************************************
' Repositon the frames and resize the tabs.
'*********************************************************************
Private Sub Form_Resize()
Dim ActivateTab!
'*****************************************************************
' When the form is resized, the tabs must be rescaled to fit.
'*****************************************************************
SetupTabs Me, 2
'*****************************************************************
' Position the OLE Containers to fit inside the frames.
'*****************************************************************
PositionFrame Tabs(0), Excel(0)
PositionFrame Tabs(1), Excel(1)
'*****************************************************************
' SetupTabs will make the first tab active. Determine which
' tab should be active, and MouseUp it.
'*****************************************************************
ActivateTab = IIf(ActiveIndex = 0, 10, ((ScaleWidth - 2) / 2) + 100)
Form_MouseUp 0, 0, ActivateTab, 20
End Sub
'*********************************************************************
' Automatically saves any changes to the data.
'*********************************************************************
Private Sub Form_Unload(Cancel As Integer)
Excel(0).Object.Parent.RunAutoMacros (xlAutoClose)
End Sub
'*********************************************************************
' Handles clicks from the File Submenu.
'*********************************************************************
Private Sub mnuFileItems_Click(Index As Integer)
On Error Resume Next
Select Case Index
Case 1 'New
If ExcelWindows <= MAX_WINDOWS Then
ExcelWindows = ExcelWindows + 1
'*****************************************************
' Create a new form, and set its caption.
'*****************************************************
Excels(ExcelWindows - 1).Caption = "Excel -" _
& Str$(ExcelWindows + 1)
'*****************************************************
' Remove the caption from both frames.
'*****************************************************
Excels(ExcelWindows - 1).Tabs(0) = ""
Excels(ExcelWindows - 1).Tabs(1) = ""
End If
Case 3 'Exit
Unload mdiOLE
End Select
End Sub
'*********************************************************************
' Handles clicks from the Object Submenu.
'*********************************************************************
Private Sub mnuObjectItems_Click(Index As Integer)
Select Case Index
Case 1 'Update Links
Excel(0).Update
Excel(1).Update
Case 2 'Close Object
Excel(ActiveIndex).Close
End Select
End Sub
'*********************************************************************
' Updates the status bar.
'*********************************************************************
Private Sub Excel_MouseMove(Index As Integer, Button As Integer, _
Shift As Integer, X As Single, Y As Single)
UpdateStatus mdiOLE!lblStatus, Excel(Index).Tag
End Sub
'*********************************************************************
' Handles clicks from the Window Submenu.
'*********************************************************************
Private Sub mnuWindowItems_Click(Index As Integer)
mdiOLE.Arrange Index - 1
End Sub
'*********************************************************************
' Set the ActiveIndex. This isn't foolproof, but it works for this
' demonstration. In the "real world," this wouldn't be enough.
'*********************************************************************
Private Sub Tabs_MouseMove(Index As Integer, Button As Integer, _
Shift As Integer, X As Single, Y As Single)
ActiveIndex = Index
End Sub