VB程序员博客

虽然我会在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

我在窗体里面任何一个能右击弹出菜单的地方右击，或者点击出现pop－up菜单而不去选择，这样导致由程序的消息队列一直处于等待状态？是这样的吗？还是其他原因导致的？
我发现这么个问题
我在一个地方一直处于接受中断或者定时器触发的事件而发送的postmessage（），
而我某个地方右击出现菜单后，接受这个消息的事件过程就停止执行了，也就是一直接收postmessage，但是一直没有执行，在等待那个pop－up菜单的消息？？？？
请问怎么解决。。

我的程序也是这样做，不过并没有发现您说的这个问题啊?

有这样一个菜单如下：
文件 分类
    一类
    二类
        大类
        中类
        小类
    三类
        1类
        2类
    四类

其中大中小类在二类菜单级下，1类2类在三类菜单级下，一二三四在分类菜单下
现在需要根据点击率来动态给菜单排序，即在配置文件中记录每个菜单的点击次数，在下次打开时分类主菜单下的子菜单按照点击率由高至低显示，这样每次初始化时都要重新加载菜单，而二类三类位置变化时，它的子菜单也要跟着，请问该怎么写，最好给代码，高手帮忙

菜单中的名称都已经固定，不能修改，好像不能用菜单数组方式了

搞不懂为什么要这么用

要求做成这样的

添加菜单的代码加到Form的Form_Paint事件中，而不是Load事件中。因为修改了窗口菜单，需要重绘才能显示，正好Form_Paint事件可以满足。如果非要写在Load事件中，需要加入一句话：Call DrawMenuBar(Me.hwnd)
声明：Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long

如何获得PopupMenu弹出的菜单的句柄（HMenu）
该菜单在菜单栏上设为隐藏~
用GetMenu和GetSubMenu获取不到，设置成可见才可以获取其Hmenu
怎么样才能获取在菜单栏隐藏的弹出式菜单的HMenu呢？

当然是我自己正在编写的程序本身了，非API，用POPUPMENU弹出的
不知楼上有何高见？

弹出式菜单的HMenu只能由GetSubMenu获取,但隐藏了某些菜单后,GetSubMenu的第二个参数pos相应变小,如不作相应的调整,返回的句柄为0,这并不是隐藏引起的.

现在的问题是GetSubMenu的第一个参数都不知道该填什么……

第一个参数由GetMenu获得
Private Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Private Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Private Sub Form_Load()
Dim ret As Long
Dim vMenuHnd As Long
ret = GetMenu(Me.hwnd)
vMenuHnd = GetSubMenu(ret, 0) '假设有二个菜单,第二个菜单隐藏,求第二菜单的句柄.若不隐藏,第二个参数为1,隐藏就要改为0(少了一个菜单)
MsgBox vMenuHnd
End Sub

上面的"假设有二个菜单,第二个菜单隐藏,求第二菜单的句柄.若不隐藏,第二个参数为1,隐藏就要改为0(少了一个菜单)" 打错了一个字,应为:"假设有二个菜单,第一个菜单隐藏,求第二菜单的句柄.若不隐藏,第二个参数为1,隐藏就要改为0(少了一个菜单)"
实测了一下,若将隐藏,返回值也是0,既使用popupMenu激活,返回也是0,查了一下API说明,0就表示弹出菜单不存在,看来隐藏和不存在是一回了.

汗……我是要得到隐藏的那个菜单的HMenu….

顶~有人知道吗？

哎，我已经有替代方案了

但是这里没有满意答案，

总之时间那么长了，还是结了吧，谢谢各位了