Class to Build Cascading Pop-up Menus

Version Compatibility: Visual Basic 6

'   This class can build a hierarchical popup menu
'   Features:
'     o Build cascade popup menu easily
'     o Menu item can be disabled, grayed, default, checked
'     o Menu column break

Private Sub Command1_Click()
    Dim mnu As cMenu: Set mnu = New cMenu
    With mnu
        .AddItem 1, "Default", True
        .AddItem 0, "-"
        .AddItem 2, "Child Menus", , , True         ' Disabled menu item must has ID other than 0
        Dim i As Long
        For i = 1 To 10
            Dim submnu As cMenu: Set submnu = New cMenu
            With submnu
                .Caption = "Child Menu " & i
                .AddItem i * 10 + 1, "Child Menu " & i
            End With
            .AddItem i * 10, submnu
        Next
        .AddItem 0, "-"
        .AddItem 3, "Checked", , True
        .AddItem 4, "Grayed", , , , True
        .AddItem 5, "New Column", , , , , True
        
        MsgBox .TrackPopup(, , , Command1.hwnd)
    End With
End Sub

Instructions: Copy the declarations and code below and paste directly into your VB project.

Declarations:
Option Explicit ' Class Name: cMenu ' Version: 1.0 ' Author: Walter Wong (walterwong@msn.com) ' Description: ' This class can build a hierarchical popup menu ' Features: ' o Hierarchical structure ' o Each item has ' History: ' 2002/5/27: ' o Removed dependencies on win.tlb, now all needed API declarations included, this means ' this class can be used alone. ' o Added a full functional test project to Source+ 2000. Private m_hMenu As Long Public Caption As String ' If works as a sub-menu, this would be add as parent menu item Private Declare Function SetMenuDefaultItem Lib "user32" (ByVal hMenu As Long, ByVal uItem As Long, ByVal fByPos As Long) As Long Private Declare Function CreatePopupMenu Lib "user32" () As Long Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, lpNewItem As String) As Long Private Declare Function EnableMenuItem Lib "user32" (ByVal hMenu As Long, ByVal wIDEnableItem As Long, ByVal wEnable As Long) As Long Private Const MF_STRING = &H0& Private Const MF_SEPARATOR = &H800& Private Const MF_MENUBARBREAK = &H20& Private Const MF_POPUP = &H10& Private Const MF_MENUBREAK = &H40& Private Const MF_BYCOMMAND = &H0& Private Const MF_GRAYED = &H1& Private Const MF_DISABLED = &H2& Private Const MF_CHECKED = &H8& Private Const APIFALSE As Long = 0 Private Const APITRUE As Long = 1 Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTL) As Long Private Declare Function GetDesktopWindow Lib "user32" () 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, ByVal lprc As Long) As Long Private Declare Function GetFocus Lib "user32" () As Long Private Declare Function GetForegroundWindow Lib "user32" () As Long Private Declare Function WindowFromPoint Lib "user32" (ByVal xPoint As Long, ByVal yPoint As Long) As Long Private Declare Function GetWindow Lib "user32" (ByVal hwnd As Long, ByVal wCmd As Long) As Long Private Declare Function GetWindowThreadProcessId Lib "user32" (ByVal hwnd As Long, lpdwProcessId As Long) As Long Private Declare Function GetCurrentProcessId Lib "kernel32" () As Long Private Const GW_CHILD = 5 Private Const GW_HWNDNEXT = 2 Private Const GW_HWNDFIRST = 0 Private Type POINTL x As Long y As Long End Type Private Const TPM_RETURNCMD = &H100& Private Const TPM_LEFTALIGN = &H0& Private Const TPM_LEFTBUTTON = &H0& Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long Private Type RECT Left As Long Top As Long Right As Long Bottom As Long End Type