vbalCommandBar (45K)
5 Nov 2003
First Posted
(Incomplete) Menus From First Principles
vbAccelerator Office Docking Bar Control
vbAccelerator - Contents of code file: frmTest.frm
VERSION 5.00
Object = "*\AvbalCmdBar.vbp"
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Begin VB.Form frmTestCommandBar
Caption = "Form1"
ClientHeight = 8805
ClientLeft = 3555
ClientTop = 1740
ClientWidth = 10470
BeginProperty Font
Name = "Tahoma"
Size = 8.25
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
LinkTopic = "Form1"
ScaleHeight = 587
ScaleMode = 3 'Pixel
ScaleWidth = 698
Begin VB.ListBox lstEvents
Height = 2790
Left = 1260
TabIndex = 7
Top = 4620
Width = 4575
End
Begin vbalCmdBar.vbalCommandBar cmdBar
Height = 3675
Index = 3
Left = 7020
TabIndex = 6
Top = 3000
Width = 2775
_ExtentX = 4895
_ExtentY = 6482
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.ComboBox cboScript
Height = 315
Left = 5460
TabIndex = 5
Text = "English"
Top = 2100
Width = 1215
End
Begin VB.ComboBox cboSize
Height = 315
Left = 4140
TabIndex = 4
Text = "8"
Top = 2100
Width = 1215
End
Begin VB.ComboBox cboFont
Height = 315
Left = 2820
TabIndex = 3
Text = "Tahoma"
Top = 2100
Width = 1215
End
Begin MSComctlLib.ImageList ilsIcons
Left = 360
Top = 1980
_ExtentX = 1005
_ExtentY = 1005
BackColor = -2147483643
ImageWidth = 16
ImageHeight = 16
MaskColor = 12632256
_Version = 393216
BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628}
NumListImages = 22
BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":0000
Key = ""
EndProperty
BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":015A
Key = ""
EndProperty
BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":02B4
Key = ""
EndProperty
BeginProperty ListImage4 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":040E
Key = ""
EndProperty
BeginProperty ListImage5 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":0568
Key = ""
EndProperty
BeginProperty ListImage6 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":06C2
Key = ""
EndProperty
BeginProperty ListImage7 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":081C
Key = ""
EndProperty
BeginProperty ListImage8 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":0976
Key = ""
EndProperty
BeginProperty ListImage9 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":0AD0
Key = ""
EndProperty
BeginProperty ListImage10 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":0C2A
Key = ""
EndProperty
BeginProperty ListImage11 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":0D84
Key = ""
EndProperty
BeginProperty ListImage12 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":0EDE
Key = ""
EndProperty
BeginProperty ListImage13 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":1038
Key = ""
EndProperty
BeginProperty ListImage14 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":1192
Key = ""
EndProperty
BeginProperty ListImage15 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":12EC
Key = ""
EndProperty
BeginProperty ListImage16 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":1446
Key = ""
EndProperty
BeginProperty ListImage17 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":15A0
Key = ""
EndProperty
BeginProperty ListImage18 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":16FA
Key = ""
EndProperty
BeginProperty ListImage19 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":1854
Key = ""
EndProperty
BeginProperty ListImage20 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":19AE
Key = ""
EndProperty
BeginProperty ListImage21 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":1B08
Key = ""
EndProperty
BeginProperty ListImage22 {2C247F27-8591-11D1-B16A-00C0F0283628}
Picture = "frmTest.frx":1C62
Key = ""
EndProperty
EndProperty
End
Begin vbalCmdBar.vbalCommandBar cmdBar
Height = 495
Index = 1
Left = 240
TabIndex = 1
Top = 780
Width = 10035
_ExtentX = 17701
_ExtentY = 873
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 vbalCmdBar.vbalCommandBar cmdBar
Height = 495
Index = 0
Left = 180
TabIndex = 0
Top = 2340
Width = 9855
_ExtentX = 17383
_ExtentY = 873
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 vbalCmdBar.vbalCommandBar cmdBar
Height = 495
Index = 2
Left = 180
TabIndex = 2
Top = 1560
Width = 9915
_ExtentX = 17489
_ExtentY = 873
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 vbalCmdBar.vbalCommandBar cmdBar
Height = 5715
Index = 4
Left = 180
TabIndex = 8
Top = 3000
Width = 495
_ExtentX = 873
_ExtentY = 10081
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 = "frmTestCommandBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub createCommandBars()
Dim i As Long
Dim bar As cCommandBar
Dim btn As cButton
Dim btns As cCommandBarButtons
' --------------------------------------------------------
'
' create the items we're going to use.
' Buttons and CommandBars are global: it doesn't matter
' which control instance you use to create them,
' the other toolbars will reflect the same set of items.
' Remember the command bars are global to your *project*
' not just the form that holds the controls
'
' --------------------------------------------------------
With cmdBar(0)
With .Buttons
Set btn = .Add("NEW", 0, "&New...", , "New", "N", vbCtrlMask)
btn.ShowCaptionInToolbar = True
.Add "OPEN", 1, "&Open...", , "Open", "O", vbCtrlMask
Set btn = .Add("SAVE", 2, "&Save", , "Save", "S", vbCtrlMask)
btn.Enabled = False
.Add "TOOLS:FILE:SEPARATOR", , , eSeparator
.Add "PRINT", 3, "&Print...", , "Print", "P", vbCtrlMask
.Add "PRINTPREVIEW", 4, "Print Pre&view", , "Print Preview"
.Add "TOOLS:PRINT:SEPARATOR", , , eSeparator
.Add "FIND", 5, "&Find...", , "Find", "F", vbCtrlMask
.Add "TOOLS:FIND:SEPARATOR", , , eSeparator
.Add "CUT", 6, "Cu&t", , "Cut", "X", vbCtrlMask
.Add "COPY", 7, "&Copy", , "Copy", "C", vbCtrlMask
Set btn = .Add("PASTE", 8, "&Paste", , "Paste", "V", vbCtrlMask)
btn.Enabled = False
.Add "UNDO", 9, "&Undo", , "Undo", "Z", vbCtrlMask
.Add "TOOLS:CLIP:SEPARATOR", , , eSeparator
.Add "INSERTDATETIME", 10, "Insert Date/Time", , "Insert Date/Time"
.Add "FONT", 19, "&Font...", , "Change Font"
Set btn = .Add("VIEWOPTION", , "&View", , "Set Viewing Options")
btn.ShowCaptionInToolbar = True
btn.ShowDropDownInToolbar = True
.Add "FMT:INIT:SEPARATOR", , , eSeparator
Set btn = .Add("FONTFACE", 19, , ePanel, "Font face")
btn.PanelWidth = 90
btn.PanelControl = cboFont
Set btn = .Add("FONTSIZE", 19, , ePanel, "Font Size")
btn.PanelWidth = 36
btn.PanelControl = cboSize
Set btn = .Add("FONTSCRIPT", , , ePanel, "Font Script")
btn.PanelWidth = 90
btn.PanelControl = cboScript
.Add "FMT:FONT:SEPARATOR", , , eSeparator
.Add "BOLD", 11, "&Bold", eCheck, "Bold", "B", vbCtrlMask
.Add "ITALIC", 12, "&Italic", eCheck, "Italic", "I", vbCtrlMask
.Add "UNDERLINE", 13, "&Underline", eCheck, "Underline", "U",
vbCtrlMask
.Add "COLOUR", 21, "&Colour", eSplit, "Formats the selection with
colour"
.Add "FMT:STYLE:SEPARATOR", , , eSeparator
.Add "ALIGNLEFT", 15, "Align &Left", eRadio, "Align text left"
.Add "ALIGNCENTRE", 16, "Centre", eRadio, "Align text centre"
.Add "ALIGNRIGHT", 17, "Align &Right", eRadio, "Align text right"
.Add "FMT:PAR:SEPARATOR", , , eSeparator
Set btn = .Add("BULLETS", 18, "&Bullets", eCheck, "Bullets")
btn.Checked = True
Set btn = .Add("FILE", , "&File")
btn.ShowCaptionInToolbar = True
Set btn = .Add("EDIT", , "&Edit")
btn.ShowCaptionInToolbar = True
Set btn = .Add("VIEW", , "&View")
btn.ShowCaptionInToolbar = True
Set btn = .Add("INSERT", , "&Insert")
btn.ShowCaptionInToolbar = True
btn.Enabled = False
Set btn = .Add("FORMAT", , "&Format")
btn.ShowCaptionInToolbar = True
btn.Enabled = False
Set btn = .Add("HELP", , "&Help")
btn.ShowCaptionInToolbar = True
btn.Enabled = False
Set btn = .Add("SAVEAS", , "Save &As...")
btn.Enabled = False
.Add "PAGESETUP", , "Page Set&up..."
For i = 1 To 8
Set btn = .Add("FILE:MRU:" & i, , "")
btn.Visible = False
Next i
Set btn = .Add("FILE:MRU:SEPARATOR", , , eSeparator)
btn.Visible = False
.Add "SEND", , "Sen&d...", , "Send as a file through electronic mail"
.Add "FILE:SEND:SEPARATOR", , , eSeparator
.Add "EXIT", , "E&xit"
.Add "EDIT:UNDO:SEPARATOR", , , eSeparator
.Add "PASTESPECIAL", , "Paste &Special", , "Insert clipboard content
with options"
.Add "CLEAR", , "&Clear", , , "[DEL]"
.Add "SELECTALL", , "Select &All", , , "A", vbCtrlMask
.Add "FINDNEXT", , "&Find Next", , , "[F3]"
.Add "REPLACE", , "&Replace", , , "H", vbCtrlMask
.Add "LINKS", , "Lin&ks..."
.Add "OBJECTPROPERTIES", , "Object &Properties..."
.Add "OBJECT", , "&Object..."
.Add "TOOLBARS", , "&Toolbars"
.Add "STANDARD", , "&Tool bar", eCheck
.Add "FORMATBAR", , "&Format bar", eCheck
.Add "RULER", , "&Ruler", eCheck
.Add "STATUSBAR", , "&Status Bar", eCheck
.Add "VIEW:SEPARATOR", , , eSeparator
.Add "OPTIONS", , "&Options..."
.Add "INSERTOBJECT", , "&Object..."
.Add "FORMATFONT", , "&Font..."
.Add "BULLETSTYLE", , "&Bullet Style..."
.Add "PARAGRAPH", , "&Paragraph..."
.Add "TABS", , "&Tabs..."
.Add "HELPTOPICS", 19, "&Help Topics", , , "[F1]"
.Add "HELP:SEPARATOR", , , eSeparator
.Add "HELP:ABOUT", , "&About..."
End With
' --------------------------------------------------------
' Create the command bars:
' --------------------------------------------------------
' Toolbar:
Set bar = .CommandBars.Add("STANDARD", "Tool Bar")
Set btns = bar.Buttons
btns.Add .Buttons("NEW")
btns.Add .Buttons("OPEN")
btns.Add .Buttons("SAVE")
btns.Add .Buttons("TOOLS:FILE:SEPARATOR")
btns.Add .Buttons("PRINT")
btns.Add .Buttons("PRINTPREVIEW")
btns.Add .Buttons("TOOLS:PRINT:SEPARATOR")
btns.Add .Buttons("FIND")
btns.Add .Buttons("TOOLS:FIND:SEPARATOR")
btns.Add .Buttons("CUT")
btns.Add .Buttons("COPY")
btns.Add .Buttons("PASTE")
btns.Add .Buttons("UNDO")
btns.Add .Buttons("TOOLS:CLIP:SEPARATOR")
btns.Add .Buttons("INSERTDATETIME")
' Format bar:
Set bar = .CommandBars.Add("FORMATBAR", "Format")
Set btns = bar.Buttons
btns.Add .Buttons("FONT")
btns.Add .Buttons("VIEWOPTION")
btns.Add .Buttons("FMT:INIT:SEPARATOR")
btns.Add .Buttons("FONTFACE")
btns.Add .Buttons("FONTSIZE")
btns.Add .Buttons("FONTSCRIPT")
btns.Add .Buttons("FMT:FONT:SEPARATOR")
btns.Add .Buttons("BOLD")
btns.Add .Buttons("ITALIC")
btns.Add .Buttons("UNDERLINE")
btns.Add .Buttons("COLOUR")
btns.Add .Buttons("FMT:STYLE:SEPARATOR")
btns.Add .Buttons("ALIGNLEFT")
btns.Add .Buttons("ALIGNCENTRE")
btns.Add .Buttons("ALIGNRIGHT")
btns.Add .Buttons("FMT:PAR:SEPARATOR")
btns.Add .Buttons("BULLETS")
' Top level menu:
Set bar = .CommandBars.Add("MENU", "Menu")
Set btns = bar.Buttons
btns.Add .Buttons("FILE")
btns.Add .Buttons("EDIT")
btns.Add .Buttons("VIEW")
btns.Add .Buttons("INSERT")
btns.Add .Buttons("FORMAT")
btns.Add .Buttons("HELP")
' File menu items:
Set bar = .CommandBars.Add("FILEMENU")
Set btns = bar.Buttons
btns.Add .Buttons("NEW")
btns.Add .Buttons("OPEN")
btns.Add .Buttons("SAVE")
btns.Add .Buttons("SAVEAS")
btns.Add .Buttons("TOOLS:FILE:SEPARATOR")
btns.Add .Buttons("PRINT")
btns.Add .Buttons("PRINTPREVIEW")
btns.Add .Buttons("PAGESETUP")
btns.Add .Buttons("TOOLS:PRINT:SEPARATOR")
For i = 1 To 8
btns.Add .Buttons("FILE:MRU:" & i)
Next i
btns.Add .Buttons("FILE:MRU:SEPARATOR")
btns.Add .Buttons("SEND")
btns.Add .Buttons("FILE:SEND:SEPARATOR")
btns.Add .Buttons("EXIT")
.Buttons("FILE").bar = bar
' Edit menu items:
Set bar = .CommandBars.Add("EDITMENU")
Set btns = bar.Buttons
btns.Add .Buttons("UNDO")
btns.Add .Buttons("EDIT:UNDO:SEPARATOR")
btns.Add .Buttons("CUT")
btns.Add .Buttons("COPY")
btns.Add .Buttons("PASTE")
btns.Add .Buttons("PASTESPECIAL")
btns.Add .Buttons("CLEAR")
btns.Add .Buttons("SELECTALL")
btns.Add .Buttons("TOOLS:CLIP:SEPARATOR")
btns.Add .Buttons("FIND")
btns.Add .Buttons("FINDNEXT")
btns.Add .Buttons("REPLACE")
btns.Add .Buttons("TOOLS:FIND:SEPARATOR")
btns.Add .Buttons("LINKS")
btns.Add .Buttons("OBJECTPROPERTIES")
btns.Add .Buttons("OBJECT")
.Buttons("EDIT").bar = bar
' View - Toolbars sub meu
Set bar = .CommandBars.Add("TOOLBARS")
Set btns = bar.Buttons
btns.Add .Buttons("STANDARD")
btns.Add .Buttons("FORMATBAR")
.Buttons("TOOLBARS").bar = bar
' View menu items:
Set bar = .CommandBars.Add("VIEWMENU")
Set btns = bar.Buttons
btns.Add .Buttons("TOOLBARS")
btns.Add .Buttons("RULER")
btns.Add .Buttons("STATUSBAR")
btns.Add .Buttons("VIEW:SEPARATOR")
btns.Add .Buttons("OPTIONS")
.Buttons("VIEW").bar = bar
.Buttons("VIEWOPTION").bar = bar
'
End With
End Sub
Private Sub cmdBar_ButtonClick(Index As Integer, btn As vbalCmdBar.cButton)
'
lstEvents.AddItem "ButtonClick (control " & Index & ") - " & btn.Key & " ("
& btn.Caption & ")"
'
End Sub
Private Sub cmdBar_ButtonDropDown(Index As Integer, btn As vbalCmdBar.cButton,
cancel As Boolean)
'
lstEvents.AddItem "ButtonDropDown (control " & Index & ") - " & btn.Key & "
(" & btn.Caption & ")"
'
End Sub
Private Sub cmdBar_RequestNewInstance(Index As Integer, ctl As Object)
'
Dim lNewIndex As Long
lNewIndex = cmdBar.UBound + 1
Load cmdBar(lNewIndex)
Set ctl = cmdBar(lNewIndex)
'
End Sub
Private Sub Form_Load()
' Create all the buttons and command bars
createCommandBars
' associate the image lists
cmdBar(0).ImageList = ilsIcons
cmdBar(1).ImageList = ilsIcons
cmdBar(2).ImageList = ilsIcons
cmdBar(3).ImageList = ilsIcons
' Show the toolbars:
cmdBar(0).Toolbar = cmdBar(0).CommandBars("STANDARD")
cmdBar(1).Toolbar = cmdBar(0).CommandBars("MENU")
cmdBar(2).Toolbar = cmdBar(0).CommandBars("FORMATBAR")
' TestMenu is only here until popup menus work
cmdBar(3).TestMenu
cmdBar(3).Toolbar = cmdBar(0).CommandBars("VIEWMENU")
End Sub
