Question

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

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

Answer 1

用类模块编写一个菜单类就可以了，网上找的。
菜单类
'类的名称为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这项。

Answer 2

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