如何在 windows 10 上使用訪問 vba 系統托盤顯示彈出菜單

Question

我有一個在系統托盤上開始最小化的訪問程序 (accde)。 當用戶單擊系統托盤程序圖標時，必須顯示一個彈出菜單。 從今天開始，一切都很完美。 今天我已經為 64 位和 vb7 改編了程序。 除了在系統托盤上顯示彈出菜單外，它可以正常工作。它沒有被顯示。 Function "TrackPopupMenu" 總是返回 0。 我在這里發布必須顯示彈出菜單的代碼。 任何人都可以幫助我嗎？ 非常感謝。 弗朗西斯科

    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

Answer 1

我找到了解決方案。 Function 必須使用 InsertMenu 代替 InsertMenuItem。 我貼出必須更改的 function 的代碼，

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