转载网址：http://www.5cyd.com/cyd-1/show.asp?id=492

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

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

 

下面这个过程是我自己写的一个根据用户配置文件添加菜单的过程

'………………………………………………………………………………
'名称：AddMenu
'作者：罗简单
'日期：2010-12-17
'功能：按照用户给定的菜单配置文件创建菜单
'………………………………………………………………………………
Public Sub AddMenu(hFather As Long, strConfig As String)
  Dim colMenu As New Collection
  Dim strData As String  '菜单配置文件内容
  Dim varData As Variant  '通过Split函数分割内容
  Open strConfig For Input As #1  '读入菜单配置文件
  Do While Not EOF(1)  '循环菜单配置文件
    Line Input #1, strData
    colMenu.Add strData  '将菜单内容添加到收集器中
  Loop
  Close #1
 
  '循环收集器
  Dim i As Integer, j As Integer '循环变量
  Dim intCount As Integer  '0级菜单数量
  intCount = colMenu.Count - 1
  Dim hPopMenu() As Long
  ReDim hPopMenu(intCount)
  For i = 1 To colMenu.Count
    hPopMenu(i - 1) = CreatePopupMenu()
    varData = Split(colMenu.Item(i), ",")
    For j = 1 To UBound(varData)
      MenuCount = MenuCount + 1
      '保存菜单文本，用于菜单事件触发时识别出被选择的菜单对象
      ReDim Preserve MenuText(MenuCount)
      MenuText(MenuCount) = varData(j)
      '加入子菜单，令其ID>1000，说明其为自动生成的菜单
      If LCase(varData(j)) = "step" Then
        AppendMenu1 hPopMenu(i - 1), MF_SEPARATOR, 1000 + MenuCount, MenuText(MenuCount) '添加一级菜单
      Else
        AppendMenu1 hPopMenu(i - 1), MF_STRING, 1000 + MenuCount, MenuText(MenuCount)  '添加一级菜单
      End If
      '如果是间隔线，则wFlags=MF_SEPARATOR
      '如果要Check，则wFlags=MF_STRING + MF_CHECKED，若令不可用，则再加MF_GRAYED
    Next j
    AppendMenu1 hFather, MF_POPUP, hPopMenu(i - 1), varData(0) '添加0级菜单
  Next i
End Sub

调用的时候如下：

    '添加到0级菜单
    hSubMenu = hMenu
    'FullAllSubMenu hSubMenu
    AddMenu hSubMenu, App.Path & "\MenuConfig.txt"