vb 用代码创建右键菜单的问题

Posted 2023-04-19

不用菜单编辑器来做! 我现在想做一个程序 可以用代码创建菜单! 但是不知道怎么创建 如果能创建的话 后面的工作就简单了
补充最好要有删除菜单主项或子项的删除代码这样既能添加也能删除不用的菜单项

用类模块编写一个菜单类就可以了，网上找的。
菜单类
'类的名称为cPopupMenu
'类 cPopupMenu
Option Explicit

Private Type POINT
x As Long
y As Long
End Type
Private Const MF_BYPOSITION = &H400&
Private Const MF_ENABLED = &H0&
Private Const MF_SEPARATOR = &H800&
Private Const MF_STRING = &H0&
Private Const TPM_RIGHTBUTTON = &H2&
Private Const TPM_LEFTALIGN = &H0&
Private Const TPM_NONOTIFY = &H80&
Private Const TPM_RETURNCMD = &H100&
Private Const MF_CHECKED = &H8&
Private Const MF_APPEND = &H100&
Private Const MF_DISABLED = &H2&
Private Const MF_GRAYED = &H1&
Private Const MF_POPUP = &H10&

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
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal sCaption As String) As Long
Private Declare Function TrackPopupMenu Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal x As Long, ByVal y As Long, ByVal nReserved As Long, ByVal hwnd As Long, nIgnored As Long) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINT) As Long
Private C As New Collection
Private LMenu As String

Public Function Popup(ParamArray param()) As Long
Dim iMenu As Long
Dim hMenu As Long
Dim nMenus As Long
Dim lMenus As Long
Dim hFileSubMenu As Long
Dim p As POINT
GetCursorPos p
hMenu = CreatePopupMenu()
nMenus = 1 + UBound(param)
lMenus = hMenu
hFileSubMenu = CreatePopupMenu()
C.Add hMenu
For iMenu = 1 To nMenus
InsertM CStr(param(iMenu - 1)), hMenu, iMenu, 1
Next iMenu
iMenu = TrackPopupMenu(hMenu, TPM_RIGHTBUTTON + TPM_LEFTALIGN + TPM_NONOTIFY + TPM_RETURNCMD, p.x, p.y, 0, GetForegroundWindow(), 0)
DestroyMenu hMenu
Popup = iMenu
End Function

Public Function InsertM(Str As String, Mmenu As Long, iMenu As Long, Ci As Integer) As Long
Dim s As String
Dim i As Integer
If Trim$(Str) = "-" Or Trim$(Str) = "" Then
AppendMenu Mmenu, MF_SEPARATOR, iMenu, ""
LMenu = CStr(Trim(Str))
For i = C.Count To Ci + 1 Step -1
DestroyMenu C.Item(i)
C.Remove i
Next i
InsertM = Ci
Else
If Left(Trim(Str), 1) = "." Then
If Ci = C.Count Then
Dim InsertMenu As Long
InsertMenu = CreatePopupMenu()
ModifyMenu Mmenu, iMenu - 1, MF_POPUP, InsertMenu, LMenu
C.Add InsertMenu
End If
Ci = Ci + 1
s = Right(Str, Len(Str) - 1)
InsertM = InsertM(s, C.Item(Ci), iMenu, Ci)
Else
AppendMenu Mmenu, MF_STRING + MF_ENABLED + MF_CHECKED, iMenu, CStr(Trim(Str))
LMenu = CStr(Trim(Str))
For i = C.Count To Ci + 1 Step -1
DestroyMenu C.Item(i)
C.Remove i
Next i
InsertM = Ci
End If
End If
End Function

用法：
Dim oMenu As cPopupMenu
Dim lMenuChosen As Long
If Button = vbRightButton Then
Set oMenu = New cPopupMenu
lMenuChosen = oMenu.Popup("menu1", ".menu2", "..menu3", "..-", "..menu4", ".menu5", ".menu6", "menu7", "menu8", ".menu9", "..menu10")
End If
返回值lMenuChosen对应("menu1", ".menu2", "..menu3", "..-", "..menu4", ".menu5", ".menu6", "menu7", "menu8", ".menu9", "..menu10")的值分别为1，2，3，4，5，6，7，8，9，10。这里，第四个是"-"表示分栏， "."标识二级菜单，".."表示三级菜单。
要删除添加菜单，可以从新定义字符串，反正最后都是取lMenuChosen返回值来做对应的case，比用菜单编辑器的要输入一大堆的定义要来得有效。
如果要给菜单添加图标的话，可以用SetMenuItemBitmaps Lib "user32" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal hBitmapUnchecked As Long, ByVal hBitmapChecked As Long) As Long函数给菜单添加图标。在创建菜单项的下一行添加就可以了。添加图标不能与MF_CHECKED一起使用，所以要取消MF_CHECKED这项。 参考技术A 1．模块代码如下：
注意：因为有用到AddressOf OnMenu，函数OnMenu只能放在模块部分。

