ActiveBar控件动态添加子菜单的方法
Set ttool = .Tools.Add(0, "File")
ttool.Caption = "文件"
ttool.Style = DDSStandard
我这样写增加了一个“文件”菜单,我想再加一个子菜单“保存”,该怎么写?先谢谢大家了
[解决办法]
UPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUPUP
[解决办法]
Option ExplicitPrivate Sub ab_ToolClick(ByVal Tool As ActiveBar2LibraryCtl.Tool) Debug.Print Tool.Name If Tool.Name = "miFExit" Then Unload MeEnd SubPrivate Sub Form_Load() CreateTools CreateBandsEnd SubPrivate Sub CreateTools()Dim Tool As ActiveBar2LibraryCtl.ToolDim iCat As IntegerDim keys(0) As New ShortCut iCat = 100 Set Tool = ab.Tools.Add(iCat + 1, "mnuFile") Tool.Caption = "文件(&F)": Tool.SubBand = "mnuFile": Tool.Category = "菜单" Set Tool = ab.Tools.Add(iCat + 2, "mnuEdit") Tool.Caption = "编辑(&E)": Tool.SubBand = "mnuEdit": Tool.Category = "菜单" Set Tool = ab.Tools.Add(iCat + 3, "mnuView") Tool.Caption = "视图(&V)": Tool.SubBand = "mnuView": Tool.Category = "菜单" Set Tool = ab.Tools.Add(iCat + 4, "mnuHelp") Tool.Caption = "帮助(&H)": Tool.SubBand = "mnuHelp": Tool.Category = "菜单" iCat = 200 Set Tool = ab.Tools.Add(iCat + 1, "miFNew") Tool.Caption = "新建(&N)...": Tool.Category = "文件" keys(0) = "Control+N" Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\FileNew.bmp") Tool.ShortCuts = keys Set Tool = ab.Tools.Add(iCat + 2, "miFOpen") Tool.Caption = "打开(&O)": Tool.Category = "文件"' Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\FileOpen.bmp") keys(0) = "Control+O" Tool.ShortCuts = keys Set Tool = ab.Tools.Add(iCat + 3, "miFSave") Tool.Caption = "保存(&S)": Tool.Category = "文件"' Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\FileSave.bmp") keys(0) = "Control+S" Tool.ShortCuts = keys Set Tool = ab.Tools.Add(iCat + 4, "miFExit") Tool.Caption = "退出(&X)": Tool.Category = "文件" keys(0) = "Alt+F4" Tool.ShortCuts = keys iCat = 300 Set Tool = ab.Tools.Add(iCat + 3, "miECut") Tool.Caption = "剪切(&U)": Tool.Category = "编辑"' Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\EditCut.bmp") keys(0) = "Control+X" Tool.ShortCuts = keys Set Tool = ab.Tools.Add(iCat + 1, "miECopy") Tool.Caption = "复制(&C)": Tool.Category = "编辑"' Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\EditCopy.bmp") keys(0) = "Control+C" Tool.ShortCuts = keys Set Tool = ab.Tools.Add(iCat + 2, "miEPaste") Tool.Caption = "打开(&O)": Tool.Category = "编辑" ' Tool.SetPicture ddITNormal, LoadPicture(App.Path & "\icons\EditPsate.bmp") keys(0) = "Control+V" Tool.ShortCuts = keys iCat = 400 Set Tool = ab.Tools.Add(iCat + 1, "miVToolbar") Tool.Caption = "工具栏(&T)": Tool.Category = "视图" Set Tool = ab.Tools.Add(iCat + 2, "miVStatusBar") Tool.Caption = "状态栏(&S)": Tool.Category = "视图" iCat = 500 Set Tool = ab.Tools.Add(iCat + 1, "miHAbout") Tool.Caption = "关于(&A)": Tool.Category = "帮助" keys(0) = "F1" Tool.ShortCuts = keysEnd SubPrivate Sub CreateBands()Dim b As ActiveBar2LibraryCtl.Band Set b = ab.Bands.Add("mnuFile"): b.Type = ddBTPopup With b.Tools .Insert .Count, ab.Tools("miFNew") .Insert .Count, ab.Tools("miFOpen") .Insert .Count, ab.Tools("miFSave") .Insert .Count, ab.Tools("miFExit") End With Set b = ab.Bands.Add("mnuEdit"): b.Type = ddBTPopup With b.Tools .Insert .Count, ab.Tools("miECut") .Insert .Count, ab.Tools("miECopy") .Insert .Count, ab.Tools("miEPaste") End With Set b = ab.Bands.Add("mnuView"): b.Type = ddBTPopup With b.Tools .Insert .Count, ab.Tools("miVToolbar") .Insert .Count, ab.Tools("miVStatusBar") End With Set b = ab.Bands.Add("mnuHelp"): b.Type = ddBTPopup b.Tools.Insert b.Tools.Count, ab.Tools("miHAbout") Set b = ab.Bands.Add("mnuMain"): b.Type = ddBTMenuBar ab.Tools("mnuFile").SubBand = "mnuFile" ab.Tools("mnuEdit").SubBand = "mnuEdit" ab.Tools("mnuView").SubBand = "mnuView" ab.Tools("mnuHelp").SubBand = "mnuHelp" With b.Tools .Insert .Count, ab.Tools("mnuFile") .Insert .Count, ab.Tools("mnuEdit") .Insert .Count, ab.Tools("mnuView") .Insert .Count, ab.Tools("mnuHelp") End With ab.RecalcLayout ab.RefreshEnd Sub
[解决办法]
为什么不看例子呢?其实对于不了解的控件,最快了解并使用的方法就是看例子加上帮助文件了...
你要的这个功能,例子中100%有完全一样的代码...