title image


Smiley Re: direktes Aufrufen von Programm-Menüpunkten
Hallo,



ich mache das in etwa so:

2 Funktionen (zus. Subfunktionen)



z.B. für Aktivieren des Menü-Eintrags:



Bearbeiten - Suchen



Dim iMenuePos as Long



hMenue = fGetMenue(hWwnd, "&Bearbeiten", iMenuePos)

Call fSelectMenueItem(hWnd, hMenue, "&Suchen...", iMenuePos)



Läuft in etwa so:



1. Window-Handle hWnd der Anwendung ermitteln



fGetMenue



2. Menü-Handle hMenue der Anwendung mit

3. Anzahl der Menüeintrage einlesen

4. jeden Menü-Eintrag auslesen und mit Vorgabe vergleichen



fSelectMenueItem

5. im Menue hMenue subMenue durchlaufen, bis der Eintrag gefunden wird

6. Mittels Sendmessage Klick auf Menüeintrag simulieren



Gruß

bwe



p.s. Hab das allerdings noch nicht mit neuen Menüs probiert, bei denen nach gewisser Zeit die inaktiven Einträge ausgeblendet werden!

Sollte / Könnte aber trotzdem funktionieren.



Code: (hoffe ich habe nichts vergessen)



Public Declare Function GetMenu Lib "user32" _

        (ByVal hwnd As Long) As Long



Public Declare Function GetSubMenu Lib "user32" _

        (ByVal hMenu As Long, ByVal nPos As Long) As Long



Public Declare Function GetMenuItemCount Lib "user32" _

        (ByVal hMenu As Long) As Long



Public Declare Function GetMenuState Lib "user32" _

        (ByVal hMenu As Long, ByVal wID As Long, _

         ByVal wFlags As Long) As Long



Public Declare Function GetMenuString Lib "user32" _

         Alias "GetMenuStringA" (ByVal hMenu As Long, _

         ByVal wIDItem As Long, ByVal lpString As String, _

         ByVal nMaxCount As Long, ByVal wFlag As Long) As Long



Public Declare Function GetMenuItemID Lib "user32" _

          (ByVal hMenu As Long, _

          ByVal nPos As Long) As Long



Public Const WM_COMMAND = &H111&

Public Const WM_SETTEXT = &HC&

Public Const WM_GETTEXT = &HD&



Public Const MF_BYPOSITION = &H400&

Public Const MF_CHECKED = &H8&

Public Const MF_UNCHECKED = &H0&

Public Const MF_HILITE = &H80&

Public Const WM_MENUSELECT = &H11F

Public Const WM_INITMENU = &H116&

Public Const MF_MOUSESELECT = &H8000&





Public Function fGetMenue(ByVal hwnd, ByVal menue$, ByRef iMenuePos As Integer) As Long

 

    On Error Resume Next



    Dim hMenu As Long

    Dim MenuCount As Long

    Dim buffer As String

    Dim Result As Long

    

    Dim i As Long

    

    fGetMenue = 0

    

    'Get the menu handle.

    hMenu = GetMenu(hwnd)



    'Check to see if there is no menu.

    If hMenu <> 0 Then

      'Get the number of top-level menus.

      MenuCount = GetMenuItemCount(hMenu)



      'Enumerate through all top-level menus.

      For i = 0 To MenuCount - 1

                             

        'Menü-Bezeichnung lesen

        buffer = Space(255)

       

        'Call the API to get the caption for the menu item.

        Result = GetMenuString(hMenu, i, buffer, _

                 Len(buffer), MF_BYPOSITION)

       

        'Trim the buffer of extra characters.

        buffer = Left$(buffer, Result)

        

        If UCase(buffer) = UCase(menue$) Then

            'Get a handle to the submenu.

            fGetMenue = GetSubMenu(hMenu, i)

            iMenuePos = i

            Exit Function

            

        End If

        

      Next

    

    End If

    

End Function



Public Function fGetMenueItem(ByVal hMenue As Long, ByVal Item$, Optional bExact As Boolean = False) As Long

    

On Error Resume Next



    Dim i As Long

    Dim MenuItems As Long

    Dim hSubMenue As Long

    Dim buffer As String

    Dim Result As Long



    fGetMenueItem = -1

    

    'Get the count of menu items in this menu.

    MenuItems = GetMenuItemCount(hMenue)



    'Loop through all the items on the menu.

    For i = 0 To MenuItems - 1

      'Attempt to get a submenu for each menu item.

      hSubMenue = GetSubMenu(hMenue, i)

        

      'Check for a submenu with something selected on it.

      If Not hSubMenue Then

        'Set buffer size.

        buffer = Space(255)

    

        'Call the API to get the caption for the menu item.

        Result = GetMenuString(hMenue, i, buffer, _

                               Len(buffer), MF_BYPOSITION)

    

        'Trim the buffer of extra characters.

        buffer = Left$(buffer, Result)

        

        

        If InStr(UCase(buffer), UCase(Item$)) > 0 Then

                           

           fGetMenueItem = GetMenuItemID(hMenue, i)

           Exit Function

           

        End If

      End If

    Next i



End Function



Public Function fSelectMenueItem(hwnd, ByVal hMenue, ByVal Item$, iMenuePos As Integer) As Integer

    ' Sucht in der Anwendung/Fenster hWnd nach dem Menüeintrag

    ' Item

        

        

    On Error Resume Next



    Dim hItem As Long

    Dim bExact As Boolean

        

    bExact = InStr(Item$, "&") > 0

    

    hItem = fGetMenueItem(hMenue, Item$, bExact)

        

    If (hItem > 0) Then

        Call SendMessage(hwnd, WM_INITMENU, ByVal hMenue, ByVal 0&)

        Call SendMessage(hwnd, WM_MENUSELECT, ByVal CLng(&H900000 + iMenuePos), ByVal hMenue)

        Call SendMessage(hwnd, &H117&, ByVal hMenue, ByVal CLng(iMenuePos)) ' WM_INITMENUPOPUP

        Call SendMessage(hwnd, &H125&, ByVal hMenue, ByVal &H0&)            ' WM_UNINITMENUPOPUP

        Call SendMessage(hwnd, WM_MENUSELECT, ByVal &HFFFF0000, ByVal &H0&)

        Call SendMessage(hwnd, &H212&, ByVal &H0&, ByVal &H0&)                ' WM_EXITMENULOOP

        Call SendMessage(hwnd, WM_COMMAND, ByVal hItem, ByVal &H0&)

        fSelectMenueItem = 1

    Else

        fSelectMenueItem = 0

    End If

       

End Function



Public Function fGetSubMenue(hMenue As Long, SubMenue$, ByRef iSubMenuePos) As Long



On Error Resume Next



  Dim i As Integer

  Dim hSubMenue As Long

  Dim buffer As String

  Dim Result As Long

    

  For i = 1 To GetMenuItemCount(hMenue)

    hSubMenue = GetSubMenu(hMenue, i)

    

    If hSubMenue Then

        'Set buffer size.

        buffer = Space(255)

    

        'Call the API to get the caption for the menu item.

        Result = GetMenuString(hMenue, i, buffer, _

                               Len(buffer), MF_BYPOSITION)

    

        'Trim the buffer of extra characters.

        buffer = Left$(buffer, Result)

     

        

        If UCase(buffer) = UCase(SubMenue$) Then

                           

           fGetSubMenue = hSubMenue

           iSubMenuePos = i

           Exit Function

           

        End If

      End If

    

  Next

  

  hSubMenue = 0

  

End Function

Code eingefügt mit Syntaxhighlighter 1.14

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: