vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
vb@rchiv Offline-Reader - exklusiv auf der vb@rchiv CD Vol.4  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Oberfläche · Menüs   |   VB-Versionen: VB4, VB5, VB618.06.04
Menü per API-Befehl öffnen

Dieses Beispiel zeigt wie man ein Menü per API Befehl öffnen kann, so als wenn der Benutzer es angeklickt hätte.

Autor:   Matthias KruppBewertung:     [ Jetzt bewerten ]Views:  12.504 
ohne HomepageSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

Heute zeigen wir Ihnen, wie man ein Menü per API-Befehel öffnen kann, so als hätte der Benutzer das Menü geöffnet.

Erstellen Sie ein neues Projekt und fügen der Form mit Hilfe des VB-Menüeditors ein Menü in folgender Form hinzu:

Menu1
...Eintrag1
...Eintrag2
...Eintrag3

Menu2
...Eintrag1
...Eintrag2
...Eintrag3

Platzieren Sie auf die Form einen Command, über den dann ein beliebiges Menü der Menüzeile geöffnet werden soll.

Fügen Sie nachfolgenden Code in den Codeteil der Form ein:

Option Explicit
 
' Benötigte API-Deklarationen
Private Type RECT
  left As Long
  top As Long
  right As Long
  bottom As Long
End Type
 
Private Type MENUITEMINFO
  cbSize              As Long
  fMask               As Long
  fType               As Long
  fState              As Long
  wID                 As Long
  hSubMenu            As Long
  hbmpChecked         As Long
  hbmpUnchecked       As Long
  dwItemData          As Long
  dwTypeData          As String
  cch                 As Long
End Type
 
Private Declare Function GetMenu Lib "user32.dll" ( _
  ByVal hWnd As Long) As Long
 
Private Declare Function GetSubMenu Lib "user32" ( _
  ByVal hMenu As Long, _
  ByVal nPos As Long) As Long
 
Private Declare Function TrackPopupMenu Lib "user32.dll" ( _
  ByVal hMenu As Long, _
  ByVal uFlags As Long, _
  ByVal x As Long, _
  ByVal y As Long, _
  ByVal nReserved As Long, _
  ByVal hWnd As Long, _
  ByVal prcRect As Long) As Long
 
Private Declare Function HiliteMenuItem Lib "user32.dll" ( _
  ByVal hWnd As Long, _
  ByVal hMenu As Long, _
  ByVal wIDHiliteItem As Long, _
  ByVal wHilite As Long) As Long
 
Private Declare Function GetMenuItemRect Lib "user32.dll" ( _
  ByVal hWnd As Long, _
  ByVal hMenu As Long, _
  ByVal uItem As Long, _
  ByRef lprcItem As RECT) As Long
' Menü per API öffnen
Private Sub Command1_Click()
  Dim nResult As Long
  Dim hMenu As Long
  Dim hSubMenu As Long
  Dim lFlags As Long
  Dim oRect As RECT
  Dim lMenuID As Long
 
  ' ID des Menüs der Menüzeile, beginnend von
  ' 0 für das erste Menü, 
  ' 1 für das zweite Menü usw.
  lMenuID = 1 
 
  ' Handle der Menüleiste
  hMenu = GetMenu(Me.hWnd)
 
  ' Handle des Menüeintrags der Menüzeile
  hSubMenu = GetSubMenu(ByVal hMenu, lMenuID)
 
  ' Menüeintrag auswählen
  nResult = HiliteMenuItem(Me.hWnd, ByVal hMenu, lMenuID, &H480)
 
  ' Größe und Position des Menüeintrags ermitteln
  nResult = GetMenuItemRect(Me.hWnd, ByVal hMenu, lMenuID, oRect)
 
  With oRect
    ' Menü aufklappen
    lFlags = &H0 Or &H100
    nResult = TrackPopupMenu(ByVal hSubMenu, lFlags, .left, .top + 18, 0&, Me.hWnd, 0&)
 
    ' Menüeintrag der Menüzeile wieder normal darstellen
    nResult = HiliteMenuItem(Me.hWnd, ByVal hMenu, lMenuID, &H400)
  End With
End Sub

Starten Sie jetzt das Projekt. Beim Klick auf den CommandButton wird autom. das 2. Menü der Menüzeile aufgeklappt, so als hätte der Anwender das Menü bspw. per Mausklick geöffnet.

Erweiterung:
Nachfolgend noch eine Erweiterung des Tipps. Das Menü lässt sich natürlich auch vollständig per API erstellen, ohne dass man zur Entwurfszeit den VB-Menüeditor verwendet.