Public Const MF_POPUP = &H10&
Public Const MF_STRING = &H0&
Public Const MF_DISABLED = &H2&
Public Const MF_SEPARATOR = &H800&
Public Const MF_CHECKED = &H8&
Public Const MF_GRAYED = &H1&
Public Const MF_BYCOMMAND = &H0&
Public Const GWL_WNDPROC = (-4)
Public Const WM_COMMAND = &H111
Public Declare Function CreateMenu Lib "user32" () As Long
Public Declare Function GetMenu Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function GetMenuItemCount Lib "user32" (ByVal hMenu As Long) As Long
Public Declare Function GetSubMenu Lib "user32" (ByVal hMenu As Long, ByVal nPos As Long) As Long
Public Declare Function CreatePopupMenu Lib "user32" () As Long
Public Declare Function AppendMenu1 Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As String) As Long
Public Declare Function SetMenu Lib "user32" (ByVal hwnd As Long, ByVal hMenu As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public 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
Public MenuCount As Long '菜单数量，不包括不能触发的菜单
Public MenuText() As String '菜单文本，ID=wParam的菜单的文本为MenuText(wParam - 1000)
Public OldWinProc As Long

Public Function OnMenu(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
'响应菜单事件
Select Case wMsg
Case WM_COMMAND
If wParam > 1000 And wParam <= 1000 + MenuCount Then
MsgBox MenuText(wParam - 1000)
End If
End Select
OnMenu = CallWindowProc(OldWinProc, hwnd, wMsg, wParam, lParam)
End Function

2．Form1代码如下：
设计窗体的Negotiation=False，以防止弹出对话框或响应OnMenu后窗体上的菜单消失

Private Sub Form_Load()
Call CreateActiveMenu
End Sub

Sub CreateActiveMenu()
Dim hMenu As Long, hSubMenu As Long
Dim hPopMenuTmp As Long
ReDim MenuText(0)

hMenu = GetMenu(Me.hwnd) '窗体级菜单句柄
If hMenu = 0 Then
'窗体上没有菜单时，创建菜单。这种情况下需在设计阶段设置窗体的NegotiatMenu=False菜单才能显示出来。
hMenu = CreateMenu()
End If

'添加到0级菜单
hSubMenu = hMenu
FullAllSubMenu hSubMenu

'添加到1级菜单
hSubMenu = GetSubMenu(hSubMenu, GetMenuItemCount(hSubMenu) - 1) '获取最后一个0级菜单的句柄
FullAllSubMenu hSubMenu

'添加到2级菜单
hSubMenu = GetSubMenu(hSubMenu, GetMenuItemCount(hSubMenu) - 1)
FullAllSubMenu hSubMenu

'添加到3级菜单
hSubMenu = GetSubMenu(hSubMenu, GetMenuItemCount(hSubMenu) - 1)
FullAllSubMenu hSubMenu

SetMenu Me.hwnd, hMenu
DrawMenuBar Me.hwnd
Me.Refresh

OldWinProc = SetWindowLong(Me.hwnd, GWL_WNDPROC, AddressOf OnMenu)
End Sub

Sub FullAllSubMenu(hFather As Long)
'加入全部子菜单
Dim hPopMenuTmp As Long
Dim i As Integer
hPopMenuTmp = CreatePopupMenu()
For i = 0 To 4
MenuCount = MenuCount + 1
'保存菜单文本，用于菜单事件触发时识别出被选择的菜单对象
ReDim Preserve MenuText(MenuCount)
MenuText(MenuCount) = "文件" & MenuCount
'加入子菜单，令其ID>1000，说明其为自动生成的菜单
AppendMenu1 hPopMenuTmp, MF_STRING, 1000 + MenuCount, MenuText(MenuCount)
'如果是间隔线，则wFlags=MF_SEPARATOR
'如果要Check，则wFlags=MF_STRING + MF_CHECKED，若令不可用，则再加MF_GRAYED
Next
AppendMenu1 hFather, MF_POPUP, hPopMenuTmp, "&Files"
End Sub本回答被提问者采纳

vb的PopupMenu功能

（我在vb菜单栏设置了一个标题change的菜单
用form背景的movedown设置判断右键PopupMenu弹出change菜单）
现在想在一个text的空白处右键也可以PopupMenu弹出change菜单，可是弹出的是原来的复制黏贴还是在左上角的，请问为什么？楼主初学VB想让右击text跟上面一样效果
就跟图三那个效果移植到text右键空白处，有点急，谢谢大家

If Button = 2 Then
Text1.Enabled = False
Text1.Enabled = True
PopupMenu change, 64

End If追问

text设enable为假不可编辑自身文本

请问为什么先假后真就可以响应弹出菜单
那原来右键的功能是怎么被跳过的？

追答

标准的方法是要用到API的回调函数去屏蔽text控件原有的右键菜单，代码比较复杂。而现在用的这个是个取巧的、非常规的做法。把Text1.Enabled设为False可关闭原装的右键菜单，再设为True就可响应用户的菜单，至于深层的原理就不要去深究了，都说了这是个非常规的用法了，管用就行，就像现实生活中有些事正常途径无法解决时就找一些偏门的、甚至见不得光的方法去处理一样，别深究、别好奇，好奇害死猫，嘿嘿……

参考技术A PopupMenu方法用来显示弹出菜单，语法格式为：
object.PopupMenu menuname,flags,x, y,boldcommand
其中：
Object（对象）——窗体名。
Menuname（菜单名）——指在菜单编辑器中定义的主菜单项名。
X、Y——弹出式菜单在窗体上的显示位置的X、Y坐标（与Flags参数配合使用）。
Boldcommand——指定弹出式菜中的弹出式菜单控件的名字，用以显示为黑体正文标题。
Flags——该参数是一个数值或符号常量，指定弹出式菜单的位置和行为，其取值分为两组，一组用来指定菜单位置，另一组用来定义特殊的菜单行为，如下表：
指定菜单位置

定位常量 值 作用
VbPopupMenuLeftAlign 0 X坐标指定弹出式菜单的左边界位置
VbPopupMenuCenterAlign 4 X坐标指定弹出式菜单的中间位置
VbPopupMenuRightAlign 8 X坐标指定弹出式菜单的右边界位置
定义菜单行为

定位常量 值 作用
VbPopupMenuLeftButton 0 通过单击鼠标左键选择菜单命令
VbPopupMenuRightButton 8 通过单击鼠标右键选择菜单命令
说明：
PopupMenu方法的6个参数中，除“菜单名”外，其余参数都是可选的。当省略了“对象”时，弹出式菜单只能在当前窗体中显示。如果需要在其它窗体中显示弹出菜单，则必须加上窗体名。
Flags的两组参数可以单独使用，也可以联合使用。当联合使用时，每组中取一个值，两个值相加；如果使用符号常量，则两个值用Or连接。
X、Y分别用来指定弹出式菜单显示位置的横、纵坐标，如果省略，则弹出菜单在鼠标光标的当前位置显示。
弹出式菜单的“位置”由X、Y、Flags参数共同指定。如果省略这几个参数，则在单击鼠标右键弹出菜单时，鼠标光标所在位置为弹出式菜单左上角的坐标。在默认情况下，以窗体的左上角为坐标原点。如果只省略Flags参数，不省略X、Y参数，则X、Y为弹出式菜单左上角的坐标；如果同时使用X、Y及Flags参数，则弹出菜单的位置分为一下几种情况：
Flags=0 X、Y为弹出式菜单左上角的坐标
Flags=4 X、Y为弹出式菜单顶边中间的坐标
Flags=8 X、Y为弹出式菜单右上角的坐标
为了显示弹出式菜单，通常把PopupMenu方法放在MouseDown事件中，该事件响应所有的鼠标单击操作。按照惯例，一般通过单击鼠标右键显示弹出菜单，这可以用Button参数来实现。对于两个键的鼠标来说，左键的Button参数值为1，右键的Button参数值为2。因此可以强制使用右键来响应MouseDown事件而显示弹出菜单：
If Button=2 Then PopupMenu 菜单名