使用Windows API的第三方应用程序菜单控件

时间:2019-07-11 20:32:44

标签: vba winapi menuitem

我正在寻找一种使用Windows API从VBA自动化第三方的方法。我已经设法使其他控件自动化,例如命令按钮,文本字段,列表框(几乎),选项卡等。我非常有信心,就我已经设法做到的而言,这没什么大不了的可以实现,但是由于某些原因,菜单控制失败。

我已经设法控制“基本”应用程序上的菜单项,例如记事本,记事本++等。我认为并非所有菜单都以相同的方式(ID与位置)进行控制,但我没有进行管理检查哪种情况适用于我的目标应用。

Option explicit

FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr

Declare PtrSafe Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal hwnd As LongPtr, ByVal wMsg As Long, ByVal wParam As LongPtr, ByVal lParam As LongPtr) As Long

Declare PtrSafe Function GetMenu Lib "user32" (ByVal hwnd As LongPtr) As LongPtr
Declare PtrSafe Function GetSubMenu Lib "user32" (ByVal hMenu As LongPtr, ByVal nPos As Long) As LongPtr
Declare PtrSafe Function GetMenuItemID Lib "user32" (ByVal hMenu As LongPtr, ByVal nPos As Long) As Long
Declare PtrSafe Function GetMenuString Lib "user32" Alias "GetMenuStringA" (ByVal hMenu As LongPtr, ByVal wIDItem As Long, ByVal lpString As String, ByVal nMaxCount As Long, ByVal wFlag As Long) As Long
Declare PtrSafe Function GetMenuInfo Lib "user32" (ByVal hMenu As LongPtr, ByRef lpcmi As MENUINFO) As Long 'not sure it really exists

Public Type MENUINFO
   cbSize As Long
   fMask As Long
   dwStyle As Long 'MNS_NOTIFYBYPOS
   cyMax As Long
   hbrBack As Long
   dwContextHelpID As Long
   dwMenuData As Long
End Type

Public Const MNS_NOTIFYBYPOS As Long = &H8000000

Public Const WM_COMMAND As Long = &H111
Public Const WM_MENUCOMMAND As Long = &H126

Public Const MF_BYCOMMAND As Long = &H0&
Public Const MF_BYPOSITION As Long = &H400

'---------------------------------

'
Sub test()

    Dim hwnd As LongPtr: hwnd = FindWindow(lpClassName:="Notepad", lpWindowText:="Untitled - Notepad")

    'Overall menu
    Dim hMenu As LongPtr: hMenu = GetMenu(hwnd:=hwnd)

    'File sub-menu
    Dim hSubMenu As LongPtr: hSubMenu = GetSubMenu(hMenu:=hMenu, nPos:=0)

    'Open... command ID
    Dim menuItem As Long: menuItem = GetMenuItemID(hMenu:=hSubMenu, nPos:=1)

    Dim infoMenu As MENUINFO

    infoMenu.cbSize = Len(infoMenu)

    Dim lRet As Long: lRet = GetMenuInfo(hMenu:=hMenu, lpcmi:=infoMenu) 'returns 0 - not sure it really exists as I only found examples on Russian-spoken websites...

    'infoMenu.dwStyle ---> MNS_NOTIFYBYPOS to check, but infoMenu fails

    Debug.Print Err.LastDllError 'returns 87, ie. Invalid parameter I believe

    'Debug.Print menuString(hMenu:=hMenu, wIDItem:=1, wFlag:=MF_BYPOSITION)

    'wParam:
    '      Menu: 0 ~ Menu identifier (IDM_*)
    '      Accelerator: 1 ~ Menu identifier (IDM_*)
    'lParam: 0&
    PostMessage hwnd:=hwnd, wMsg:=WM_COMMAND, wParam:=GetMenuItemID(hMenu:=hSubMenu, nPos:=3), lParam:=ByVal 0& ' OK open the Notepad Open dialog (asynchronously)

    'wParam: The zero-based index of the item selected.
    'lParam: A handle to the menu for the item selected.
    'PostMessage(hwnd:=hwnd, wMsg:=WM_MENUCOMMAND, wParam:=1, lParam:=hwndSubMenu) 'not tested with the targeted app yet

End Sub

您能告诉我 WM_COMMAND WM_NOTIFY 有什么区别吗?我已经在某处读到了 WM_NOTIFY 对于需要传递其他参数的现代应用程序将以相同的方式工作,但这让我感到困惑!

0 个答案:

没有答案