Ergänzen Sie den Allgemeinteil der Form1 um nachfolgende API-Deklarationen:

Private Const MF_STRING As Long = &H0&
 
Private Declare Function CreateMenu Lib "user32.dll" () As Long
 
Private Declare Function DestroyMenu Lib "user32.dll" ( _
  ByVal hMenu As Long) As Long
 
Private Declare Function SetMenu Lib "user32.dll" ( _
  ByVal hWnd As Long, _
  ByVal hMenu As Long) As Long
 
Private Declare Function DrawMenuBar Lib "user32.dll" ( _
  ByVal hWnd As Long) As Long
 
Private Declare Function AppendMenu Lib "user32.dll" _
  Alias "AppendMenuA" ( _
  ByVal hMenu As Long, _
  ByVal wFlags As Long, _
  ByVal wIDNewItem As Long, _
  ByVal lpNewItem As Any) As Long
 
Private Declare Function SetMenuItemInfo Lib "user32.dll" _
  Alias "SetMenuItemInfoA" ( _
  ByVal hMenu As Long, _
  ByVal un As Long, _
  ByVal bool As Boolean, _
  ByRef lpcMenuItemInfo As MENUITEMINFO) As Long
 
Private lMenuID() As Long

Beim Laden der Form soll das Menü per API erstellt werden:

Private Sub Form_Load()
  Dim nResult As Long
  Dim mnuEntry As MENUITEMINFO
 
  ' Handle für Menüzeile mit 2 Menüs
  ReDim lMenuID(2)
 
  ' Menüzeile erstellen
  lMenuID(0) = CreateMenu()
 
  ' 1. Menüeintrag erstellen
  Call AppendMenu(lMenuID(0), MF_STRING, 1000, "&Menu1")
 
  ' 2. Menüeintrag erstellen
  Call AppendMenu(lMenuID(0), MF_STRING, 1000, "&Menu2")
 
  ' Menüzeile anzeigen
  nResult = SetMenu(Me.hWnd, lMenuID(0))
  nResult = DrawMenuBar(Me.hWnd)
 
  ' 1. SubMenü erstellen
  lMenuID(1) = CreateMenu()
  Call AppendMenu(lMenuID(1), MF_STRING, 1001, "&Sub Eintrag 1")
  Call AppendMenu(lMenuID(1), MF_STRING, 1002, "&Sub Eintrag 2")
  Call AppendMenu(lMenuID(1), MF_STRING, 1003, "&Sub Eintrag 3")
 
  ' Menüstruktur der Menüzeile zuweisen
  With mnuEntry
    .cbSize = Len(mnuEntry)
    .fMask = &H10 Or &H4 Or &H2 Or &H1
    .fType = &H0
    .hSubMenu = lMenuID(1)
    .dwTypeData = "&Neues Menue"
    .cch = Len(Trim$(.dwTypeData))
    .wID = 1000
  End With
  nResult = SetMenuItemInfo(lMenuID(0), 1000, 0, mnuEntry)
 
  ' 2. SubMenü erstellen
  lMenuID(2) = CreateMenu()
  Call AppendMenu(lMenuID(2), MF_STRING, 1001, "&Sub Eintrag 1")
  Call AppendMenu(lMenuID(2), MF_STRING, 1002, "&Sub Eintrag 2")
  Call AppendMenu(lMenuID(2), MF_STRING, 1003, "&Sub Eintrag 3")
 
  ' Menüstruktur der Menüzeile zuweisen
  With mnuEntry
    .cbSize = Len(mnuEntry)
    .fMask = &H10 Or &H4 Or &H2 Or &H1
    .fType = &H0
    .hSubMenu = lMenuID(2)
    .dwTypeData = "&Neues Menue"
    .cch = Len(Trim$(.dwTypeData))
    .wID = 1000
  End With
  nResult = SetMenuItemInfo(lMenuID(0), 1000, 0, mnuEntry) 
End Sub
Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
  ' Menü zerstören
  Dim i As Long
 
  For i = UBound(lMenuID) To 0 Step -1
    Call DestroyMenu(lMenuID(i))
  Next i
End Sub

Dieser Tipp wurde bereits 12.504 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Aktuelle Diskussion anzeigen (3 Beiträge)

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv  Vol.6
(einschl. Beispielprojekt!)

Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv!
- nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten
- Symbol-Galerie mit mehr als 3.200 Icons im modernen Look
Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel