用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