CISA FotoGallery

Statistiche

Tot. visite contenuti : 927999
Home Articoli tecnici API API Popup Menù in poche righe di codice

API Popup Menù in poche righe di codice

CODICE

Option Compare Database
Option Explicit

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&
Const TPM_RETURNCMD = &H100&
Const TPM_RIGHTBUTTON = &H2&

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 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
Corpo_MouseUp(Button As Integer, _
                            Shift As Integer, _
                            X As Single, _
                            Y As Single)
    Dim Pt As POINTAPI
    Dim ret As Long
    
hMenu = CreatePopupMenu()
    AppendMenu hMenu, MF_STRING, 1, "Hello !"
    AppendMenu hMenu, MF_GRAYED Or MF_DISABLED, 2, "Testing ..."
    AppendMenu hMenu, MF_SEPARATOR, 3, ByVal 0&
    AppendMenu hMenu, MF_CHECKED, 4, "TrackPopupMenu"
    GetCursorPos Pt
    ret = TrackPopupMenuEx(hMenu, TPM_LEFTALIGN Or _
                            TPM_RETURNCMD Or _
                            TPM_RIGHTBUTTON, _
                            Pt.X, Pt.Y, Me.HWnd, ByVal 0&)
    DestroyMenu hMenu
    Debug.Print ret
End Sub


Alessandro