Tvorba PopUp Menu pomocí Win32API

Potřebujete vytvořit PopUp menu? I to lze řešit pomocí API funkcí. Tento komentovaný příklad ukáže, jak kliknutím kamkoliv na formulář vyvoláte PopUp menu. Pravé tlačítko vyvolá Systémové menu (Stejné jako kliknutím na ikonu okna), levé tlačítko vyvolá vámi definované menu.
A nyní již příklad:

'Konstanty pro menu
Const MF_CHECKED = &H8&
Const MF_APPEND = &H100&
Const TPM_LEFTALIGN = &H0&
Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&

'Deklarace pozice kurzoru mysi
Private Type POINTAPI
   x As Long
   y As Long
End Type

'Deklarace API funkci
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

Dim hMenu As Long

Private Sub Form_Load()
   'Vytvorit prazdne menu
   hMenu = CreatePopupMenu()
   'Vytvoreni jednotlivych polozek menu
   AppendMenu hMenu, MF_STRING, ByVal 0&, "Ahoj lidi!"
   AppendMenu hMenu, MF_GRAYED Or MF_DISABLED, ByVal 0&, _
      "Formátovat C: ..."
   AppendMenu hMenu, MF_SEPARATOR, ByVal 0&, ByVal 0&
   AppendMenu hMenu, MF_CHECKED, ByVal 0&, "Zobrazit"
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, _
   x As Single, y As Single)

   Dim objPt As POINTAPI

   GetCursorPos objPt
   If Button = 1 Then
   'Prave tlacitko Vase PopUp menu
      TrackPopupMenu hMenu, _
         TPM_LEFTALIGN, _
         objPt.x, _
         objPt.y, _
         0, _
         Me.hwnd, _
         ByVal 0&
   Else
      'Ukazat defaultni systemove menu
      TrackPopupMenu GetSystemMenu(Me.hwnd, False), _
         TPM_LEFTALIGN, objPt.x, _
         objPt.y, 0, _
         Me.hwnd, _
         ByVal 0&
   End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
   'Zrusit instanci popup menu
   DestroyMenu hMenu
End Sub