VB5 TabStrip Control Binary (19K)
VB5 TabStrip Control Demonstration (18K)
VB5 TabStrip Control Full Source (57K)
VB6 TabStrip Control Binary (20K)
VB6 TabStrip Control Demonstration (16K)
VB6 TabStrip Control Full Source (57K)
vbalTabStrip Interface Definition (2K)
Bugs: 1 / 1
Issues: 2 / 2
Questions: 0 / 0
7 Jan 2003
Added XP Visual Styles Manifest
Ole Guid and interface definitions (OleGuids.Tlb)
Adding XP Visual Styles to Your Visual Basic Application
Subclassing Without The Crashes
vbAccelerator ImageList Control and Class v2.0
vbAccelerator - Contents of code file: fTabTest.frm
VERSION 5.00
Object = "{C14485BC-7593-11D2-8E21-20B404C10000}#1.2#0"; "vbalTab.ocx"
Object = "{8245A918-4CF7-11D2-8E21-10B404C10000}#8.1#0"; "vbalIml.ocx"
Begin VB.Form frmTabTest
Caption = "vbAccelerator TabStrip Control Tester"
ClientHeight = 5328
ClientLeft = 4536
ClientTop = 2208
ClientWidth = 6516
BeginProperty Font
Name = "Tahoma"
Size = 8.4
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "fTabTest.frx":0000
LinkTopic = "Form1"
ScaleHeight = 5328
ScaleWidth = 6516
Begin VB.PictureBox picTestCtrl
Height = 4095
Left = 1020
ScaleHeight = 4044
ScaleWidth = 3924
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.OptionButton optStyle
Appearance = 0 'Flat
Caption = "&DevStudio"
ForeColor = &H80000008&
Height = 315
Index = 2
Left = 120
TabIndex = 20
Top = 2280
Width = 2295
End
Begin VB.OptionButton optStyle
Appearance = 0 'Flat
Caption = "&Flat"
ForeColor = &H80000008&
Height = 315
Index = 1
Left = 120
TabIndex = 19
Top = 2040
Width = 2295
End
Begin VB.OptionButton optStyle
Appearance = 0 'Flat
Caption = "&Standard"
ForeColor = &H80000008&
Height = 315
Index = 0
Left = 120
TabIndex = 18
Top = 1800
Width = 2295
End
Begin VB.CheckBox chkOwnerDraw
Appearance = 0 'Flat
Caption = "&Owner Draw"
ForeColor = &H80000008&
Height = 315
Left = 120
TabIndex = 17
Top = 1500
Width = 1215
End
Begin VB.CommandButton cmdRebuild
Caption = "&Rebuild it..."
Height = 375
Left = 2460
TabIndex = 15
Top = 180
Width = 1215
End
Begin VB.ComboBox cboAlign
Height = 315
Left = 660
Style = 2 'Dropdown List
TabIndex = 14
Top = 2760
Width = 1575
End
Begin VB.CheckBox chkFlatButtons
Appearance = 0 'Flat
Caption = "&Flat Buttons"
Enabled = 0 'False
ForeColor = &H80000008&
Height = 255
Left = 360
TabIndex = 12
Top = 960
Width = 1455
End
Begin VB.CheckBox chkFlatSeparators
Appearance = 0 'Flat
Caption = "&Flat Separators"
Enabled = 0 'False
ForeColor = &H80000008&
Height = 255
Left = 360
TabIndex = 11
Top = 720
Width = 1455
End
Begin VB.CheckBox chkHotTrack
Appearance = 0 'Flat
Caption = "&Hot Track"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 10
Top = 1260
Width = 2955
End
Begin VB.CheckBox chkButtons
Appearance = 0 'Flat
Caption = "&Buttons"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 9
Top = 480
Width = 1155
End
Begin VB.CheckBox chkMultiLine
Appearance = 0 'Flat
Caption = "&Multi Line"
ForeColor = &H80000008&
Height = 255
Left = 120
TabIndex = 8
Top = 240
Width = 2955
End
Begin VB.Label lblAlign
Caption = "Align:"
Height = 195
Left = 120
TabIndex = 13
Top = 2820
Width = 495
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 vbalIml.vbalImageList ilsIcons
Left = 240
Top = 3960
_ExtentX = 762
_ExtentY = 762
ColourDepth = 24
Size = 5640
Images = "fTabTest.frx":0442
KeyCount = 6
Keys = ""
End
Begin VB.PictureBox picTab
BeginProperty Font
Name = "MS Sans Serif"
Size = 7.8
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 735
Left = 900
ScaleHeight = 684
ScaleWidth = 984
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 vbalTabStrip.TabControl tabTest
Height = 3075
Left = 60
TabIndex = 16
Top = 60
Width = 6135
_ExtentX = 10816
_ExtentY = 5419
BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.4
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
HotTrack = -1 'True
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
