用VB编写一个弹出菜单类

' 类的名称为cPopupMenu

Option   Explicit
'
Private  Type POINT
    x  As   Long
    y  As   Long
End  Type
'
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  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  GetForegroundWindow Lib  " user32 "  ()  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  mSelMenuString  As   String
Public   Property   Get  SelMenuString()  As   String
    SelMenuString  =  mSelMenuString
End Property
'
Public   Function  Popup(ParamArray param())  As   Long
     Dim  iMenu  As   Long
     Dim  hMenu  As   Long
     Dim  nMenus  As   Long
     Dim  p  As  POINT

'  get the current cursor pos in screen coordinates
    GetCursorPos p

'  create an empty popup menu
    hMenu  =  CreatePopupMenu()

'  determine # of strings in paramarray
    nMenus  =   1   +   UBound (param)

'  put each string in the menu
     For  iMenu  =   1   To  nMenus
'  the AppendMenu function has been superseeded by the InsertMenuItem
'  function, but it is a bit easier to use.
         If   Trim $( CStr (param(iMenu  -   1 )))  =   " - "   Then
'  if the parameter is a single dash, a separator is drawn
            AppendMenu hMenu, MF_SEPARATOR, iMenu,  ""
         Else
            AppendMenu hMenu, MF_STRING  +  MF_ENABLED, iMenu,  CStr (param(iMenu  -   1 ))
         End   If
     Next  iMenu

'  show the menu at the current cursor location;
'  the flags make the menu aligned to the right (!); enable the right button to select
'  an item; prohibit the menu from sending messages and make it return the index of
'  the selected item.
'  the TrackPopupMenu function returns when the user selected a menu item or cancelled
'  the window handle used here may be any window handle from your application
'  the return value is the (1-based) index of the menu item or 0 in case of cancelling
    iMenu  =  TrackPopupMenu(hMenu, TPM_RIGHTBUTTON  +  TPM_LEFTALIGN  +  TPM_NONOTIFY  +  TPM_RETURNCMD, p.x, p.y,  0 , GetForegroundWindow(),  0 )
     Dim  result  As   Long
     Dim  buffer  As   String
     Const  MF_BYPOSITION  =   & H400 &

    buffer  =   Space ( 255 )
    
    result  =  GetMenuString(hMenu, (iMenu  -   1 ), buffer, _
                    Len (buffer), MF_BYPOSITION)
     ' Debug.Print buffer
    mSelMenuString  =   Trim (buffer)
'  release and destroy the menu (for sanity)
    DestroyMenu hMenu

'  return the selected menu item's index
    Popup  =  iMenu

End Function

' 结束

' 以下是实例，在Form上添加一个ListBox控件

Option   Explicit

Private   Sub  Form_Load()
    List1.AddItem  " Right-Click here for a menu "
End Sub

Private   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 4 " )
'
        Debug.Print lMenuChosen
        Debug.Print oMenu.SelMenuString
     End   If

'
End Sub