vbAccelerator - Contents of code file: frmMain.frm
VERSION 5.00
Object = "{C9E5D1F8-C181-11D3-8E24-44910FC10000}#4.0#0"; "ctlFrame.ocx"
Begin VB.Form frmMain
Caption = "Active Frame Control Tester"
ClientHeight = 7065
ClientLeft = 3675
ClientTop = 2220
ClientWidth = 9240
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmMain.frx":0000
LinkTopic = "Form1"
ScaleHeight = 7065
ScaleWidth = 9240
Begin ctlFrame.ActiveFrame ActiveFrame3
Height = 1995
Left = 1860
TabIndex = 3
Top = 0
Width = 4035
_ExtentX = 7117
_ExtentY = 3519
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
CaptionVisible = 0 'False
BackColor = -2147483633
End
Begin VB.TextBox Text1
BorderStyle = 0 'None
Height = 795
Left = 1920
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 2
Text = "frmMain.frx":014A
Top = 2700
Width = 1965
End
Begin ctlFrame.ActiveFrame ActiveFrame2
Height = 1395
Left = 1860
TabIndex = 1
Top = 5640
Width = 7365
_ExtentX = 12991
_ExtentY = 2461
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "Add-In"
CaptionAlign = 3
BackColor = -2147483633
End
Begin ctlFrame.ActiveFrame ActiveFrame1
Height = 7065
Left = 0
TabIndex = 0
Top = 0
Width = 1845
_ExtentX = 3254
_ExtentY = 12462
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Caption = "Folders"
End
Begin VB.Image Image1
Height = 3090
Left = 4440
Picture = "frmMain.frx":0647
Stretch = -1 'True
Top = 540
Width = 4500
End
Begin VB.Menu mnuViewTOP
Caption = "&View"
Begin VB.Menu mnuView
Caption = "&Left"
Checked = -1 'True
Index = 0
End
Begin VB.Menu mnuView
Caption = "&Bottom"
Checked = -1 'True
Index = 1
End
End
End
Attribute VB_Name = "frmMain"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Type RECT
left As Long
top As Long
right As Long
bottom As Long
End Type
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal
hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Const EM_GETRECT = &HB2
Private Const EM_SETRECT = &HB3
Private Declare Function GetClientRect Lib "user32" (ByVal hwnd As Long, lpRect
As RECT) As Long
Private Declare Function InflateRect Lib "user32" (lpRect As RECT, ByVal X As
Long, ByVal Y As Long) As Long
Private Sub ActiveFrame1_QueryUnload()
ActiveFrame1.Visible = False
Form_Resize
End Sub
Private Sub ActiveFrame2_QueryUnload()
ActiveFrame2.Visible = False
Form_Resize
End Sub
Private Sub Form_Load()
' ActiveFrame1 is the LHS frame:
ActiveFrame1.Pane = Text1
' ActiveFrame3 only has a border, no button:
ActiveFrame3.Pane = Image1
' ActiveFrame2, the bottom frame, is left empty for this demo
End Sub
Private Sub Form_Resize()
Dim lL As Long
Dim lH As Long
Dim tR As RECT
On Error Resume Next
' Note we only resize the frames - any child is auto-sized to fit
ActiveFrame1.Move Screen.TwipsPerPixelX, Screen.TwipsPerPixelY,
ActiveFrame1.Width, Me.ScaleHeight - 2 * Screen.TwipsPerPixelY
' A trick to make a borderless text box look better:
SendMessage Text1.hwnd, EM_GETRECT, 0, tR
tR.left = 2
tR.top = 2
SendMessage Text1.hwnd, EM_SETRECT, 0, tR
lL = (ActiveFrame1.left + ActiveFrame1.Width + 4 * Screen.TwipsPerPixelX) *
-ActiveFrame1.Visible
lH = (ActiveFrame2.Height + Screen.TwipsPerPixelY) * -ActiveFrame2.Visible
ActiveFrame2.Move lL, Me.ScaleHeight - lH, Me.ScaleWidth - lL -
Screen.TwipsPerPixelY
If ActiveFrame2.Visible Then
lH = lH + 4 * Screen.TwipsPerPixelY
End If
ActiveFrame3.Move ActiveFrame2.left, ActiveFrame1.top, ActiveFrame2.Width,
Me.ScaleHeight - lH - Screen.TwipsPerPixelY * 2
End Sub
Private Sub mnuView_Click(Index As Integer)
Dim bS As Boolean
bS = Not (mnuView(Index).Checked)
mnuView(Index).Checked = bS
Select Case Index
Case 0
ActiveFrame1.Visible = bS
Case 1
ActiveFrame2.Visible = bS
End Select
Form_Resize
End Sub
Private Sub mnuViewTOP_Click()
mnuView(0).Checked = ActiveFrame1.Visible
mnuView(1).Checked = ActiveFrame2.Visible
End Sub
|
|