在VB中动态添加弹出菜单

'Code By 魑魅魍魉
'mailto:[e-mail]

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Const WM_SYSCOMMAND = &H112

 

Const MF_CHECKED = &H8&
Const MF_APPEND = &H100&
Const TPM_LEFTALIGN = &H0&
Const TPM_RETURNCMD = &H100

Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&

 

Private Type POINTAPI
    x As Long
    y As Long
End Type
Private Declare Function CreatePopupMenu 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 Any) As Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal hwnd As Long, ByVal bRevert As Long) As Long
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) As Long
Private Declare Function DestroyMenu Lib "user32" (ByVal hMenu As Long) As Long
Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function CreateMenu Lib "user32" () As Long

 

Dim hMenu, sMenu As Long

 

 

 

Private Sub Form_Load()
hMenu = CreatePopupMenu()

 AppendMenu hMenu, MF_STRING, 1, "111111"
 AppendMenu hMenu, MF_STRING, 2, "211111"
 AppendMenu hMenu, MF_STRING, 3, "311111"
 AppendMenu hMenu, MF_STRING, 4, "411111"

  sMenu = GetSystemMenu(Me.hwnd, False)
     AppendMenu sMenu, MF_STRING, 99, "About"
End Sub
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
    Dim aaa As Long
   
    Dim Pt As POINTAPI
  
    GetCursorPos Pt
 If Button = 2 Then
  
       aaa = TrackPopupMenu(sMenu, TPM_LEFTALIGN Or &H100, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&)
        Me.Caption = aaa
    If aaa = 99 Then
   '
   MsgBox "Demon!"
    Else
   '
    SendMessage Me.hwnd, WM_SYSCOMMAND, aaa, 0&
  
    End If
   
    Else
 Me.Caption = TrackPopupMenu(hMenu, TPM_LEFTALIGN Or &H100, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&)
 End If
End Sub
Private Sub Form_Unload(Cancel As Integer)

    DestroyMenu hMenu
    DestroyMenu sMenu
End Sub

效果如下：