VB程序员博客

vb中如何才能出现类似于windows 开始菜单效果的那种级联菜单呢？感觉自己拿option控件做的菜单不正规，也不好用，也不美观。 
希望大家给予意见，会尽快结贴给分，谢谢！自定义控件！想多美有多美~~ownerdraw。

vb中如何才能出现类似于windows 开始菜单效果的那种级联菜单呢？感觉自己拿option控件做的菜单不正规，也不好用，也不美观。 
希望大家给予意见，会尽快结贴给分，谢谢！自定义控件！想多美有多美~~ownerdraw。

写了一个类似开始菜单运行的TEXT窗口。但是不能加载.msc命令。请各位帮我一下。代码如下。

Private Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dim SS As String
SS = Text1.Text
strPath = Environ("SystemRoot") & "system32"
Shell strPath & SS, 1
End If
End Sub
我想在输入*.msc命令的时候，（就是开始菜单里运行可以执行的那些.msc命令)。执行以下代码：
strPath = Environ("SystemRoot") & "system32"
Shell strPath & "MMC.EXE " & strPath & SS,vbNormalFocus
问题是我不会写如何判断输入的内容是不是.msc结尾的。请会的不惜赐教。
还有网上找了一个可以直接调用开始菜单里运行的代码。可是出来却是韩文。我想可以调用中文的。请大家帮下。
Private Declare Function SHRunDialog Lib "shell32" Alias "#61" (ByVal hOwner As Long, ByVal Unknown1 As Long, ByVal Unknown2 As Long, ByVal szTitle As String, ByVal szPrompt As String, ByVal uFlags As Long) As Long

Private Sub Command1_Click()
SHRunDialog hWnd, 0, 0, "运行", "点击 确定 运行输入的程序", -chkRunNoMRU
End Sub
"问题是我不会写如何判断输入的内容是不是.msc结尾的"
是指判断text1.text的后4位?那不就是right(s,4)=".msc"吗?顶！！！！！！！！！！！！！！！SHRunDialog 乱码问题参考：http://topic.csdn.net/t/20010730/21/216195.html

运行.msc可以使用shellexecutePrivate Sub Text1_KeyPress(KeyAscii As Integer)
If KeyAscii = 13 Then
Dim SS, ID As String
SS = Text1.Text
ID = Right(SS, 4)
Select Case ID
Case ".msc"
strPath = Environ("SystemRoot") & "system32"
Shell strPath & "MMC.EXE " & strPath & SS, vbNormalFocus
Case Else
strPath = Environ("SystemRoot") & "system32"
Shell strPath & SS, 1
End Select
End If
End Sub
写好了。谢谢了！3楼给的SHRunDialog 乱码问题参考：http://topic.csdn.net/t/20010730/21/216195.html
我去看了。依旧是乱码。

虽然我会在WebBrowser里屏蔽掉IE的那个右键菜单，自定义菜单显示，但是我不想那样做，

只想保留IE原始右键菜单，但里面的那个“查看源文件”屏蔽掉，或者让它 点击无效

经过研究注册表，在注册表里找不到可以修改原始的那个“查看源文件”

注册表只可以添加新的右键菜单，不能删除和修改原始菜单

大虾们支招了ⷂ𗂷ⷼ/
同问ⷂ𗂷ⷂ𗂷有志同道合的兄弟啊，谢谢帮顶ⷂ𗂷

把记事本删除就行了别想了，难道你还能禁掉不同浏览器的主菜单。
甚至遨游还有一个 ViewPage 插件。

Option Explicit

Private hMainMenu As Long                                '主菜单
Private hFirstLevelMenu() As Long                        '一级菜单
Private hSecondLevelMenu As Long                          '二级菜单
Private hThirdLevelMenu As Long                          '三级菜单

Private intMenuCount As Integer                          '菜单总数
Private arrMenuList() As String                      '菜单信息列表数组
Private lngWinProc As Long

Private Const MF_POPUP = &H10
Private Const MF_STRING = &H0
Private Const MF_SEPARATOR = &H800
Private Const MF_BYPOSITION = &H400

Private Const WM_COMMAND = &H111
Private Const GWL_WNDPROC = (-4)

Public Xwx As New Class1
Public R1 As Recordset

'创建菜单API函数
Private Declare Function CreateMenu Lib "User32" () As Long

'创建弹出式菜单API函数
Private Declare Function CreatePopupMenu Lib "User32" () As Long

'插入菜单项API函数
Private Declare Function InsertMenu Lib "User32" Alias "InsertMenuA" _
    (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
 
'追加菜单项API函数
Private Declare Function AppendMenu Lib "User32" Alias "AppendMenuA" _
    (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
 
'修改菜单项API函数
Private Declare Function ModifyMenu Lib "User32" Alias "ModifyMenuA" _
    (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpString As Any) As Long

'设定菜单到对象上API函数
Private Declare Function SetMenu Lib "User32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long

'在对象上画菜单条API函数
Private Declare Function DrawMenuBar Lib "User32" (ByVal hwnd As Long) As Long

'获取一个窗口的菜单句柄
Private Declare Function GetMenu Lib "User32" (ByVal hwnd As Long) As Long

'获取子菜单句柄
Private Declare Function GetSubMenu Lib "User32" (ByVal hMenu As Long, ByVal nPos As Long) As Long

'删除菜单控件, 释放资源
Private Declare Function DestroyMenu Lib "User32" (ByVal hMenu As Long) As Long

'在窗口结构中为指定的窗口设置信息
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 Declare Function CallWindowProc Lib "User32" Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Sub main()

Form1.Show

End Sub

'自动创建菜单过程
Public Sub AutoCreateMenu(frmName As Form)
    Dim i As Integer, j As Integer, k As Integer, intTopMenuCount As Integer
    Dim wFlags As Long
 
    '建立主菜单
    hMainMenu = GetMenu(frmName.hwnd)
    If hMainMenu = 0 Then Exit Sub
 
    '从数据库菜单表中取出信息初始化菜单数组
    Call InitMenuArray
    ReDim hFirstLevelMenu(intMenuCount)
 
    '建立一级菜单  TODO 循环优化
    For i = 1 To intMenuCount
        If arrMenuList(3, i) = "1" Then
            '取得一个弹出式菜单的句柄。
            hFirstLevelMenu(i) = CreatePopupMenu()
   
            '为主菜单添加菜单项及添加Caption属性并指定为弹出式菜单属性。
            AppendMenu hMainMenu, MF_POPUP Or MF_BYPOSITION Or MF_STRING, hFirstLevelMenu(i), arrMenuList(2, i)
            intTopMenuCount = intTopMenuCount + 1
        End If
    Next i
 
    '建立二级菜单
    For i = 1 To intMenuCount
        If arrMenuList(3, i) = "2" Then
            If arrMenuList(2, i) = "-" Then
                wFlags = MF_SEPARATOR Or MF_BYPOSITION
            Else
                wFlags = MF_STRING Or MF_BYPOSITION
            End If
         
            For j = 1 To intMenuCount
                If arrMenuList(5, i) = arrMenuList(1, j) Then                  'i循环菜单的上级菜单编号=j循环菜单的菜单编号
                    hSecondLevelMenu = GetSubMenu(hMainMenu, arrMenuList(4, j))
                 
                    '建立三级菜单
                    If arrMenuList(6, i) = "0" Then                            'END_MENU_FLAG=0 表示还有下属子菜单
                        '取得一个弹出式菜单的句柄。
                        hThirdLevelMenu = CreatePopupMenu()
                        For k = 1 To intMenuCount
                            If arrMenuList(5, k) = arrMenuList(1, i) Then      'k循环菜单的上级菜单编号=i循环菜单的菜单编号
                                AppendMenu hThirdLevelMenu, wFlags, arrMenuList(1, k), arrMenuList(2, k)
                            End If
                        Next k
                     
                        AppendMenu hSecondLevelMenu, wFlags Or MF_POPUP, hThirdLevelMenu, arrMenuList(2, i)
                    Else
                        AppendMenu hSecondLevelMenu, wFlags, arrMenuList(1, i), arrMenuList(2, i)
                    End If
                End If
            Next j
        End If
    Next i
 
    '将主菜单设置给本窗口。
    SetMenu frmName.hwnd, hMainMenu
 
    '响应API创建成的菜单单击事件
    lngWinProc = GetWindowLong(frmName.hwnd, GWL_WNDPROC)
    'SetWindowLong frmName.hwnd, GWL_WNDPROC, AddressOf ClickMenu
   
    SetWindowLong frmName.hwnd, GWL_WNDPROC, AddressOf ClickMenu
   
   
End Sub

'响应API创建成的菜单单击事件
Private Function ClickMenu(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    Select Case wMsg
        Case WM_COMMAND
            Select Case wParam
                Case 900204
                    frmSysUser.Show
                Case 900205
                    frmSysRole.Show
                Case 900210
                    Unload frmMain
            End Select
    End Select
 
    ClickMenu = CallWindowProc(lngWinProc, hwnd, wMsg, wParam, lParam)
End Function

'获取系统菜单总个数
Private Function GetMenuCount() As Integer
    Dim rsMenu As New ADODB.Recordset
   
    Dim gsSql As String
   
 
    gsSql = "SELECT COUNT(*) CNT FROM SYS_MENU"
    If DBQuerySQL(rsMenu, gsSql) = 1 Then
        GetMenuCount = rsMenu("CNT").Value
    Else
        GetMenuCount = 0
    End If
   
    rsMenu.Close
End Function

'菜单数组赋值
  Function InitMenuArray()
    Dim i As Integer
    Dim rsMenu As New ADODB.Recordset
    Dim gsSql  As String
   

    'MenuArray数组描述
    '第一维按顺序分别存放 菜单编号、菜单名称、菜单层级、菜单显示顺序、上级菜单、是否末级菜单、菜单对应窗体名、菜单操作权限
    intMenuCount = GetMenuCount()
   
    ReDim arrMenuList(1 To 8, 1 To intMenuCount)
 
    'gsSql = "SELECT " & _
            "MENU_NO," & _
            "MENU_NAME," & _
            "MENU_LEVEL," & _
            "MENU_SEQ," & _
            "PARENT_MENU," & _
            "END_MENU_FLAG," & _
            "EXEC_FORM," & _
            "'1' MENU_PVG" & _
            "  FROM SYS_MENU " & _
            " ORDER BY MENU_NO,MENU_SEQ"
           
    gsSql = "SELECT " & _
            "sys_MENU_1," & _
            "sys_MENU_2," & _
            "sys_MENU_3," & _
            "sys_MENU_4," & _
            "sys_MENU_5," & _
            "sys_MENU_6," & _
            "sys_MENU_7," & _
            "'0' sys_MENU_8" & _
            "  FROM SYS_MENU " & _
            " ORDER BY sys_MENU_1,sys_MENU_4"
           
           
    If DBQuerySQL(rsMenu, gsSql) <> -1 Then
        For i = 1 To rsMenu.RecordCount
            arrMenuList(1, i) = rsMenu("sys_MENU_1").Value
            arrMenuList(2, i) = rsMenu("sys_MENU_2").Value
            arrMenuList(3, i) = rsMenu("sys_MENU_3").Value
            arrMenuList(4, i) = rsMenu("sys_MENU_4").Value
            arrMenuList(5, i) = rsMenu("sys_MENU_5").Value
            arrMenuList(6, i) = rsMenu("sys_MENU_6").Value
            arrMenuList(7, i) = rsMenu("sys_MENU_7").Value
            arrMenuList(8, i) = rsMenu("sys_MENU_8").Value
         
            rsMenu.MoveNext
        Next i
    End If
    rsMenu.Close
   
End Function

那位老师可以决绝这个，问题

程序运行到：
    SetWindowLong frmName.hwnd, GWL_WNDPROC, AddressOf ClickMenu

vb就自动关闭了，不知道问题出在哪儿，在线求助！

问题已近解决，明天结贴，谢谢各位。

ClickMenu参数问题？

还是有问题，

Case WM_COMMAND
            Select Case wParam
                Case 900204
                  ‘’ frmSysUser.Show
                Case 900205
                  ‘’ frmSysRole.Show
                Case 900210
                  ‘’ Unload frmMain
            End Select

单引号后面不用就可以，去掉单引号就自动退出VB

人呢？

问题解决，是参数回调错误。

    If rslimite.State Then
        rslimite.Close
    End If
    sql = "exec user_pro @name='" + Frm_mm.Lbl_Name2.Caption + "'"
        rslimite.Open sql, con, adOpenKeyset
            If rslimite.BOF <> True And rslimite.EOF <> True Then
               
                For i = 5 To 12
                      str = Trim(rslimite.Fields(i).Value)
                      '最后边为0
                      If Right(str, 1) = 0 Then
                      Left(str, Len(str) - 1).enable = True
                      '注意[Left(str, Len(str) - 1)]是菜单中标题的名称，应该怎样来定义
如果是窗体Dim tmpForm As Form  Set tmpForm = Forms.add(str_frm)这样可以
                      End If
                Next i
            End If

Left(str, Len(str) - 1)必须是菜单控件名称，不能是菜单标题名称….

运行效果图：

此动态链接库是专门用于美化程序的菜单的。实现方法是在原有菜单的基础上直接调用，非常方便。Demo版只包含一种风格，在后续版本中会加入自定义风格的接口。

【发行文件包括】
DLL文件：cutemenu.dll
LIB文件：cutemenu.lib

【特点】
1、库文件体积小巧，只有16.5KB
2、界面美观。支持渐变填充和Alpha混合。
3、使用方便，仅在适当的时候调用3个函数即可。
4、支持32位位图菜单项
5、内部实现完全依赖已经建立好的菜单，没有另行建立任何结构数组用来保存自绘菜单信息。因此运行起来十分节省资源。

具体使用方法及注意事项请参见说明文件和演示代码（Visual C++ 6.0、Visual Basic 6.0、PureBasic 三个版本）。

CSDN下载链接：
http://download.csdn.net/source/917718

不错 收藏一下~

友情up

友情up

5、内部实现完全依赖已经建立好的菜单，没有另行建立任何结构数组用来保存自绘菜单信息。

这个听起来不错啊

是不是从Vlad的HOOK Menu改动而来？

感觉上是HOOK了创建过程后重绘……?

类似BSE引擎那种的吗?

不过也顶顶楼主!

纯原创。没有使用Hook。

up

不懂，up

不懂，up

顶.

up

自己顶一下。

如果不是下拉，工具栏可以用button.index 判断写代码，但是工具栏下拉菜单事件该怎么判断写代码。

同意楼上

兄弟key不行啊，我试过的

Toolbar1_ButtonMenuClick (Toolbar1.Buttons.Item("修改").ButtonMenus("修改一"))

使用Toolbar的ButtonMenuClick事件

想将窗口中的菜单信息取出来用一个treeview来显示,但现在问题是使用 controls集合可以取得所有的菜单名,但是它的上级菜单是哪一个??这个问题困扰了我很久,但现在必须要用了…

嗯，解决了，但为什么连个接分的人都没有？？？

接分

哪就不客气了

学习学习

学习中………………

我也来接下… 

接分

学习下。

up

接分~

我实现过类似问题，当时是在代码中把每个菜单的tag值设置成父菜单的key值。如果是顶级菜单为空。然后遍历实现的

学习来了

MDI窗体，工具栏为picturebox上,绘制多个xp风格按钮（网上找的按钮控件），没有代码，按按钮时，菜单栏明显抖动，像是重绘了，如何解决？

换了两种别的xp风格按钮，依然抖动，似乎只有vb自带的按钮没有这种情况！

我也帮你看看
syssz@yahoo.com.cn

打错了
syssz_hh@yahoo.com.cn

先谢了

快速交替点击工具栏上的三个按钮，效果更明显

这种情况应该常见，从枕善康上找的几个源码也有这种情况，而且换了按钮控件或只用vb自带的菜单也是这样。

如不能解决,发邮件renhengsoft@163.com

我下载了枕善居的那个代码试了一下完全正常啊，把按钮Click事件注释掉，也没发现楼主所说的抖动现象啊。
我把显示器的屏幕刷新频率调到最低，也没出现菜单栏的抖动现象，只在第一次点击的时候有一点轻微的闪动，再连续点击就没有了。

放在窗体不抖动,就是不能放在图片框上,否则一点击抖动很厉害,输入法控制条也一起抖动,奇怪.

谁有免费、漂亮的xp风格activeX工具栏控件，推荐一个，自定义控件我看不懂，测试起来也麻烦，好用我另外给分。

Email:lwmwork@tom.com

……….路过,帮顶.

枕善居  原来不只我一个人知道啊 ，这么多的人都，  呵呵，那个抖动啊 我也有个源程序，LZ想要 邮件我：215995706@qq.com