VB5 Pinnable VS Tab Demonstration (21K)
VB5 VS Tab Control Binary (30K)
VB5 VS Tab Control Demonstration (17K)
VB5 VS Tab Control Full Source (97K)
VB6 Pinnable VS Tab Demonstration (20K)
VB6 VS Tab Control Binary (30K)
VB6 VS Tab Control Demonstration (16K)
VB6 VS Tab Control Full Source (95K)
vbalDTab6 Interface Definition (1K)
Bugs: 4 / 6
Issues: 6 / 6
Questions: 1 / 1
11 May 2003
Calling remove on a non-existent tab did not raise an error because the control ate it.
Inserting a tab did not work correctly since the existing tabs were not shuffled up.
If a tab with a panel was removed, and then added, then a subscript out of range error occurred.
Thanks to Michael Elashoff, Julien Margail and Matt Funnell
Subclassing Without The Crashes
Using the System Image List with (and without) vbAccelerator Controls
vbAccelerator ImageList Control and Class v2.0
vbAccelerator - Contents of code file: frmTestTabs.frm
VERSION 5.00
Object = "{74AB545E-1F51-4CA8-A61B-89925A0B8D2A}#1.6#0"; "vbalDTab.ocx"
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Begin VB.Form frmTestTabs
Caption = "Visual Studio Tab Tester"
ClientHeight = 4215
ClientLeft = 4500
ClientTop = 3630
ClientWidth = 7140
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmTestTabs.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4215
ScaleWidth = 7140
Begin VB.CommandButton cmdTestAddRemove
Caption = "Test Remove"
Height = 375
Left = 6060
TabIndex = 11
Top = 60
Width = 1035
End
Begin VB.CommandButton cmdTestFont
Caption = "Test &Font"
Height = 375
Left = 4920
TabIndex = 10
Top = 60
Width = 1035
End
Begin vbalDTab.vbalDTabControl tabTest
Height = 2235
Left = 60
TabIndex = 9
Top = 780
Width = 3135
_ExtentX = 5530
_ExtentY = 3942
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
BeginProperty SelectedFont {0BE35203-8F91-11CE-9DE3-00AA004BB851}
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
End
Begin VB.CheckBox chkNoClose
Caption = "No &Close Button"
Height = 255
Left = 3120
TabIndex = 8
Top = 60
Width = 1515
End
Begin VB.TextBox txtTest
BorderStyle = 0 'None
Height = 435
Left = 4560
MultiLine = -1 'True
ScrollBars = 3 'Both
TabIndex = 7
Top = 1740
Width = 1155
End
Begin VB.PictureBox picEvents
BorderStyle = 0 'None
Height = 1335
Left = 2820
ScaleHeight = 1335
ScaleWidth = 2655
TabIndex = 4
Top = 720
Width = 2655
Begin VB.ListBox lstEvents
Height = 540
IntegralHeight = 0 'False
Left = 60
TabIndex = 5
Top = 240
Width = 2355
End
Begin VB.Label lblEvents
Caption = "Events:"
Height = 195
Left = 60
TabIndex = 6
Top = 0
Width = 1395
End
End
Begin VB.CheckBox chkAllowScroll
Caption = "Allow &Scroll"
Height = 255
Left = 1560
TabIndex = 3
Top = 360
Value = 1 'Checked
Width = 1515
End
Begin VB.CheckBox chkNoTabs
Caption = "&No Tabs"
Height = 255
Left = 1560
TabIndex = 2
Top = 60
Width = 1515
End
Begin VB.CheckBox chkIcons
Caption = "&Icons"
Height = 255
Left = 60
TabIndex = 1
Top = 360
Value = 1 'Checked
Width = 1515
End
Begin VB.CheckBox chkTabBottom
Caption = "&Tabs at Bottom"
Height = 255
Left = 60
TabIndex = 0
Top = 60
Value = 1 'Checked
Width = 1515
End
Begin ComctlLib.ImageList ilsIcons
Left = 4860
Top = 2400
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 8
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestTabs.frx":1272
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestTabs.frx":144C
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestTabs.frx":1626
Key = ""
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestTabs.frx":1800
Key = ""
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestTabs.frx":19DA
Key = ""
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestTabs.frx":1BB4
Key = ""
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestTabs.frx":1D8E
Key = ""
EndProperty
BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestTabs.frx":1F68
Key = ""
EndProperty
EndProperty
End
Begin VB.Menu mnuContextTOP
Caption = ""
Visible = 0 'False
Begin VB.Menu mnuContext
Caption = "&Tabs At Bottom"
Checked = -1 'True
Index = 0
End
Begin VB.Menu mnuContext
Caption = "&Icons"
Checked = -1 'True
Index = 1
End
Begin VB.Menu mnuContext
Caption = "Allow &Scroll"
Checked = -1 'True
Index = 2
End
Begin VB.Menu mnuContext
Caption = "No &Close Button"
Index = 3
End
Begin VB.Menu mnuContext
Caption = "-"
Index = 4
End
Begin VB.Menu mnuContext
Caption = "&No Tabs"
Index = 5
End
End
End
Attribute VB_Name = "frmTestTabs"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
' remove border from ListBox
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 Enum EWindowLongIndexes
GWL_EXSTYLE = (-20)
GWL_HINSTANCE = (-6)
GWL_HWNDPARENT = (-8)
GWL_ID = (-12)
GWL_STYLE = (-16)
GWL_USERDATA = (-21)
GWL_WNDPROC = (-4)
End Enum
' General window styles:
Private Enum EExWindowStyles
WS_EX_DLGMODALFRAME = &H1
WS_EX_NOPARENTNOTIFY = &H4
WS_EX_TOPMOST = &H8
WS_EX_ACCEPTFILES = &H10
WS_EX_TRANSPARENT = &H20
WS_EX_MDICHILD = &H40
WS_EX_TOOLWINDOW = &H80
WS_EX_WINDOWEDGE = &H100
WS_EX_CLIENTEDGE = &H200
WS_EX_CONTEXTHELP = &H400
WS_EX_RIGHT = &H1000
WS_EX_LEFT = &H0
WS_EX_RTLREADING = &H2000
WS_EX_LTRREADING = &H0
WS_EX_LEFTSCROLLBAR = &H4000
WS_EX_RIGHTSCROLLBAR = &H0
WS_EX_CONTROLPARENT = &H10000
WS_EX_STATICEDGE = &H20000
WS_EX_APPWINDOW = &H40000
WS_EX_OVERLAPPEDWINDOW = (WS_EX_WINDOWEDGE Or WS_EX_CLIENTEDGE)
WS_EX_PALETTEWINDOW = (WS_EX_WINDOWEDGE Or WS_EX_TOOLWINDOW Or
WS_EX_TOPMOST)
End Enum
Private Sub LogEvent(ByVal sMsg As String)
lstEvents.AddItem sMsg
lstEvents.ListIndex = lstEvents.ListCount - 1
End Sub
Private Sub chkAllowScroll_Click()
If (chkAllowScroll.Value = vbChecked) Then
tabTest.AllowScroll = True
mnuContext(2).Checked = True
Else
tabTest.AllowScroll = False
mnuContext(2).Checked = True
End If
End Sub
Private Sub chkIcons_Click()
If (chkIcons.Value = vbChecked) Then
tabTest.ImageList = ilsIcons
mnuContext(1).Checked = True
Else
tabTest.ImageList = 0
mnuContext(1).Checked = False
End If
End Sub
Private Sub chkNoClose_Click()
If (chkNoClose.Value = vbChecked) Then
tabTest.ShowCloseButton = False
mnuContext(3).Checked = False
Else
tabTest.ShowCloseButton = True
mnuContext(3).Checked = True
End If
End Sub
Private Sub chkNoTabs_Click()
If (chkNoTabs.Value = vbChecked) Then
tabTest.ShowTabs = False
mnuContext(5).Checked = True
Else
tabTest.ShowTabs = True
mnuContext(5).Checked = True
End If
End Sub
Private Sub chkTabBottom_Click()
If (chkTabBottom.Value = vbChecked) Then
tabTest.TabAlign = TabAlignBottom
mnuContext(0).Checked = True
Else
tabTest.TabAlign = TabAlignTop
mnuContext(0).Checked = False
End If
End Sub
Private Sub cmdTestAddRemove_Click()
tabTest.Tabs.Remove "SOLUTION"
Dim c As cTab
Set c = tabTest.Tabs.Add("SOLUTION", "CLASS", "Contents", 2)
c.Panel = picEvents
End Sub
Private Sub cmdTestFont_Click()
Dim sF As New StdFont
sF.Name = tabTest.Font.Name
If (tabTest.Font.Size < 24) Then
sF.Size = 24
tabTest.Font = sF
sF.Bold = True
tabTest.SelectedFont = sF
Else
tabTest.Font.Size = 8
sF.Size = 8
tabTest.Font = sF
sF.Bold = True
tabTest.SelectedFont = sF
End If
End Sub
Private Sub Form_Load()
'Dim lStyle As Long
'lStyle = GetWindowLong(lstEvents.hWnd, GWL_EXSTYLE)
'lStyle = lStyle And Not WS_EX_CLIENTEDGE
'SetWindowLong lstEvents.hWnd, GWL_EXSTYLE, lStyle
Dim c As cTab
With tabTest
.ImageList = ilsIcons
Set c = .Tabs.Add("SOLUTION", , "Solution Explorer")
c.IconIndex = 0
c.Panel = picEvents
Set c = .Tabs.Add("CLASS", , "Class View")
c.IconIndex = 1
c.CanClose = False
c.Panel = txtTest
Set c = .Tabs.Add("CONTENTS")
c.IconIndex = 2
c.Caption = "Contents"
Set c = .Tabs.Add("INDEX", , "Index")
c.IconIndex = 3
Set c = .Tabs.Add("SEARCH", , "Search")
c.IconIndex = 4
End With
txtTest.Text = "vbAccelerator VS Tab Control Demonstration"
End Sub
Private Sub Form_Resize()
On Error Resume Next ' in case form is too small
tabTest.Move _
2 * Screen.TwipsPerPixelX, _
tabTest.Top, _
Me.ScaleWidth - 4 * Screen.TwipsPerPixelX, _
Me.ScaleHeight - tabTest.Top - 2 * Screen.TwipsPerPixelY
End Sub
Private Sub Form_Terminate()
If (Forms.Count = 0) Then
UnloadApp
End If
End Sub
Private Sub mnuContext_Click(Index As Integer)
Select Case Index
Case 0
If (chkTabBottom.Value = vbChecked) Then
chkTabBottom.Value = vbUnchecked
Else
chkTabBottom.Value = vbChecked
End If
Case 1
If (chkIcons.Value = vbChecked) Then
chkIcons.Value = vbUnchecked
Else
chkIcons.Value = vbChecked
End If
Case 2
If (chkAllowScroll.Value = vbChecked) Then
chkAllowScroll.Value = vbUnchecked
Else
chkAllowScroll.Value = vbChecked
End If
Case 3
If (chkNoClose.Value = vbChecked) Then
chkNoClose.Value = vbUnchecked
Else
chkNoClose.Value = vbChecked
End If
Case 5
If (chkNoTabs.Value = vbChecked) Then
chkNoTabs.Value = vbUnchecked
Else
chkNoTabs.Value = vbChecked
End If
End Select
End Sub
Private Sub picEvents_Resize()
On Error Resume Next ' in case it gets too small
lblEvents.Width = picEvents.ScaleWidth - lstEvents.Left * 2
lstEvents.Move lstEvents.Left, lstEvents.Top, picEvents.ScaleWidth -
lstEvents.Left * 2, picEvents.ScaleHeight - lstEvents.Top - 2 *
Screen.TwipsPerPixelY
End Sub
Private Sub tabTest_Resize()
LogEvent "Resize"
End Sub
Private Sub tabTest_TabBarClick(ByVal iButton As MouseButtonConstants, ByVal
Shift As ShiftConstants, ByVal x As Single, ByVal y As Single)
LogEvent "TabBarClick: Button = " & iButton & ", Shift = " & Shift & ", X =
" & x & ", Y = " & y
End Sub
Private Sub tabTest_TabClick(theTab As cTab, ByVal iButton As
MouseButtonConstants, ByVal Shift As ShiftConstants, ByVal x As Single, ByVal
y As Single)
LogEvent "TabClick: '" & theTab.Caption & "', Button = " & iButton & ",
Shift = " & Shift & ", X = " & x & ", Y = " & y
If (iButton = vbRightButton) Then
Me.PopupMenu mnuContextTOP, , x + tabTest.Left, y + tabTest.Top
End If
End Sub
Private Sub tabTest_TabClose(theTab As cTab, bCancel As Boolean)
LogEvent "TabClose: '" & theTab.Caption & "'"
If (vbNo = MsgBox("Are you sure you want to close the " & theTab.Caption & "
tab?", vbQuestion Or vbYesNo)) Then
bCancel = True
End If
End Sub
Private Sub tabTest_TabDoubleClick(theTab As cTab)
LogEvent "TabDoubleClick: '" & theTab.Caption & "'"
End Sub
Private Sub tabTest_TabSelected(theTab As cTab)
If Not (theTab Is Nothing) Then
LogEvent "TabSelected: '" & theTab.Caption & "'"
Else
LogEvent "No Tab Selected"
End If
End Sub
