VB5 ToolBox ListBar Control Binary (30K)
VB5 ToolBox ListBar Demonstration (18K)
VB5 ToolBox ListBar Full Source (75K)
VB6 ToolBox ListBar Control Binary (30K)
VB6 ToolBox ListBar Demonstration (17K)
VB6 ToolBox ListBar Full Source (74K)
Bugs: 3 / 3
Issues: 0 / 0
Questions: 0 / 0
12 Feb 2003
First Posted
vbAccelerator Visual Studio Style Tab Control
vbAccelerator - Contents of code file: frmTestToolBoxBar.frm
VERSION 5.00
Object = "{6B7E6392-850A-101B-AFC0-4210102A8DA7}#1.3#0"; "COMCTL32.OCX"
Object = "{896EE2E8-B1A5-475E-855E-A5E4531DF26E}#2.1#0"; "vbalToolboxBar.ocx"
Begin VB.Form frmTestToolBoxBar
Caption = "vbAccelerator ToolBox ListBar Control"
ClientHeight = 4695
ClientLeft = 3855
ClientTop = 3360
ClientWidth = 6645
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Icon = "frmTestToolBoxBar.frx":0000
LinkTopic = "Form1"
ScaleHeight = 4695
ScaleWidth = 6645
Begin vbalToolboxBarLib.vbalToolBoxBarCtl tbxLeft
Align = 3 'Align Left
Height = 4695
Left = 0
TabIndex = 9
Top = 0
Width = 2550
_ExtentX = 4498
_ExtentY = 8281
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
Begin VB.CommandButton cmdNewInstance
Caption = "&New Form..."
Height = 435
Left = 4920
TabIndex = 8
Top = 600
Width = 1215
End
Begin VB.Frame fraBar
Caption = "Bar Properties"
Height = 1935
Left = 2760
TabIndex = 2
Top = 60
Width = 2055
Begin VB.CheckBox chkItemsEnabled
Caption = "Items E&nabled"
Height = 255
Left = 180
TabIndex = 7
Top = 1560
Width = 1695
End
Begin VB.CheckBox chkSorted
Caption = "&Sorted"
Height = 255
Left = 180
TabIndex = 6
Top = 1260
Width = 1695
End
Begin VB.CheckBox chkVisible
Caption = "&Visible"
Height = 255
Left = 180
TabIndex = 5
Top = 960
Width = 1695
End
Begin VB.CheckBox chkListStyle
Caption = "&List Style"
Height = 255
Left = 180
TabIndex = 4
Top = 660
Width = 1695
End
Begin VB.ComboBox cboBar
Height = 315
Left = 120
Style = 2 'Dropdown List
TabIndex = 3
Top = 240
Width = 1815
End
End
Begin VB.TextBox txtDragDrop
Height = 2295
Left = 2760
MultiLine = -1 'True
OLEDropMode = 1 'Manual
ScrollBars = 2 'Vertical
TabIndex = 1
Text = "frmTestToolBoxBar.frx":1272
Top = 2280
Width = 3795
End
Begin VB.CommandButton cmdNext
Caption = "Select Next"
Height = 435
Left = 4920
TabIndex = 0
Top = 60
Width = 1215
End
Begin ComctlLib.ImageList ilsIcons
Left = 3660
Top = 2820
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 327682
BeginProperty Images {0713E8C2-850A-101B-AFC0-4210102A8DA7}
NumListImages = 19
BeginProperty ListImage1 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":1340
Key = ""
EndProperty
BeginProperty ListImage2 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":151A
Key = ""
EndProperty
BeginProperty ListImage3 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":16F4
Key = ""
EndProperty
BeginProperty ListImage4 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":18CE
Key = ""
EndProperty
BeginProperty ListImage5 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":1AA8
Key = ""
EndProperty
BeginProperty ListImage6 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":1C82
Key = ""
EndProperty
BeginProperty ListImage7 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":1E5C
Key = ""
EndProperty
BeginProperty ListImage8 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":2036
Key = ""
EndProperty
BeginProperty ListImage9 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":2210
Key = ""
EndProperty
BeginProperty ListImage10 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":23EA
Key = ""
EndProperty
BeginProperty ListImage11 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":25C4
Key = ""
EndProperty
BeginProperty ListImage12 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":279E
Key = ""
EndProperty
BeginProperty ListImage13 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":2978
Key = ""
EndProperty
BeginProperty ListImage14 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":2B52
Key = ""
EndProperty
BeginProperty ListImage15 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":2D2C
Key = ""
EndProperty
BeginProperty ListImage16 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":2F06
Key = ""
EndProperty
BeginProperty ListImage17 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":30E0
Key = ""
EndProperty
BeginProperty ListImage18 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":32BA
Key = ""
EndProperty
BeginProperty ListImage19 {0713E8C3-850A-101B-AFC0-4210102A8DA7}
Picture = "frmTestToolBoxBar.frx":3494
Key = ""
EndProperty
EndProperty
End
Begin VB.Menu mnuContextTop
Caption = ""
Visible = 0 'False
Begin VB.Menu mnuContext
Caption = "&Delete Tab..."
Index = 0
End
Begin VB.Menu mnuContext
Caption = "&Rename Tab..."
Index = 1
End
Begin VB.Menu mnuContext
Caption = "Cu&t"
Index = 2
Visible = 0 'False
End
Begin VB.Menu mnuContext
Caption = "&Copy"
Index = 3
Visible = 0 'False
End
Begin VB.Menu mnuContext
Caption = "&Paste"
Index = 4
Visible = 0 'False
End
Begin VB.Menu mnuContext
Caption = "&Delete"
Index = 5
Visible = 0 'False
End
Begin VB.Menu mnuContext
Caption = "-"
Index = 6
End
Begin VB.Menu mnuContext
Caption = "&Add Tab"
Index = 7
End
Begin VB.Menu mnuContext
Caption = "S&ort Items Alphabetically"
Index = 8
End
Begin VB.Menu mnuContext
Caption = "&Show All Tabs"
Index = 9
End
Begin VB.Menu mnuContext
Caption = "&List View"
Index = 10
End
Begin VB.Menu mnuContext
Caption = "-"
Index = 11
End
Begin VB.Menu mnuContext
Caption = "Move &Up"
Index = 12
End
Begin VB.Menu mnuContext
Caption = "Move &Down"
Index = 13
End
End
End
Attribute VB_Name = "frmTestToolBoxBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_sComboKey() As String
Private m_cMenuBar As cToolBoxBar
Private m_cMenuItem As cToolItem
Private Sub addItems(cBar As cToolBoxBar)
Dim i As Long
Dim lSize As Long
If (cBar.Index = 1) Then
lSize = ilsIcons.ListImages.Count
Else
lSize = Rnd * ilsIcons.ListImages.Count
End If
For i = 1 To lSize
cBar.Items.Add "ITEM" & i & ":" & cBar.Index, , "Item " & i, i - 1
Next i
End Sub
Private Sub cboBar_Click()
cboBar.Tag = "NOSET"
With tbxLeft.Bars(m_sComboKey(cboBar.ListIndex))
chkListStyle.Value = Abs(.ListStyle)
chkVisible.Value = Abs(.Visible)
chkSorted.Value = Abs(.Sorted)
chkItemsEnabled.Enabled = (.Items.Count > 0)
If (.Items.Count > 0) Then
chkItemsEnabled.Value = Abs(.Items(1).Enabled)
End If
End With
cboBar.Tag = ""
End Sub
Private Sub chkItemsEnabled_Click()
If (cboBar.Tag = "") Then
Dim i As Long
With tbxLeft.Bars(m_sComboKey(cboBar.ListIndex)).Items
For i = 1 To .Count
.Item(i).Enabled = (chkItemsEnabled.Value = vbChecked)
Next i
End With
cboBar_Click
End If
End Sub
Private Sub chkListStyle_Click()
If (cboBar.Tag = "") Then
tbxLeft.Bars(m_sComboKey(cboBar.ListIndex)).ListStyle =
(chkListStyle.Value = vbChecked)
cboBar_Click
End If
End Sub
Private Sub chkSorted_Click()
If (cboBar.Tag = "") Then
tbxLeft.Bars(m_sComboKey(cboBar.ListIndex)).Sorted = (chkSorted.Value =
vbChecked)
cboBar_Click
End If
End Sub
Private Sub chkVisible_Click()
If (cboBar.Tag = "") Then
tbxLeft.Bars(m_sComboKey(cboBar.ListIndex)).Visible = (chkVisible.Value =
vbChecked)
cboBar_Click
End If
End Sub
Private Sub cmdNewInstance_Click()
Dim f As New frmTestToolBoxBar
f.Show
End Sub
Private Sub cmdNext_Click()
Dim l As Long
If Not (tbxLeft.SelectedBar Is Nothing) Then
Dim cNext As cToolBoxBar
Dim lIndex As Long
Set cNext = tbxLeft.SelectedBar.NextBar
If (cNext Is Nothing) Then
' Off the bottom:
If (tbxLeft.Bars(1).Visible) Then
lIndex = 1
Else
Set cNext = tbxLeft.Bars(1).NextBar
If Not (cNext Is Nothing) Then
lIndex = cNext.Index
Else
' no visible bars:
Exit Sub
End If
End If
Else
lIndex = cNext.Index
End If
tbxLeft.Bars(lIndex).Selected = True
End If
End Sub
Private Sub Form_Load()
Dim cBar As cToolBoxBar
Dim cItem As cToolItem
tbxLeft.ImageList = ilsIcons
Set cBar = tbxLeft.Bars.Add("COMPONENTS", , "Components")
addItems cBar
Set cBar = tbxLeft.Bars.Add("DATA", , "Data")
addItems cBar
Set cBar = tbxLeft.Bars.Add("GENERAL", , "General")
addItems cBar
Set cBar = tbxLeft.Bars.Add("WINDOWFORM", , "Windows Forms")
addItems cBar
Set cBar = tbxLeft.Bars.Add("CLIPBOARD", , "Clipboard Ring")
cBar.Items.Add "C1", , Clipboard.GetText
Dim i As Long
ReDim m_sComboKey(0 To tbxLeft.Bars.Count - 1) As String
For i = 1 To tbxLeft.Bars.Count
cboBar.AddItem tbxLeft.Bars(i).Caption
m_sComboKey(i - 1) = tbxLeft.Bars(i).Key
Next i
cboBar.ListIndex = 0
End Sub
Private Sub mnuContext_Click(Index As Integer)
Dim sI As String
Dim i As Long
Select Case Index
Case 0
' delete
If (vbYes = MsgBox("Are you sure you want to delete the tab " &
m_cMenuBar.Caption & "?", vbYesNo Or vbQuestion)) Then
tbxLeft.Bars.Remove m_cMenuBar.Key
End If
Case 1
' rename
If (m_cMenuItem Is Nothing) Then
sI = InputBox("Enter the the new name for tab " & m_cMenuBar.Caption,
App.Title)
If (Len(sI) > 0) Then
m_cMenuBar.Caption = sI
End If
Else
sI = InputBox("Enter the new name for item " & m_cMenuItem.Caption,
App.Title)
If (Len(sI) > 0) Then
m_cMenuItem.Caption = sI
End If
End If
Case 2
Case 3
Case 4
Case 5
' delete item
If (vbYes = MsgBox("Are you sure you want to delete the item " &
m_cMenuItem.Caption & "?", vbYesNo Or vbQuestion)) Then
tbxLeft.Bars(m_cMenuBar.Key).Items.Remove m_cMenuItem.Key
End If
Case 7
' add
sI = InputBox("Enter the new tab name:", App.Title)
If (Len(sI) > 0) Then
tbxLeft.Bars.Add "USER" & tbxLeft.Bars.Count, , sI
End If
Case 8
' sort
mnuContext(Index).Checked = Not (mnuContext(Index).Checked)
m_cMenuBar.Sorted = mnuContext(Index).Checked
Case 9
' show all
For i = 1 To tbxLeft.Bars.Count
tbxLeft.Bars(i).Visible = True
Next i
Case 10
' list view
mnuContext(Index).Checked = Not (mnuContext(Index).Checked)
m_cMenuBar.ListStyle = mnuContext(Index).Checked
Case 12
' move up
If (m_cMenuItem Is Nothing) Then
m_cMenuBar.MovePrevious
Else
m_cMenuItem.MovePrevious
End If
Case 13
' move down
If (m_cMenuItem Is Nothing) Then
m_cMenuBar.MoveNext
Else
m_cMenuItem.MoveNext
End If
End Select
End Sub
Private Sub tbxLeft_BarClick(Bar As cToolBoxBar, ByVal Button As
MouseButtonConstants, ByVal Shift As ShiftConstants, ByVal x As Single, ByVal
y As Single)
If (Button = vbRightButton) Then
Set m_cMenuBar = Bar
Set m_cMenuItem = Nothing
mnuContext(0).Visible = True
mnuContext(1).Caption = "Re&name Tab"
mnuContext(2).Visible = False
mnuContext(3).Visible = False
mnuContext(4).Visible = False
mnuContext(5).Visible = False
' Move up:
mnuContext(12).Enabled = Not (Bar.PreviousBar Is Nothing)
' Move down:
mnuContext(13).Enabled = Not (Bar.NextBar Is Nothing)
' Sort
mnuContext(8).Checked = (Bar.Sorted)
' ListView
mnuContext(10).Checked = (Bar.ListStyle)
Me.PopupMenu mnuContextTop, , x, y
End If
End Sub
Private Sub tbxLeft_BarSelected(Bar As cToolBoxBar)
Dim i As Long
For i = 0 To cboBar.ListCount - 1
If (m_sComboKey(i) = Bar.Key) Then
cboBar.ListIndex = i
Exit For
End If
Next i
End Sub
Private Sub tbxLeft_ItemClick(Item As cToolItem, ByVal Button As
MouseButtonConstants, ByVal Shift As ShiftConstants, ByVal x As Single, ByVal
y As Single)
If (Button = vbRightButton) Then
If (Item Is Nothing) Then
If Not (tbxLeft.SelectedBar Is Nothing) Then
If Not (tbxLeft.SelectedBar.SelectedItem Is Nothing) Then
Set Item = tbxLeft.SelectedBar.SelectedItem
Else
Exit Sub
End If
Else
Exit Sub
End If
Item.EnsureVisible
End If
Set m_cMenuBar = Item.OwnerBar
Set m_cMenuItem = Item
mnuContext(0).Visible = False
mnuContext(1).Caption = "Re&name Item"
mnuContext(2).Visible = True
mnuContext(3).Visible = True
mnuContext(4).Visible = True
mnuContext(5).Visible = True
' Move up:
mnuContext(12).Enabled = Not (Item.PreviousItem Is Nothing)
' Move down:
mnuContext(13).Enabled = Not (Item.NextItem Is Nothing)
' Sort
mnuContext(8).Checked = (m_cMenuBar.Sorted)
' ListView
mnuContext(10).Checked = (m_cMenuBar.ListStyle)
Me.PopupMenu mnuContextTop, , x, y
End If
End Sub
Private Sub tbxLeft_ItemDblClick(Item As cToolItem, ByVal Button As
MouseButtonConstants, ByVal Shift As ShiftConstants, ByVal x As Single, ByVal
y As Single)
MsgBox "Double-clicked " & Item.Caption, vbInformation
End Sub
Private Sub tbxLeft_KeyPress(KeyAscii As Integer)
If (KeyAscii = vbKeyReturn) Then
If Not (tbxLeft.SelectedBar.SelectedItem Is Nothing) Then
MsgBox "Return on " & tbxLeft.SelectedBar.SelectedItem.Caption,
vbInformation
End If
End If
End Sub
Private Sub txtDragDrop_OLECompleteDrag(Effect As Long)
Debug.Print "OLECompleteDrag"
End Sub
Private Sub txtDragDrop_OLEDragDrop(Data As DataObject, Effect As Long, Button
As Integer, Shift As Integer, x As Single, y As Single)
Debug.Print "OLEDragDrop"
Dim b() As Byte
Effect = vbDropEffectNone
If (Data.GetFormat(tbbCfItemIdentifier)) Then
b = Data.GetData(tbbCfItemIdentifier)
Dim cT As cToolItem
Set cT = tbxLeft.ItemFromDragData(b)
If (cT.Enabled) Then
If (cT.OwnerBar.Key = "CLIPBOARD") Then
Effect = vbDropEffectCopy
txtDragDrop.SelText = cT.Caption
End If
End If
End If
End Sub
Private Sub txtDragDrop_OLEDragOver(Data As DataObject, Effect As Long, Button
As Integer, Shift As Integer, x As Single, y As Single, State As Integer)
Dim b() As Byte
Effect = vbDropEffectNone
If (Data.GetFormat(tbbCfItemIdentifier)) Then
b = Data.GetData(tbbCfItemIdentifier)
Dim cT As cToolItem
Set cT = tbxLeft.ItemFromDragData(b)
If (cT.Enabled) And (cT.OwnerBar.Key = "CLIPBOARD") Then
Effect = vbDropEffectCopy
End If
End If
End Sub