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&

 

Private Type POINTAPI

x As Long

y As Long

End Type

 

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 Command1_Click()

Call AppendMenu(hMenu, MF_STRING, ByVal 0&, "новое меню")

End Sub

 

Private Sub Form_Load()

'Создаём пустое всплывающие меню

hMenu = CreatePopupMenu()

'Добавляем несколько пунктов в меню

AppendMenu hMenu, MF_STRING, ByVal 0&, "Hello !"

AppendMenu hMenu, MF_GRAYED Or MF_DISABLED, ByVal 0&, "Testing ..."

AppendMenu hMenu, MF_SEPARATOR, ByVal 0&, ByVal 0&

AppendMenu hMenu, MF_CHECKED, ByVal 0&, "TrackPopupMenu"

End Sub

 

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

Dim Pt As POINTAPI

'Получаем позицию курсора мыши

GetCursorPos Pt

If Button = 1 Then

'Показываем всплывающие меню

TrackPopupMenu hMenu, TPM_LEFTALIGN, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&

Else

'Показываем всплывающее меню по умолчанию

TrackPopupMenu GetSystemMenu(Me.hwnd, False), TPM_LEFTALIGN, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&

End If

End Sub

 

Private Sub Form_Unload(Cancel As Integer)

Call DestroyMenu(hMenu)

End Sub