1．模塊代碼如下：
注意：因為有用到AddressOf OnMenu，函數(shù)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 '菜單數(shù)量，不包括不能觸發(fā)的菜單
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
'{響應(yīng)菜單事件}
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代碼如下：
設(shè)計窗體的Negotiation=False，以防止彈出對話框或響應(yīng)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
'窗體上沒有菜單時，創(chuàng)建菜單。這種情況下需在設(shè)計階段設(shè)置窗體的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
'保存菜單文本，用于菜單事件觸發(fā)時識別出被選擇的菜單對象
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
