I struggled with PopUp Menus because I was not able to find very good documentation. I found examples on PSC and elsewhere but they seemed too limited, as well as complex and difficult, to relate to my own coding. So I decided to dig into it and was able to come up with this brief Tutorial. I hope you find it helpful...
Version 1.0.1. (Apr 22, 2007)
I added more comments and improved a couple others, but more importantly, I replaced the confusing lngMenu array with more meaningful names. It should be less confusing. I also added more Menus, including a Sub_Menu that uses Check-Boxes.
Version 1.0.2. (May 16, 2007)
I made a huge change to the Check-Box Menu. Please see the extensive comments in the code for further details.
Start Visual Basic and select Standard Exe, then copy and paste all the Blue lines below. Press Cntl + F5 to run the app. Click a button inside the form and you will see your new PopUp Menu.
You may open the file called Cre8Popup.Vbp rather than do all the copying. It is the same program but with much more commenting.
Randy Giese
'Let's start with:
Option Explicit
'And a variable for the Check-Boxes.
Private lngBoxNum As Long
'Next we'll add the Constants for the AppendMenu Function:
Private Const MF_CHECKED As Long = &H8&
Private Const MF_GRAYED As Long = &H1&
Private Const MF_POPUP As Long = &H10&
Private Const MF_SEPARATOR As Long = &H800&
Private Const MF_STRING As Long = &H0&
'And a couple more for the TrackPopupMenuEx Function.
Private Const TPM_LEFTALIGN As Long = &H0&
Private Const TPM_RETURNCMD As Long = &H100&
Private Const TPM_RIGHTBUTTON As Long = &H2&
'Now we'll set up the POINTAPI which is used in the TrackPopupMenuEx Function.
Private Type POINTAPI
lngX As Long
lngY As Long
End Type
'These are the Menu Functions.
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 CreatePopupMenu Lib "user32" () 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 TrackPopupMenuEx Lib "user32" (ByVal hMenu As Long, ByVal wFlags As Long, ByVal X As Long, ByVal Y As Long, ByVal HWnd As Long, ByVal lptpm As Any) As Long
'The rest of the code is all contained in the Form_MouseUp Event.
Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
'These Dim's are for the TrackPopupMenuEx Function:
Dim lngTPM As Long
Dim pntXorY As POINTAPI
'Dimension each of the Menu variables. The variable will hold the Menu address.
Dim lngMainMenu As Long
Dim lngFirst_Sub_Menu As Long
Dim lngSecond_Sub_Menu As Long
' Create the Menu addresses. The variable contains the address.
lngMainMenu = CreatePopupMenu()
lngFirst_Sub_Menu = CreatePopupMenu()
lngSecond_Sub_Menu = CreatePopupMenu()
' Save the current Cursor Position.
GetCursorPos pntXorY
' This is the Main-Menu.
AppendMenu lngMainMenu, MF_STRING, 1, "This is the..."
AppendMenu lngMainMenu, MF_CHECKED, 2, "Main Menu"
AppendMenu lngMainMenu, MF_SEPARATOR, 3, ByVal 0&
' This MF_POPUP is the button that will Popup the Sub-Menu.
' It references the Sub-Menu's identifier lngFirst_Sub_Menu.
AppendMenu lngMainMenu, MF_POPUP, lngFirst_Sub_Menu, "More Menus"
' This is the First Sub-Menu.
AppendMenu lngFirst_Sub_Menu, MF_STRING, 4, "This is an example of..."
AppendMenu lngFirst_Sub_Menu, MF_SEPARATOR, 5, ByVal 0&
' This MF_POPUP is the button that will Popup the Check-Boxes in the Colors Sub-Menu.
' It references the Sub-Menu's identifier lngSecond_Sub_Menu.
AppendMenu lngFirst_Sub_Menu, MF_POPUP, lngSecond_Sub_Menu, "A Sub Menu w/Checked items..."
AppendMenu lngFirst_Sub_Menu, MF_SEPARATOR, 6, ByVal 0&
' This is the Colors Sub-Menu w/Check-Boxes. These 3 lines replaced 14 lines of code in the original version. Please see the code comments for further explanation.
AppendMenu lngSecond_Sub_Menu, Hex(Abs(lngBoxNum = 1) * 8), 7, "Red"
AppendMenu lngSecond_Sub_Menu, Hex(Abs(lngBoxNum = 2) * 8), 8, "Green"
AppendMenu lngSecond_Sub_Menu, Hex(Abs(lngBoxNum = 3) * 8), 9, "Blue"
' This is the rest of the First Sub_Menu.
AppendMenu lngFirst_Sub_Menu, MF_STRING, 10, "Open the Sub Menu above."
AppendMenu lngFirst_Sub_Menu, MF_STRING, 11, "Then Click one of the colors."
AppendMenu lngFirst_Sub_Menu, MF_STRING, 12, "The next time you open it,"
AppendMenu lngFirst_Sub_Menu, MF_STRING, 13, "your new color will be Checked."
AppendMenu lngFirst_Sub_Menu, MF_SEPARATOR, 14, ByVal 0&
AppendMenu lngFirst_Sub_Menu, MF_STRING, 15, "Close"
' This is the rest of the Main-Menu.
AppendMenu lngMainMenu, MF_SEPARATOR, 16, ByVal 0&
AppendMenu lngMainMenu, MF_STRING, 17, "The next one is"
AppendMenu lngMainMenu, MF_GRAYED, 18, "Grayed out."
' The TrackPopupMenuEx function displays a shortcut menu at the specified location and tracks the selection of items on the shortcut menu.
lngTPM = TrackPopupMenuEx(lngMainMenu, TPM_LEFTALIGN Or TPM_RETURNCMD Or TPM_RIGHTBUTTON, pntXorY.lngX, pntXorY.lngY, Me.HWnd, ByVal 0&)
' The DestroyMenu function destroys the specified menu and frees any memory that the menu occupies.
DestroyMenu lngMainMenu
DestroyMenu lngFirst_Sub_Menu
DestroyMenu lngSecond_Sub_Menu
' This is where you control the Menu buttons. This Menu is merely for demonstration purposes so I only included code to handle the Check-Boxes and an End statement for the Quit button.
Select Case lngTPM
Case 7
lngBoxNum = 1
Case 8
lngBoxNum = 2
Case 9
lngBoxNum = 3
Case 15
End
End Select ' lngTPM
End Sub
That's it! Press Cntl + F5 to run the Cre8Popup Menu program.