appendmenuPublic 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
yes,有运行时添加的(不是根据ini添加的)作参考 ---------------------------------------- 动态创建菜单,鼠标右键弹出菜单,执行对应鼠标事件 '窗体 Option Explicit Private Sub Form_Load() hMenu = CreateMenu() hmenupopup = CreatePopupMenu() result = AppendMenu(hmenupopup, MF_STRING, 300, "&New") result = AppendMenu(hmenupopup, MF_STRING, 301, "&Save") result = AppendMenu(hmenupopup, MF_STRING, 302, "Save &As...") result = AppendMenu(hMenu, MF_POPUP, hmenupopup, "&File") oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC) SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf OnMenu End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single) Dim r As RECT Dim p As POINTAPI If Button = vbRightButton Then GetCursorPos p TrackPopupMenu hmenupopup, 0, p.x, p.y, 0, Me.hWnd, r End If End SubPrivate Sub Form_Unload(Cancel As Integer) SetWindowLong Me.hWnd, GWL_WNDPROC, oldwinproc End Sub '模块 Option ExplicitPublic Declare Function CreateMenu Lib "user32" () As Long Public 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 Public 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, lprc As RECT) As Long Public Declare Function CreatePopupMenu Lib "user32" () 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long Public Const MF_STRING = &H0& Public Const MF_POPUP = &H10& Public Const WM_USER = &H400 Public Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type Public Type POINTAPI x As Long y As Long End Type Public Const GWL_WNDPROC = (-4) Public hMenu As Long Public hmenupopup As Long Public result As Long Public oldwinproc As Long Public Const WM_COMMAND = &H111Public 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 Select Case wParam Case 300 MsgBox "u select new", vbInformation, "hello, world!" Case 301 MsgBox "u select save", vbInformation, "hello, world!" Case 302 MsgBox "u select save as", vbInformation, "hello, world!" End Select End Select OnMenu = CallWindowProc(oldwinproc, hWnd, wMsg, wParam, lParam) End Function
----------------------------------------
动态创建菜单,鼠标右键弹出菜单,执行对应鼠标事件
'窗体
Option Explicit
Private Sub Form_Load()
hMenu = CreateMenu()
hmenupopup = CreatePopupMenu()
result = AppendMenu(hmenupopup, MF_STRING, 300, "&New")
result = AppendMenu(hmenupopup, MF_STRING, 301, "&Save")
result = AppendMenu(hmenupopup, MF_STRING, 302, "Save &As...")
result = AppendMenu(hMenu, MF_POPUP, hmenupopup, "&File")
oldwinproc = GetWindowLong(Me.hWnd, GWL_WNDPROC)
SetWindowLong Me.hWnd, GWL_WNDPROC, AddressOf OnMenu
End SubPrivate Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
Dim r As RECT
Dim p As POINTAPI
If Button = vbRightButton Then
GetCursorPos p
TrackPopupMenu hmenupopup, 0, p.x, p.y, 0, Me.hWnd, r
End If
End SubPrivate Sub Form_Unload(Cancel As Integer)
SetWindowLong Me.hWnd, GWL_WNDPROC, oldwinproc
End Sub
'模块
Option ExplicitPublic Declare Function CreateMenu Lib "user32" () As Long
Public 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
Public 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, lprc As RECT) As Long
Public Declare Function CreatePopupMenu Lib "user32" () 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 Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Const MF_STRING = &H0&
Public Const MF_POPUP = &H10&
Public Const WM_USER = &H400
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type POINTAPI
x As Long
y As Long
End Type
Public Const GWL_WNDPROC = (-4)
Public hMenu As Long
Public hmenupopup As Long
Public result As Long
Public oldwinproc As Long
Public Const WM_COMMAND = &H111Public 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
Select Case wParam
Case 300
MsgBox "u select new", vbInformation, "hello, world!"
Case 301
MsgBox "u select save", vbInformation, "hello, world!"
Case 302
MsgBox "u select save as", vbInformation, "hello, world!"
End Select
End Select
OnMenu = CallWindowProc(oldwinproc, hWnd, wMsg, wParam, lParam)
End Function
在菜单编辑器中建立一下菜单并定义为数组形式,例如:菜单名为mnuFile
如果新加菜单,就使用:
load mnuFile(i)
mnufile(i).caption="ssss"