如何在windows 10上显示带有acess vba系统的弹出菜单

Question

我有一个访问程序(accde)，从系统开始最小化。当用户单击系统程序图标时，必须显示弹出式菜单。从今天起一切都很完美。今天，我已经对64位和vb7的程序进行了调整。除了显示系统上的弹出菜单外，它工作正常，没有显示。函数"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

我已经找到了解决办法。必须使用函数InsertMenu而不是InsertMenuItem。我发布了必须更改的函数代码，

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