Popup menu 1

[Ablecken]

i have a prog that sits in the system tray and has a popup menu. i have everything working but if i popup the menu and dont want to click on anything it just stays there until i click on something. how do i make it disapear when i move the mouse off the menu?

 

[poltergeist]

The popup menus only have a Click-event so this problem only can be captured with a API procedure buts very complicate.

I do it with a menupoint "Close" and send a ESC

Private Sub pop1_Click(Index As Integer)
Select Case Index
Case 0
SendKeys "{Esc}"
Case 1
'....
Case 2
'....
End Select
End Sub



peterguhl@yahoo.de

 

[poltergeist]

With this code de popup disapear when you make a Click outside de popup

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
Dim EMenu As Boolean
Private Sub Form_Load()
hMenu = CreatePopupMenu()
'Append a few menu items
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
'Get the position of the mouse cursor
GetCursorPos Pt
If Button = 1 Then
'Show our popupmenu
If EMenu Then
SendKeys "{esc}"
EMenu = False
Else
TrackPopupMenu hMenu, TPM_LEFTALIGN, Pt.x, Pt.y, 0, Me.hwnd, ByVal 0&
EMenu = True
End If

Else
'Show our form's default popup menu
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)
DestroyMenu hMenu
End Sub



peterguhl@yahoo.de

 

[poltergeist]

This example will be run when you have a simple popupmenu. There is one restrinction you must enumerate your subMenu
Index start with 1 because 0 is the click out of window.

If there is anyone who know a better method please let it know.


Private Type POINTAPI
x As Long
y As Long
End Type

Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

Private Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Sub InflateRect Lib "user32" (lpRect As RECT, ByVal x As Long, ByVal y As Long)
Private Declare Function PtInRect Lib "user32" (lpRect As RECT, ByVal ptx As Long, ByVal pty As Long) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Private mMenuWnd As Long
Private mMenuRect As RECT
Private mMenuIndex As Long

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
Select Case Button
Case vbRightButton
mMenuIndex = 0
PopupMenu mnuPopUp, vbPopupMenuRightButton
Timer1.Interval = 0
Select Case mMenuIndex
Case 0
Debug.Print "Popup-Menü abgebrochen"
Case Else
Debug.Print "Popup-Menü Index " & mMenuIndex
End Select
End Select
End Sub

Private Sub Form_Unload(Cancel As Integer)
Timer1.Interval = 0
End Sub

Private Sub mnuPopUp_Click()
mMenuWnd = FindWindow("#32768", vbNullString)
GetWindowRect mMenuWnd, mMenuRect
InflateRect mMenuRect, 5, 5
Timer1.Interval = 50
End Sub

Private Sub mnuPopUpItem_Click(Index As Integer)
mMenuIndex = Index
End Sub

Private Sub Timer1_Timer()
Dim nPoint As POINTAPI
Const WM_CLOSE = &H10
GetCursorPos nPoint
If Not CBool(PtInRect(mMenuRect, nPoint.x, nPoint.y)) Then
SendMessage mMenuWnd, WM_CLOSE, 0, 0
End If
End Sub


enjoy

peterguhl@yahoo.de