Binaryworld - How to display shortcut PopupMenu generated at runtime ? ... [ VB -> Menu ]

This article will show you simple demo of creating and displaying popup menu using TrackPopupMenu api. You will learn the following items from this sample code.

How to create PopupMenu, MenuItems and Submenu at runtime using CreatePopupMenu and AppendMenu APIs
How to display popupmenu anywhere on the screen using TrackPopupMenu API along with TPM_RETURNCMD flag to process click event
How to Check/Uncheck menuitem using CheckMenuItem API
How to do radio Check/Uncheck with MenuItems group using CheckMenuRadioItem API
How to get MenuItem caption using GetMenuString API
How to Enable/Disable menu item using EnableMenuItem API
How to use EndMenu API to disappear any active Popup for current thread
How to free menu resources using DestroyMenu API

Using Menu Creation Functions

You use menu creation function when you want to create or change a menu during run time. To create an empty menu bar, use the CreateMenu function; to create an empty menu, use the CreatePopupMenu function. To add items to a menu, use the AppendMenu and InsertMenu functions. When a menu contains more items than will fit in one column, the menu is truncated unless you force the line to break. You can cause a column break to occur at a specific item in a menu by assigning the MFT_MENUBREAK type flag to the item. Windows places that item and all subsequent items in a new column. You can also assign the MFT_MENUBARBREAK type flag to the item, which has the same effect as MFT_MENUBREAK, except that a vertical line appears between the new column and the old.

To display a shortcut menu, use the TrackPopupMenuEx function. Shortcut menus, also called floating pop-up menus or context menus, are typically displayed when the WM_CONTEXTMENU message is processed.
The older TrackPopupMenu function is still supported, but new applications should use the TrackPopupMenuEx function.

If a menu is assigned to a window and that window is destroyed, Windows CE automatically destroys the menu, freeing the menu handle and the memory occupied by the menu. Windows CE does not automatically destroy a menu not assigned to a window. An application must destroy the unassigned menu by calling the DestroyMenu function.

Step-By-Step Example

- Create a standard exe project
- Add one timer control and one commandbutton on the form1
- Add the following code in form1

Click here to copy the following block

Const MF_UNCHECKED = &H0&
Const MF_CHECKED = &H8&
Const MF_DISABLED = &H2&
Const MF_GRAYED = &H1&
Const MF_SEPARATOR = &H800&
Const MF_STRING = &H0&
Const MF_POPUP = &H10&
Const MF_BYPOSITION = &H400&
Const MF_BYCOMMAND = &H0&
Const MF_HILITE = &H80

Const TPM_LEFTALIGN = &H0&
Const TPM_RETURNCMD = &H100& '//This flag will return menu item after popup item is clicked

Private Type POINTAPI
  x As Long
  y As Long
End Type

Private Declare Function ClientToScreen Lib "user32" ( _
    ByVal hwnd As Long, _
    lpPoint As POINTAPI) As Long

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 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 GetMenuState Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal wID As Long, _
    ByVal wFlags As Long) As Long

Private Declare Function CheckMenuItem Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal wIDCheckItem As Long, _
    ByVal wCheck As Long) As Long

Private Declare Function CheckMenuRadioItem Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal idFirst As Long, _
    ByVal idLast As Long, _
    ByVal idCheck As Long, _
    ByVal uFlags As Long) As Long

Private Declare Function EnableMenuItem Lib "user32" ( _
    ByVal hMenu As Long, _
    ByVal wIDEnableItem As Long, _
    ByVal wEnable As Long) 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 Declare Function HiliteMenuItem Lib "user32" ( _
    ByVal hwnd As Long, _
    ByVal hMenu As Long, _
    ByVal wIDHiliteItem As Long, _
    ByVal wHilite As Long) As Long

Private Declare Function EndMenu Lib "user32.dll" () As Long

Const ID_OPEN = 1001
Const ID_VIEW_ENABLE = 1002
Const ID_VIEW_100 = 1003
Const ID_VIEW_200 = 1004
Const ID_VIEW_FULL = 1005
Const ID_EXIT = 1006

Dim hMenu As Long, hSubMenu As Long
Dim TimePassed As Integer

'//////////////////////////////////////////////////////
Private Sub Command1_Click()
  Dim pt As POINTAPI
  Me.ScaleMode = vbPixels

  pt.x = Me.ScaleLeft
  pt.y = Me.ScaleHeight / 2
  ClientToScreen Me.hwnd, pt  '//Convert out client window cordinates to absolute value to screen

  '//Just make popup visible some where and watch for 5 seconds
  Timer1.Enabled = True

  '//When popup opens then make "open" by default hilited
  ret = HiliteMenuItem(Form1.hwnd, hMenu, ID_OPEN, MF_BYCOMMAND Or MF_HILITE)
  Call TrackPopupMenu(hMenu, 0, pt.x, pt.y, 0, Me.hwnd, ByVal 0&)

End Sub

'//////////////////////////////////////////////////////
Private Sub Form_Load()
  Timer1.Interval = 1000
  Timer1.Enabled = False
  Command1.Caption = "Click to see Popup Timeout Demo (Timeout=5 sec)"

  hMenu = CreatePopupMenu() '//Popup menu
  hSubMenu = CreatePopupMenu() '//Submenu for PreView

  'Append a few menu items
  AppendMenu hMenu, MF_STRING, ByVal ID_OPEN, "Open"
  '//Create submenu for Preview
  AppendMenu hMenu, MF_POPUP, hSubMenu, "Preview"
  AppendMenu hSubMenu, MF_STRING Or MF_CHECKED, ByVal ID_VIEW_ENABLE, "Enable Preview"
  AppendMenu hSubMenu, MF_STRING, ByVal ID_VIEW_100, "100%"
  AppendMenu hSubMenu, MF_STRING, ByVal ID_VIEW_200, "200%"
  AppendMenu hSubMenu, MF_STRING Or MF_DISABLED Or MF_GRAYED, ByVal ID_VIEW_FULL, "Full Screen Preview (Not supported)"

  AppendMenu hMenu, MF_SEPARATOR, ByVal 0&, ByVal 0&
  AppendMenu hMenu, MF_CHECKED, ByVal ID_EXIT, "Exit"

  'Now set menuitems state
End Sub

'//////////////////////////////////////////////////////
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  Dim pt As POINTAPI
  Dim ret As Long, ClickedItem As Long

  'Get the position of the mouse cursor
  GetCursorPos pt

  If Button = 2 Then    '//On right button click
    Timer1.Enabled = True

    'Show our popupmenu
    ClickedItem = TrackPopupMenu(hMenu, TPM_RETURNCMD Or TPM_LEFTALIGN, pt.x, pt.y, 0, Me.hwnd, ByVal 0&)

    Select Case ClickedItem
      Case ID_OPEN
      Case ID_VIEW_ENABLE
        If ToggleCheck(ClickedItem) = MF_CHECKED Then
          Call EnableOrDisable(ID_VIEW_100, True)  '//Enable this item
          Call EnableOrDisable(ID_VIEW_200, True)  '//Enable this item
        Else
          Call EnableOrDisable(ID_VIEW_100, False)  '//Disable this item
          Call EnableOrDisable(ID_VIEW_200, False)  '//Disable this item
        End If

      Case ID_VIEW_100, ID_VIEW_200  '//for any of this item execute this code
        ToggleRadio ClickedItem, ID_VIEW_100, ID_VIEW_FULL

      Case ID_VIEW_FULL
        '//some code
      Case ID_EXIT
        Unload Me
        Exit Sub
    End Select
    MsgBox "You clicked on >> " & GetMenuCaption(ClickedItem)
  End If
  TimePassed = 0
  Timer1.Enabled = False
End Sub

'//////////////////////////////////////////////////////
'// Check/Uncheck Item by ItemID
'//
'// This function toggle checkmark of menuitem and returns
'// new state of menuitem
'// MF_CHECKED=> Menu items is Checked
'// MF_UNCHECKED=> Menu items is UnChecked
'//////////////////////////////////////////////////////
Function ToggleCheck(MenuItemID As Long) As Long
  ret = GetMenuState(hMenu, MenuItemID, MF_BYCOMMAND)
  If (ret And MF_CHECKED) Then
    CheckMenuItem hMenu, MenuItemID, MF_BYCOMMAND Or MF_UNCHECKED
    ToggleCheck = MF_UNCHECKED  '//UnCheck it
  Else
    CheckMenuItem hMenu, MenuItemID, MF_BYCOMMAND Or MF_CHECKED
    ToggleCheck = MF_CHECKED  '//Check it
  End If
End Function

'//////////////////////////////////////////////////////
'// Check/Uncheck Items Group by ItemID (Radio style)
'//////////////////////////////////////////////////////
Function ToggleRadio(MenuItemID As Long, GroupStartAt As Integer, GroupEndAt As Integer) As Long
  Dim ret As Long
  ret = CheckMenuRadioItem(hMenu, GroupStartAt, GroupEndAt, MenuItemID, MF_BYCOMMAND)
End Function

'//////////////////////////////////////////////////////
'// Enable/Disable menu item by ItemID
'//////////////////////////////////////////////////////
Function EnableOrDisable(MenuItemID As Long, IsEnabled As Boolean) As Long
  If IsEnabled = True Then
    EnableOrDisable = EnableMenuItem(hMenu, MenuItemID, MF_BYCOMMAND)
  Else
    EnableOrDisable = EnableMenuItem(hMenu, MenuItemID, MF_BYCOMMAND Or MF_DISABLED Or MF_GRAYED)
  End If
End Function

'//////////////////////////////////////////////////////
'// Get menu caption by ItemID
'//////////////////////////////////////////////////////
Function GetMenuCaption(MenuItemID As Long) As String
  Dim strCaption As String
  '//First call to determine buffer size (GetMenuString returns caption length)
  strCaption = Space$(GetMenuString(hMenu, MenuItemID, vbNullString, 0, MF_BYCOMMAND) + 1)  '//Add 1 for Nullchar

  If (Len(strCaption)) Then
    Call GetMenuString(hMenu, MenuItemID, strCaption, Len(strCaption), MF_BYCOMMAND)
  End If
  GetMenuCaption = strCaption
End Function

Private Sub Form_Unload(Cancel As Integer)
  'Destroy our menu and free resource
  DestroyMenu hMenu
End Sub

Private Sub Timer1_Timer()
  Me.Caption = TimePassed
  TimePassed = TimePassed + 1
  Me.Caption = "Lookat the popup menu, it will disappear after [" & 5 - TimePassed & "] seconds"
  '//if popup menu remains active for Const 5 seconds then end it
  If TimePassed >= 5 Then
    '//if popup menu is still active then end it
    Call EndMenu

    TimePassed = 0
    Timer1.Enabled = False
    Me.Caption = "APIDemo"
  End If
End Sub