!! Avis aux boss des Api !!!!!!!

Comment capter le click de la souris sur un bouton dans un popupmenu créé par : CreatePopupMenu, TrackPopupMenu, AppendMenu

Merci

Schouly





ex : (allapi.net)

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 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

Je sais pas si c'est la bonne façon, mais j'ai consulté leur outils (il en manque des choses pour AppendMenu!) et j'arrive à ceci qui est stable même en dehors de VB (NON! Je suis pas un god des API, juste un bidouilleur):

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& ' <-- AJOUTÉ 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 Form_Load() hMenu = CreatePopupMenu() AppendMenu hMenu, MF_STRING, 1, "Hello !" ' <-- J'ai mis un numéro aux items pouvant réagir AppendMenu hMenu, MF_GRAYED Or MF_DISABLED, 2, "Testing ..." AppendMenu hMenu, MF_SEPARATOR, ByVal 0&, ByVal 0& ' <-- Un séparateur ne peux pas réagir AppendMenu hMenu, MF_CHECKED, 4, "TrackPopupMenu" ' <-- Personnellement, je met 4, pcq c'est effectivement le 4ème item End Sub Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single) Dim Pt As POINTAPI Dim ItemRetour As Long GetCursorPos Pt If Button = 1 Then ItemRetour = TrackPopupMenu(hMenu, TPM_LEFTALIGN Or TPM_RETURNCMD, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&) ' <-- Modifié 'Debug.Print "Item #" & ItemRetour ' <-- Ajouté Me.Caption = "Item #" & ItemRetour ' <-- Ajouté ' Il resterait à mettre un Select Case appellant ' une fonction selon la valeur de ItemRetour. Else TrackPopupMenu GetSystemMenu(Me.hwnd, False), TPM_LEFTALIGN, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0& ' <-- Utile niveau académique mais pas pratique. End If End Sub 'Tu avais oublié ceci, pour ceux qui lisent c'est important: Private Sub Form_Unload(Cancel As Integer) 'Destroy our menu DestroyMenu hMenu End Sub

-------------------------------
Réponse au message :
-------------------------------

Comment capter le click de la souris sur un bouton dans un popupmenu créé par : CreatePopupMenu, TrackPopupMenu, AppendMenu

Merci

Schouly





ex : (allapi.net)

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 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

Merci bcp ...


Pourquoi est-ce important de détruire le menu en sortant ? ... (pour libérer la mémoire ?)


Schouly

J'ai aucune idée des circonstances exactes où ça planterais, mais comme on crée qqch avec les API, bah faut les retirer pour pas justement que ça plante. P-ê aussi pour éviter que devienne des ressources non libérées à la sortie de l'App. (memory leak)



-------------------------------
Réponse au message :
-------------------------------

Merci bcp ...


Pourquoi est-ce important de détruire le menu en sortant ? ... (pour libérer la mémoire ?)


Schouly