vbAccelerator - Contents of code file: fTabTest.frm
VERSION 5.00
Object = "{396F7AC0-A0DD-11D3-93EC-00C0DFE7442A}#1.0#0"; "vbalIml6.ocx"
Object = "{5F37140E-C836-11D2-BEF8-525400DFB47A}#1.1#0"; "vbalTab6.ocx"
Begin VB.Form frmTabTest
Caption = "vbAccelerator TabStrip Control Tester"
ClientHeight = 5325
ClientLeft = 2430
ClientTop = 1860
ClientWidth = 6525
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "fTabTest.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5325
ScaleWidth = 6525
Begin VB.PictureBox picTestCtrl
Height = 4095
Left = 1020
ScaleHeight = 4035
ScaleWidth = 3915
TabIndex = 2
TabStop = 0 'False
Top = 600
Visible = 0 'False
Width = 3975
Begin VB.Frame fraStyle
Caption = "&Style"
Height = 3195
Left = 60
TabIndex = 7
Top = 780
Width = 3795
Begin VB.PictureBox picOptHolder
BorderStyle = 0 'None
Height = 2895
Left = 60
ScaleHeight = 2895
ScaleWidth = 3675
TabIndex = 9
Top = 180
Width = 3675
Begin VB.CheckBox chkOwnerDraw
Appearance = 0 'Flat
Caption = "&Owner Draw"
ForeColor = &H80000008&
Height = 315
Left = 0
TabIndex = 20
Top = 1320
Width = 1215
End
Begin VB.CommandButton cmdRebuild
Caption = "&Rebuild it..."
Height = 375
Left = 2340
TabIndex = 19
Top = 0
Width = 1215
End
Begin VB.ComboBox cboAlign
Height = 315
Left = 540
Style = 2 'Dropdown List
TabIndex = 18
Top = 2580
Width = 1575
End
Begin VB.CheckBox chkFlatButtons
Appearance = 0 'Flat
Caption = "&Flat Buttons"
Enabled = 0 'False
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 17
Top = 780
Width = 1455
End
Begin VB.CheckBox chkFlatSeparators
Appearance = 0 'Flat
Caption = "&Flat Separators"
Enabled = 0 'False
ForeColor = &H80000008&
Height = 255
Left = 240
TabIndex = 16
Top = 540
Width = 1455
End
Begin VB.CheckBox chkHotTrack
Appearance = 0 'Flat
Caption = "&Hot Track"
ForeColor = &H80000008&
Height = 255
Left = 0
TabIndex = 15
Top = 1080
Width = 2955
End
Begin VB.CheckBox chkButtons
Appearance = 0 'Flat
Caption = "&Buttons"
ForeColor = &H80000008&
Height = 255
Left = 0
TabIndex = 14
Top = 300
Width = 1155
End
Begin VB.CheckBox chkMultiLine
Appearance = 0 'Flat
Caption = "&Multi Line"
ForeColor = &H80000008&
Height = 255
Left = 0
TabIndex = 13
Top = 60
Width = 1095
End
Begin VB.OptionButton optStyle
Appearance = 0 'Flat
Caption = "&Standard"
ForeColor = &H80000008&
Height = 255
Index = 0
Left = 240
TabIndex = 12
Top = 1620
Width = 2295
End
Begin VB.OptionButton optStyle
Appearance = 0 'Flat
Caption = "&Flat"
ForeColor = &H80000008&
Height = 255
Index = 1
Left = 240
TabIndex = 11
Top = 1860
Width = 2295
End
Begin VB.OptionButton optStyle
Appearance = 0 'Flat
Caption = "&DevStudio"
ForeColor = &H80000008&
Height = 255
Index = 2
Left = 240
TabIndex = 10
Top = 2100
Width = 2295
End
Begin VB.Label lblAlign
Caption = "Align:"
Height = 195
Left = 0
TabIndex = 21
Top = 2640
Width = 495
End
End
End
Begin VB.CommandButton cmdRemoveAll
Caption = "Remove A&ll"
Height = 315
Left = 1200
TabIndex = 6
Top = 420
Width = 1095
End
Begin VB.CommandButton cmdRemoveTab
Caption = "&Remove Tab"
Height = 315
Left = 1200
TabIndex = 5
Top = 60
Width = 1095
End
Begin VB.CommandButton cmdAddTab
Caption = "&Add Tab"
Height = 315
Left = 60
TabIndex = 4
Top = 60
Width = 1095
End
Begin VB.CommandButton cmdInsertTab
Caption = "&Insert Tab"
Height = 315
Left = 60
TabIndex = 3
Top = 420
Width = 1095
End
End
Begin vbalIml6.vbalImageList ilsIcons
Left = 240
Top = 3960
_ExtentX = 953
_ExtentY = 953
ColourDepth = 24
Size = 5640
Images = "fTabTest.frx":0442
KeyCount = 6
Keys = ""
End
Begin VB.PictureBox picTab
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 900
ScaleHeight = 675
ScaleWidth = 975
TabIndex = 0
Top = 3900
Width = 1035
Begin VB.ListBox lstInfo
Height = 450
IntegralHeight = 0 'False
Left = 60
TabIndex = 1
Top = 60
Width = 915
End
End
Begin vbalTabStrip6.TabControl tabTest
Height = 3795
Left = 60
TabIndex = 8
Top = 60
Width = 6315
_ExtentX = 11139
_ExtentY = 6694
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
End
End
Attribute VB_Name = "frmTabTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub pShowOptions()
With tabTest
chkMultiLine.Value = Abs(.MultiLine)
chkButtons.Value = Abs(.Buttons)
chkFlatSeparators.Value = Abs(.FlatSeparators And .Buttons)
chkFlatButtons.Value = Abs(.FlatButtons And .Buttons)
chkHotTrack.Value = Abs(.HotTrack)
cboAlign.ListIndex = .TabAlign
End With
End Sub
Private Sub chkButtons_Click()
Dim bS As Boolean
bS = (chkButtons.Value = Checked)
chkFlatSeparators.Enabled = bS
chkFlatButtons.Enabled = bS
End Sub
Private Sub cmdAddTab_Click()
Dim sText As String
sText = "Test" & CLng(Rnd * 100 + 1)
tabTest.AddTab sText, Rnd * ilsIcons.ImageCount - 1, , sText
If tabTest.TabCount = 1 Or tabTest.MultiLine Then
Form_Resize
End If
End Sub
Private Sub cmdInsertTab_Click()
On Error GoTo ErrorHandler
Dim lIndex As Long
Dim sI As String
Dim sText As String
sI = InputBox$("Insert Before Which Tab? (Enter 1 based index or key)", ,
tabTest.TabKey(tabTest.SelectedTab))
If (sI <> "") Then
sText = "Test" & CLng(Rnd * 100 + 1)
tabTest.AddTab sText, Rnd * ilsIcons.ImageCount, sI, sText
If tabTest.MultiLine Then
Form_Resize
End If
End If
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbExclamation
Exit Sub
End Sub
Private Sub cmdRebuild_Click()
With tabTest
.Buttons = (chkButtons.Value = Checked)
If (.Buttons) Then
.FlatButtons = (chkFlatButtons.Value = Checked)
.FlatSeparators = (chkFlatSeparators.Value = Checked)
End If
.MultiLine = (chkMultiLine.Value = Checked)
.HotTrack = (chkHotTrack.Value = Checked)
.TabAlign = cboAlign.ListIndex
.OwnerDraw = (chkOwnerDraw.Value = Checked)
.Rebuild
Form_Resize
pShowOptions
End With
End Sub
Private Sub cmdRemoveAll_Click()
If (vbYes = MsgBox("Are you sure you want to remove all tabs?", vbYesNo Or
vbQuestion)) Then
tabTest.RemoveAllTabs
If tabTest.TabCount = 0 Then
Form_Resize
End If
End If
End Sub
Private Sub cmdRemoveTab_Click()
On Error GoTo ErrorHandler
Dim sI As String
sI = InputBox$("Which Tab?", , tabTest.TabKey(tabTest.SelectedTab))
If (sI <> "") Then
tabTest.RemoveTab sI
If tabTest.TabCount = 0 Then
Form_Resize
End If
End If
Exit Sub
ErrorHandler:
MsgBox Err.Description, vbExclamation
Exit Sub
End Sub
Private Sub Form_Load()
Dim i As Long
With cboAlign
.AddItem "Top"
.AddItem "Left"
.AddItem "Bottom"
.AddItem "Right"
.ListIndex = 0
End With
picTab.BorderStyle = 0
picTestCtrl.BorderStyle = 0
With tabTest
.ImageList = ilsIcons
.AddTab "Editor", 0, , "EDITOR", 1000
.AddTab "Editor Format", 1, , "FORMAT", 2000
.AddTab "General", 2, , "GENERAL", 3000
.AddTab "Docking", 3, , "DOCKING", 4000
.AddTab "Environment", 4, , "ENVIRONMENT", 5000
.AddTab "Advanced", 5, , "ADVANCED", 6000
End With
pShowOptions
End Sub
Private Sub Form_Resize()
On Error Resume Next
With tabTest
.Move tabTest.Left, tabTest.Top, Me.ScaleWidth - tabTest.Left * 2,
Me.ScaleHeight - tabTest.Top * 2
picTab.Move .ClientLeft, .ClientTop, .ClientWidth, .ClientHeight
picTestCtrl.Move .ClientLeft, .ClientTop, .ClientWidth, .ClientHeight
End With
End Sub
Private Sub optStyle_Click(Index As Integer)
Select Case True
Case optStyle(0).Value
tabTest.CoolTabs = etaNone
Me.BackColor = vbButtonFace
Case optStyle(1).Value
tabTest.CoolTabs = etaThinBlockEdge
Me.BackColor = vbButtonFace
Case optStyle(2).Value
tabTest.CoolTabs = etaDevStudio
Me.BackColor = vbButtonFace 'vbButtonShadow
End Select
End Sub
Private Sub picTab_Resize()
On Error Resume Next
lstInfo.Move 0, 0, picTab.ScaleWidth, picTab.ScaleHeight
End Sub
Private Sub tabTest_BeforeClick(ByVal lTab As Long, bCancel As Boolean)
Debug.Print "BeforeClick:" & lTab
lstInfo.AddItem "Tab_BeforeClick:" & lTab & " " & TabInfo(lTab)
End Sub
Private Sub tabTest_DrawItem(ByVal lTab As Long, ByVal hdc As Long, ByVal
bSelected As Boolean, ByVal bHot As Boolean, LeftPixels As Long, TopPixels As
Long, RightPixels As Long, BottomPixels As Long, bDoDefault As Boolean)
bDoDefault = True
End Sub
Private Sub tabTest_GotFocus()
lstInfo.AddItem "GotFocus"
End Sub
Private Sub tabTest_LostFocus()
lstInfo.AddItem "LostFocus"
End Sub
Private Sub tabTest_TabClick(ByVal lTab As Long)
Debug.Print "TabClick:" & lTab
lstInfo.AddItem "Tab_Click:" & lTab & " " & TabInfo(lTab)
picTab.Visible = ((lTab Mod 2) = 1)
picTestCtrl.Visible = Not (picTab.Visible)
End Sub
Private Sub tabTest_TabRightClick()
lstInfo.AddItem "TabRightClick"
End Sub
Private Function TabInfo(ByVal lTab As Long) As String
TabInfo = " (Text: '" & tabTest.TabText(lTab) & "', Image: " &
tabTest.TabImage(lTab) & ", Key: " & tabTest.TabKey(lTab) & ", ItemData: "
& tabTest.TabItemData(lTab) & ")"
End Function
|
|