API 创建弹出多级菜单

现在form 添加一个listbox 
Option ExplicitPrivate Sub Form_Load()
    List1.AddItem "Right-Click here for a menu"
End SubPrivate Sub List1_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim oMenu As cPopupMenu
    Dim lMenuChosen As Long
    If Button = vbRightButton Then
        Set oMenu = New cPopupMenu
'
' Pass in the desired menu, use '-' for a separator
'
        lMenuChosen = oMenu.Popup("Menu 1", ".Menu 2", "..Menu 3", "..-", "..Menu 5", ".Menu 6", ".Menu 7", "Menu 8", "Menu 9", ".Menu 10", "..Menu 11")
        Debug.Print lMenuChosen
    End If
End Sub然后添加一个类 名字叫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 Declare Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As Long, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
'Private Declare Function CheckMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDCheckItem As Long, ByVal wCheck As Long) 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 FunctionPublic 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
之前在其他网址上找到类似的代码他那个不支持多级菜单的我这个支持