Create PopUp Menu dynamically 1

[YL99]

Hi,

Does anybody know how to create PopUp menu dynamically, rather than creating it at design time.

Your help would be much appreciated.

Thanks

 

[Hypetia]

See the example below.

A popup menu is created using CreatePopupMenu function.

Items are added to this menu using InsertMenu function.

The menu is displayed using TrackPopupMenu function at a position retrieved by GetCursorPos function.(Mouse position)

If the user clicks an item then the WM_COMMAND message generated by this action is retrieved using PeekMessage function. (this prevents us from the subclassing stuff required otherwise)

In the end the menu is destroyed using DestroyMenu function.
___
Option Explicit
Dim hMenu As Long
Private Declare Function CreatePopupMenu Lib "user32" () As Long
Private Declare Function InsertMenu Lib "user32" Alias "InsertMenuA" (ByVal hMenu As Long, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As Long, ByVal lpNewItem As Any) 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, lprc 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 PeekMessage Lib "user32" Alias "PeekMessageA" (lpMsg As MSG, ByVal hwnd As Long, ByVal wMsgFilterMin As Long, ByVal wMsgFilterMax As Long, ByVal wRemoveMsg As Long) As Long
Private Type POINTAPI
x As Long
y As Long
End Type
Private Type MSG
hwnd As Long
message As Long
wParam As Long
lParam As Long
time As Long
pt As POINTAPI
End Type
Const WM_COMMAND = &H111

Private Sub Form_Load()
hMenu = CreatePopupMenu
Dim N As Integer
For N = 1 To 7
InsertMenu hMenu, -1, 0, N, ByVal WeekdayName(N)
Next
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
If Button = vbRightButton Then
Dim p As POINTAPI, m As MSG
GetCursorPos p
TrackPopupMenu hMenu, 0, p.x, p.y, 0, hwnd, ByVal 0&
If PeekMessage(m, hwnd, WM_COMMAND, WM_COMMAND, 0) Then
'm.wParam identifies the menu item Id
MsgBox "You chose " & WeekdayName(m.wParam)
End If
End If
End Sub

Private Sub Form_Unload(Cancel As Integer)
DestroyMenu hMenu
End Sub