ctListBar控件制作菜单（仿天正屏幕菜单）
本帖最后由 作者 于 2008-2-15 10:55:38 编辑 <br /><br /> <p>用这个控件可以制作出色的仿天正的菜单，我想这个也是非常好的办法，一直都没有想到好的方法来实现，而ACCONT及OCX有下载，但没有介绍相关的方法来调用。用这个控件网上有现成的VB参考程序，方便宜行，而其中有不少问题存在：如何把图标放在左边？如何自动加载？如何与程序调用快捷？如何文本方式存储菜单信息？这都有待解决？这个程序基本解决，当然要感谢各位明经高手。本菜单程序可以免费共享哟，感谢郑立凯，张帆等出的VBA本书。本人常用LISP，而VBA则作为软件的补充。让界面更友好。</p> 图片呢，看不见的呀 创建一个窗体，在上面布置CommandButton1及ctListBar1，ImageList1控件Dim strListName, strItemName As String
Dim intListNum, intItemNum As Integer
Sub userForm1_Load()
Call CommandButton1_Click
End Sub
Private Sub CommandButton1_Click()
ctListBar1.IconSize = 1
ctListBar1.AddList "翻译接线"
ctListBar1.AddList "标识"
ctListBar1.AddListItem 1, "导线", ImageList1.ListImages(1).Picture
ctListBar1.AddListItem 1, "常闭", ImageList1.ListImages(59).Picture
ctListBar1.AddListItem 1, "小林", ImageList1.ListImages(3).Picture
ctListBar1.AddListItem 1, "小B", ImageList1.ListImages(4).Picture
ctListBar1.AddListItem 1, "张三", ImageList1.ListImages(5).Picture
ctListBar1.AddListItem 1, "李四", ImageList1.ListImages(6).Picture
ctListBar1.AddListItem 2, "李四", ImageList1.ListImages(7).Picture
End Sub
Sub ctListBar1_ItemClick1(ByVal nList As Integer, ByVal nItem As Integer)
Select Case nList And nItem
Case 1 And 1
MsgBox "A_1"
ThisDrawing.SendCommand ("line" & vbCr)
Case 1 And 2
MsgBox "A_2"
ThisDrawing.SendCommand ("(JXYJ1" & """CB_2""" & ")" & vbCr)
Case 1 And 3
MsgBox "A_3"
ThisDrawing.SendCommand ("(JXYJ1" & """CB_1""" & ")" & vbCr)
Case 2 And 1
ThisDrawing.SendCommand ("(JXYJ1" & """CB_5""" & ")" & vbCr)
Case 2 And 2
MsgBox "B_2"
Case 3 And 1
MsgBox "C_1"
Case 3 And 2
MsgBox "C_2"
Case 4 And 1
MsgBox "D_1"
Case 5 And 1
MsgBox "E_1"
'以上为第五级目录的连接
End Select
End Sub
Private Sub ctListBar1_ItemClick(ByVal nList As Integer, ByVal nItem As Integer)
MsgBox "你点击的项目名称是：" & ctListBar1.ItemText(nList, nItem), vbInformation, nList & "-" & nItem
End Sub
将下面这个过程放在thisdrawing里
Sub AcadDocument_Activate()
UserForm1.Show vbModeless
End Sub
接下来就是如何文本文件方式进行存储，在菜单加载是加载。 <p></p><p>那么就看大家努力把它改得合理一些，让大家都来共享这样的成果哟</p> <p></p><p>现将ctlistbar使用说明及控件发上来，那么就只有从文本文件读取一行，并将每行分成四个部分</p><p>**×× ×× </p><p>组代号 组名</p><p>ID×× ×× ×× ××</p><p>序号 名称 图标 命令</p><p><font color="#ff3300">希望高手来化解这样的程序，让更多的朋友有一个免费的屏幕菜单来使用哟。</font></p><p>文本文件格式如下：</p><p>&&&BARNAME&&&小林电气</p><p>**lin 导线<br/>id00 原理线 JXHLH LINE<br/>**ck 常开<br/>id20 普通 JXHLH (JXYJ1 "CK_1")<br/>id21 刀开关 JXHLH (JXYJ1 "CK_18")<br/>id22 负荷开关 JXHLH (JXYJ1 "CK_20")<br/>id23 断路器 JXHLH (JXYJ1 "CK_19")<br/>id24 接触器 JXHLH (JXYJ1 "CK_17")<br/>id25 按钮 JXHLH (JXYJ1 "CK_3")<br/>id26 热继电器 JXHLH (JXYJ1 "CK_14")<br/>**cb 常闭<br/>id27 普通 JXHLH (JXYJ1 "CB_1")<br/>id28 按钮 JXHLH (JXYJ1 "CB_2")<br/>id29 热继电器 JXHLH (JXYJ1 "CB_5")<br/>**xq 线圈<br/>id30 普通 JXHLH (JXYJ1 "XQ_1")<br/>id31 时间继电器 JXHLH (JXYJ1 "XQ_2")<br/>id32 过流继电器 JXHLH (JXYJ1 "XQ_3")<br/>id33 欠流继电器 JXHLH (JXYJ1 "XQ_4")<br/>id34 过压继电器 JXHLH (JXYJ1 "XQ_5")<br/>id35 欠压继电器 JXHLH (JXYJ1 "XQ_6")<br/>**fuse 其他元件<br/>id36 熔断器 JXFUS (JXYJ1 "FU_1")<br/>id37 信号灯 JXHLH (JXYJ1 "XH_1")<br/>id38 交叉点 JXHLH lindonut<br/>**INIT 标号线号 <br/>id2 标出线号 JXHLH xhbz</p> 压缩包密码？？？？？ 密码..... <p><br/>Public ptcen As Variant<br/>Public bpick As Boolean<br/>Public strpath As String</p><p>Private Sub Form_Load()<br/>Dim strtemp As String<br/>Dim nfile, listnum, m As Integer<br/>On Error GoTo errhandler<br/>nfile = FreeFile<br/>bpick = False<br/>Open App.Path & "\xiaolin.INI" For Input As #nfile<br/>listnum = 1<br/>ctListBar1.IconSize = IconSmall<br/>While Not EOF(nfile)</p><p> Line Input #nfile, strtemp<br/> If Left$(strtemp, 1) = "*" Then<br/> strtemp = Right$(strtemp, (Len(strtemp) - 2))<br/> 'MsgBox InStr(strtemp, ",")<br/> ctListBar1.AddList strtemp<br/> listnum = listnum + 1<br/> Else<br/> m = InStr(strtemp, ",") - 1<br/> <br/> strtemp = Left$(strtemp, m)<br/> intListNum = listnum<br/> 'If intListNum <> 0 Then strItemName = strtemp<br/> If strtemp <> "" Then ctListBar1.AddListItem listnum, strtemp, ctListBar1.Image1<br/> End If<br/> <br/> Wend<br/> Close #nfile<br/> Exit Sub<br/>errhandler:<br/> MsgBox "error no."<br/> Err.Clear<br/> <br/>End Sub</p><p>Private Sub ctListBar1_ItemClick(ByVal nList As Integer, ByVal nItem As Integer)<br/> Dim strtemp As String<br/>Dim nfile, listnum As Integer<br/>nfile = FreeFile<br/> MsgBox "你点击的项目名称是：" & ctListBar1.ItemText(nList, nItem), vbInformation, nList & "-" & nItem<br/> Open App.Path & "\xiaolin.INI" For Input As #nfile<br/> While Not EOF(nfile)</p><p> Line Input #nfile, strtemp<br/> If Left$(strtemp, InStr(strtemp, ",")) = ctListBar1.ItemText(nList, nItem) & "," Then<br/> strtemp = Right$(strtemp, (Len(strtemp) - InStr(strtemp, ",")))<br/> 'MsgBox ctListBar1.ItemText(nList, nItem)<br/> MsgBox "ThisDrawing.SendCommand" & " (""" & strtemp & """ & vbCr)"<br/> End If<br/> Wend<br/> Close #nfile<br/>End Sub</p><p>xiaolin.ini文件内容</p><p>原理线,LINE<br/>**常开<br/>普通常开,(JXYJ1 "CK_1")<br/>刀开关常开,(JXYJ1 "CK_18")<br/>负荷开关,(JXYJ1 "CK_20")<br/>断路器常开,(JXYJ1 "CK_19")<br/>接触器常开,(JXYJ1 "CK_17")<br/>按钮常开,(JXYJ1 "CK_3")<br/>热继电器常开,(JXYJ1 "CK_14")<br/>**常闭<br/>普通常闭,(JXYJ1 "CB_1")<br/>按钮常闭,(JXYJ1 "CB_2")<br/>热继电器常闭,(JXYJ1 "CB_5")<br/>**线圈<br/>普通线圈,(JXYJ1 "XQ_1")<br/>时间继电器,(JXYJ1 "XQ_2")<br/>过流继电器,(JXYJ1 "XQ_3")<br/>欠流继电器,(JXYJ1 "XQ_4")<br/>过压继电器,(JXYJ1 "XQ_5")<br/>欠压继电器,(JXYJ1 "XQ_6")<br/>**其他元件</p><p><br/></p><p>这是我春节期间做的</p><p>1.新建一个窗体 名为Form</p><p>2.在上面放置CTLISTBAR控件名为ctListBar1</p><p>3.xiaolin.ini文件与工程文件放在同一目录下</p><p></p><p>而今问题如下：</p><p>1.如何将相应的命令发送到CAD里执行？</p><p>2.如何实现VB直接操作CAD运行相应命令？</p><p>3.生成EXE文件时为什么会没有调试时的界面？</p><p></p> <p>先查找CAD，找到后调用API做为CAD的子窗体，再显示自制的菜单窗体</p><p>程序中设一全局变量存储CAD的连接，这样就可以用Sendcommand调用</p><p>相应命令了，</p> <p>而今却又发现编译存在问题，在VBA状态下则没有问题，借用明经里的高手</p><p>Function GetSupportPath() As String<br/>Dim strFileName<br/>strFileName = VBE.ActiveVBProject.FileName 'VBE.ActiveVBProject.FileName获取.dvb文件的文件名<br/>GetSupportPath = Left$(strFileName, InStrRev(strFileName, "\"))<br/>End Function</p><p>用GetSupportPath替换掉app.path</p><p>ThisDrawing.SendCommand strtemp + Chr(13)替换掉MsgBox "ThisDrawing.SendCommand" & " (""" & strtemp & """ & vbCr)"</p><p>窗体名及添加一个初始命令，在thisdrawing里加入</p><p>Private Sub AcadDocument_Activate()<br/>UserForm1.Show vbModeless<br/>End Sub</p><p>效果非常不错，呵呵</p>