简体   繁体   中英

How to show popup menu with acess vba systray on windows 10

I have an access program (accde) that starts minimized on systray. When user clicks on systray program icon a popup menu must be shown. All worked perfect since today. Today I have adapted program for 64 bits and vb7. It works correctly except showing popupmenu on systray.It's not being shown. Function "TrackPopupMenu" returns 0 always. I post here the code that must show popupmenu. Anybody can help me please? Thanks a lot. Francesc

    Public Declare PtrSafe Function GetCursorPos Lib "USER32" (lpPoint As POINTAPI) As LongPublic Declare PtrSafe Function CreatePopupMenu Lib "USER32" () As LongPtr
    Public Declare PtrSafe Function InsertMenu Lib "USER32" Alias "InsertMenuA" (ByVal hMenu As LongPtr, ByVal nPosition As Long, ByVal wFlags As Long, ByVal wIDNewItem As LongPtr, ByVal lpNewItem As Any) As Long
    Public Declare PtrSafe Function InsertMenuItem Lib "USER32" Alias "InsertMenuItemA" (ByVal hMenu As LongPtr, ByVal un As Long, ByVal bool As Boolean, ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
    Public Declare PtrSafe Function TrackPopupMenu Lib "USER32" (ByVal hMenu As LongPtr, ByVal wFlags As LongPtr, ByVal X As LongPtr, ByVal Y As LongPtr, ByVal nReserved As LongPtr, ByVal hWnd As LongPtr, lprc As RECT) As LongPtr
           
    Public Declare PtrSafe Function DestroyMenu Lib "USER32" (ByVal hMenu As LongPtr) As Long

Public Function buildMenu() As LongPtr

' Office Commandbars do not work well when displayed over the taskbar
' therefor we'll create the context-menu by API-Calls.

Dim hMenu   As LongPtr

' Creating the PopUpMenu
hMenu = CreatePopupMenu

' Inserting the MenuItems in the PopUpMenu
Call addMenuItem(hMenu, lngRESTORE_WINDOW, "Mostra Pantalla")
'Call addMenuItem(hMenu, lngSHOW_ACCESSWINDOW, "Show Access Window")
Call addMenuItem(hMenu, lngEXIT_APP, "Sortir")

' Return the handle to the PopUpMenu
buildMenu = hMenu
End Function

Private Sub addMenuItem(hMenu As LongPtr, ItemID As Long, ItemText As String)

Dim MenItemInf As MENUITEMINFO

With MenItemInf
    .cbSize = Len(MenItemInf)
    .fState = MF_ENABLED
    .fMask = MIIM_STATE Or MIIM_TYPE Or MIIM_ID
    .fType = MFT_STRING
    .dwItemData = 0
    .cch = Len(ItemText)
    .hSubMenu = 0
    .wID = ItemID
    .dwTypeData = ItemText
    .hbmpChecked = 0
    .hbmpUnchecked = 0
End With

Call InsertMenuItem(hMenu, 0, 1, MenItemInf)

End Sub

Private Sub trayIconRClick()

Dim hMen As LongPtr
Dim lngRetVal, lngRetVal1 As LongPtr
Dim curPoint As POINTAPI
Dim lptrREct As RECT


' Build the systray-contextmenu an retrieve the handle
hMen = buildMenu()

' get the actual cursor position
lngRetVal = GetCursorPos(curPoint)

If lngRetVal <> 0 Then
    ' Show the systray-contextmenu at the cursor-position
     
    lngRetVal1 = TrackPopupMenu(hMen, TPM_BOTTOMALIGN Or TPM_LEFTBUTTON Or TPM_NOANIMATION, curPoint.X, curPoint.Y, 0, Application.hWndAccessApp, lptrREct)
    
        

    If lngRetVal1 <> 0 Then
        ' check which menuitem was clicked
        Select Case lngRetVal
        Case lngRESTORE_WINDOW
            DoCmd.Restore
            Call bringWindowToFront(Me.hWnd)
        Case lngSHOW_ACCESSWINDOW
            Call ShowWindow(Application.hWndAccessApp, SW_SHOW)
        Case lngEXIT_APP
            DoCmd.Close acForm, Me.Name, acSaveNo
            
            On Error Resume Next
            Call unregisterIcon
            ' Free icon-resources
            Call DeleteObject(hIcon)
            Application.Quit (acQuitSaveNone)
        
        End Select
    End If

End If

' Free menu-ressources
Call DestroyMenu(hMen)
End Sub

I have found the solution. Function InsertMenu must be used instead InsertMenuItem. I post the code of the function that must be changed,

Public Function buildMenu() As LongPtr

 ' Office Commandbars do not work well when displayed over the taskbar ' therefor we'll create the context-menu by API-Calls. Dim hMenu As LongPtr ' Creating the PopUpMenu hMenu = CreatePopupMenu InsertMenu hMenu, 0, MF_BYCOMMAND Or MF_STRING, lngRESTORE_WINDOW, "Mostra Pantalla" InsertMenu hMenu, 0, MF_BYCOMMAND Or MF_STRING, lngEXIT_APP, "Sortir" ' Return the handle to the PopUpMenu buildMenu = hMenu

End Function

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM