vbAccelerator - Contents of code file: mfrmMain.frm
VERSION 5.00
Begin VB.MDIForm mfrmMain
Appearance = 0 'Flat
AutoShowChildren= 0 'False
BackColor = &H8000000C&
Caption = "MDI Tab Tester"
ClientHeight = 6540
ClientLeft = 3150
ClientTop = 3090
ClientWidth = 10050
Icon = "mfrmMain.frx":0000
LinkTopic = "MDIForm1"
Begin VB.PictureBox picTools
Align = 4 'Align Right
BorderStyle = 0 'None
Height = 5730
Index = 3
Left = 8280
ScaleHeight = 5730
ScaleWidth = 1770
TabIndex = 3
Top = 435
Width = 1770
Begin VB.CommandButton cmdChangeCaption
Caption = "&Caption"
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 375
Left = 300
TabIndex = 4
Top = 0
Width = 1155
End
End
Begin VB.PictureBox picTools
Align = 3 'Align Left
BorderStyle = 0 'None
Height = 5730
Index = 2
Left = 0
ScaleHeight = 5730
ScaleWidth = 810
TabIndex = 2
Top = 435
Width = 810
End
Begin VB.PictureBox picTools
Align = 2 'Align Bottom
BorderStyle = 0 'None
Height = 375
Index = 1
Left = 0
ScaleHeight = 375
ScaleWidth = 10050
TabIndex = 1
Top = 6165
Width = 10050
End
Begin VB.PictureBox picTools
Align = 1 'Align Top
BorderStyle = 0 'None
Height = 435
Index = 0
Left = 0
ScaleHeight = 435
ScaleWidth = 10050
TabIndex = 0
Top = 0
Width = 10050
End
Begin VB.Menu mnuFileTop
Caption = "&File"
Begin VB.Menu mnuFile
Caption = "&New"
Index = 0
Shortcut = ^N
End
Begin VB.Menu mnuFile
Caption = "&Open..."
Index = 1
Shortcut = ^O
End
Begin VB.Menu mnuFile
Caption = "&Close"
Enabled = 0 'False
Index = 2
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 3
End
Begin VB.Menu mnuFile
Caption = "&Save"
Enabled = 0 'False
Index = 4
Shortcut = ^S
End
Begin VB.Menu mnuFile
Caption = "Save &As..."
Enabled = 0 'False
Index = 5
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 6
End
Begin VB.Menu mnuFile
Caption = "Page Se&tup"
Enabled = 0 'False
Index = 7
End
Begin VB.Menu mnuFile
Caption = "Print Pre&view"
Enabled = 0 'False
Index = 8
End
Begin VB.Menu mnuFile
Caption = "&Print"
Enabled = 0 'False
Index = 9
Shortcut = ^P
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 10
End
Begin VB.Menu mnuFile
Caption = "P&roperties"
Enabled = 0 'False
Index = 11
End
Begin VB.Menu mnuFile
Caption = "-"
Index = 12
End
Begin VB.Menu mnuFile
Caption = "E&xit"
Index = 13
End
End
Begin VB.Menu mnuViewTOP
Caption = "&View"
Begin VB.Menu mnuView
Caption = "&Toolbar"
Checked = -1 'True
Index = 0
End
Begin VB.Menu mnuView
Caption = "&Status Bar"
Checked = -1 'True
Index = 1
End
Begin VB.Menu mnuView
Caption = "&Toolbox"
Checked = -1 'True
Index = 2
End
Begin VB.Menu mnuView
Caption = "&Project"
Checked = -1 'True
Index = 3
End
Begin VB.Menu mnuView
Caption = "-"
Index = 4
End
Begin VB.Menu mnuView
Caption = "&Tab Below"
Index = 5
End
End
Begin VB.Menu mnuWindowTop
Caption = "&Window"
WindowList = -1 'True
End
Begin VB.Menu mnuHelpTOP
Caption = "&Help"
Begin VB.Menu mnuHelp
Caption = "&vbAccelerator on the Web..."
Index = 0
Shortcut = {F1}
End
Begin VB.Menu mnuHelp
Caption = "-"
Index = 1
End
Begin VB.Menu mnuHelp
Caption = "&About..."
Index = 2
End
End
End
Attribute VB_Name = "mfrmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private WithEvents m_cMDITabs As cMDITabs
Attribute m_cMDITabs.VB_VarHelpID = -1
Private m_lDocumentId As Long
Private Declare Function SetWindowLong Lib "USER32" Alias "SetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "USER32" Alias "GetWindowLongA"
(ByVal hWnd As Long, ByVal nIndex As Long) As Long
Private Declare Function SetWindowPos Lib "USER32" (ByVal hWnd As Long, ByVal
hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long,
ByVal cy As Long, ByVal wFlags As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const GWL_EXSTYLE = (-20)
Private Const WS_EX_APPWINDOW = &H40000
Private Const WS_SYSMENU = &H80000
Private Const SWP_FRAMECHANGED = &H20 ' The frame changed: send
WM_NCCALCSIZE
Private Const SWP_NOACTIVATE = &H10
Private Const SWP_NOMOVE = &H2
Private Const SWP_NOOWNERZORDER = &H200 ' Don't do owner Z ordering
Private Const SWP_NOSIZE = &H1
Private Const SWP_NOZORDER = &H4
Private Sub newWindow(Optional ByVal sFileName As String)
m_lDocumentId = m_lDocumentId + 1
Dim fT As New frmTest
fT.Show
If (sFileName = "") Then
fT.NewDocument "Document" & m_lDocumentId
Else
fT.OpenDocument sFileName
End If
m_cMDITabs.ForceRefresh
End Sub
Private Sub cmdChangeCaption_Click()
If Not Me.ActiveForm Is Nothing Then
Dim sCap As String
sCap = Me.ActiveForm.Caption
If InStr(sCap, "Changed Cap") = 0 Then
Me.ActiveForm.Tag = sCap
sCap = "Changed Caption:" & Format$(Now, "Short Time")
Else
sCap = Me.ActiveForm.Tag
End If
Me.ActiveForm.Caption = sCap
m_cMDITabs.ForceRefresh
End If
End Sub
Private Sub m_cMDITabs_CloseWindow(ByVal hWnd As Long)
Dim frm As Form
Set frm = formForHwnd(hWnd)
Unload frm
m_cMDITabs.ForceRefresh
End Sub
Private Sub m_cMDITabs_TabBarClick(ByVal iButton As MouseButtonConstants, ByVal
screenX As Long, ByVal screenY As Long)
Dim sMsg As String
sMsg = "Bar Click, button: "
If (iButton = vbLeftButton) Then
sMsg = sMsg & "Left"
Else
sMsg = sMsg & "Right"
End If
sMsg = sMsg & " at (" & screenX & "," & screenY & ")"
showEvent sMsg
End Sub
Private Sub m_cMDITabs_TabClick(ByVal iButton As MouseButtonConstants, ByVal
hWnd As Long, ByVal screenX As Long, ByVal screenY As Long)
Dim sMsg As String
sMsg = "Tab Click, button: "
If (iButton = vbLeftButton) Then
sMsg = sMsg & "Left"
Else
sMsg = sMsg & "Right"
End If
sMsg = sMsg & " for form: " & formForHwnd(hWnd).Name
sMsg = sMsg & " at (" & screenX & "," & screenY & ")"
showEvent sMsg
If (iButton = vbRightButton) Then
Me.PopupMenu mnuViewTOP, , screenX * Screen.TwipsPerPixelX, screenY *
Screen.TwipsPerPixelY
'Me.PopupMenu mnuViewTOP, , 0, 0
End If
End Sub
Private Function formForHwnd(ByVal hWnd As Long) As Form
Dim frmChild As Form
For Each frmChild In Forms
If (frmChild.hWnd = hWnd) Then
Set formForHwnd = frmChild
Exit For
End If
Next
End Function
Private Sub showEvent(ByVal sMsg As String)
Dim frmChild As Form
For Each frmChild In Forms
'If (frmChild.MDIChild) Then
If TypeName(frmChild) = "frmEvents" Then
frmChild.lstEvents.AddItem sMsg
frmChild.lstEvents.ListIndex = frmChild.lstEvents.ListCount - 1
End If
'End If
Next
End Sub
Private Sub m_cMDITabs_WindowChanged(ByVal hWnd As Long)
Dim frm As Form
Set frm = formForHwnd(hWnd)
Dim bEnable As Boolean
If Not frm Is Nothing Then
bEnable = (TypeName(frm) = "frmTest")
End If
mnuFile(2).Enabled = bEnable
mnuFile(4).Enabled = bEnable
mnuFile(5).Enabled = bEnable
' would do 7,8,9,11 here as well
End Sub
Private Sub MDIForm_Load()
Set m_cMDITabs = New cMDITabs
m_cMDITabs.Attach Me.hWnd
Load frmEvents
frmEvents.Show
Dim fB As New frmBrowser
Dim sUrl As String
sUrl = App.Path
If (Right(sUrl, 1) <> "\") Then sUrl = sUrl & "\"
sUrl = sUrl & "startPage.html"
fB.Url = sUrl
fB.Show
newWindow App.Path & "/home/VB/Code/Controls/Tab_Controls/MDI_Tabs/licence.txt"
End Sub
Private Sub mnuFile_Click(Index As Integer)
Dim sFile As String
Select Case Index
Case 0
' new
newWindow
Case 1
' open
Dim c As New cCommonDialog
If (c.VBGetOpenFileName( _
Filename:=sFile, _
Filter:="Text Files (*.TXT)|*.TXT|HTML Files (*.HTML)|*.HTML|XML Files
(*.XML)|*.XML)|All Files (*.*)|*.*", _
InitDir:=App.Path, _
Owner:=Me.hWnd)) Then
newWindow sFile
End If
Case 2
' close
If Not (Me.ActiveForm Is Nothing) Then
If Not (Me Is Me.ActiveForm) Then
Unload Me.ActiveForm
m_cMDITabs.ForceRefresh
End If
End If
Case 4
' save
Me.ActiveForm.SaveDocument
Case 5
' save as
Me.ActiveForm.SaveDocument True
Case 7
' page setup
' todo
Case 8
' print preview
' todo
Case 9
' print
' todo
Case 11
' properties
' todo
Case 13
Unload Me
End Select
End Sub
Private Sub mnuHelp_Click(Index As Integer)
Select Case Index
Case 0
' vbAccelerator on the Web
Case 2
' About
frmAbout.Show vbModal, Me
End Select
End Sub
Private Sub mnuView_Click(Index As Integer)
mnuView(Index).Checked = Not (mnuView(Index).Checked)
If (Index < 4) Then
picTools(Index).Visible = mnuView(Index).Checked
ElseIf Index = 5 Then
If (mnuView(Index).Checked) Then
m_cMDITabs.TabAlign = TabAlignBottom
Else
m_cMDITabs.TabAlign = TabAlignTop
End If
End If
End Sub
|
|