How to Make Context Menu (Pop up) Using API in Visual Basic

This is a very good example on how to make context menu or pop-up menu using API.

Context menu (pop up menu) is useful for your program, specially if it's heavy in graphic. A program with context menu far more user-friendly than one which has not.

In my case at work, are program usually deals with map (autoCAD maps), so context menu is very important. Fortunately, Visual Basic 6 has APIs to do just that.

Copy and paste the source codes below into your VB project and you're ready to go.

Private Enum BTN_STYLE
    MF_CHECKED = &H8&
    MF_APPEND = &H100&
    TPM_LEFTALIGN = &H0&
    MF_DISABLED = &H2&
    MF_GRAYED = &H1&
    MF_SEPARATOR = &H800&
    MF_STRING = &H0&
    TPM_RETURNCMD = &H100&
    TPM_RIGHTBUTTON = &H2&
End Enum

Private Type POINTAPI
    X As Long
    Y As Long
End Type

Private Declare Function CreatePopupMenu Lib "user32" () 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
Private Declare Function AppendMenu Lib "user32" Alias "AppendMenuA" _
                (ByVal hMenu As Long, _
                ByVal wFlags As BTN_STYLE, 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_MouseDown(Button As Integer, Shift As Integer, _
                           X As Single, Y As Single)
    Dim Pt As POINTAPI
    Dim ret As BTN_STYLE

    If Button = vbRightButton Then
        hMenu = CreatePopupMenu()
        AppendMenu hMenu, MF_STRING, 1, "New"
        AppendMenu hMenu, MF_STRING, 2, "Open"
        AppendMenu hMenu, MF_SEPARATOR, -1, "Add"
        AppendMenu hMenu, MF_STRING, 3, "Exit"
        GetCursorPos Pt
        ret = TrackPopupMenuEx(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD, _
                                Pt.X, Pt.Y, Me.HWnd, ByVal 0&)
        DestroyMenu hMenu

        If ret = 1 Then
            MsgBox "New"
        ElseIf ret = 2 Then
            MsgBox "Open"
        ElseIf ret = 3 Then
            MsgBox "Exit"
        End If
    End If
End Sub