Die Community zu .NET und Classic VB.

Startseite / Tipps / VB 5/6-Tipp 0141: Menüs und Popupmenüs mit Spalten

VB 5/6-Tipp 0141: Menüs und Popupmenüs mit Spalten

 von ActiveVB

Schwierigkeitsgrad:

Verwendete API-Aufrufe: GetMenu, GetMenuItemCount, GetMenuItemID, GetMenuStringA (GetMenuString), GetSubMenu, ModifyMenuA (ModifyMenu)

Download: Download des Beispielprojektes [2,44 KB]

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Kontrollkästchen-Steuerelement "Check1"
' Steuerelement: Beschriftungsfeld "Label1"
' Steuerelement: Menü "mnuMenu"
' Steuerelement: Menü "mnuMenuItem" (Index von 0 bis 0) auf mnuMenu

Option Explicit

Private Declare Function GetMenu Lib "user32" (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 GetMenuItemCount Lib "user32" _
        (ByVal hMenu As Long) As Long
        
Private 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
        
Private Declare Function GetMenuItemID Lib "user32" (ByVal _
        hMenu As Long, ByVal nPos As Long) As Long
        
Private Declare Function ModifyMenu Lib "user32" Alias _
        "ModifyMenuA" (ByVal hMenu As Long, ByVal nPosition _
        As Long, ByVal wFlags As Long, ByVal wIDNewItem As _
        Long, ByVal lpString As Any) As Long

Const MF_MENUBARBREAK = &H20&
Const MF_MENUBREAK = &H40&
Const MF_BYPOSITION = &H400&

Private Sub Form_Load()
  Dim X%

    For X = 0 To 24
      If X > 0 Then Load mnuMenuItem(X)
      mnuMenuItem(X).Caption = Chr$((Int(X / 5)) + 65) _
                             & CStr(X Mod 5 + 1)
    Next X

    Call MakeColums
End Sub

Private Sub Label1_MouseDown(Button As Integer, Shift As _
                             Integer, X As Single, Y As Single)
  If Button = vbRightButton Then PopupMenu mnuMenu
End Sub

Private Sub Check1_Click()
  Call MakeColums
End Sub

Private Sub mnuMenuItem_Click(Index As Integer)
  Me.Caption = mnuMenuItem(Index).Caption
End Sub

Private Sub MakeColums()
  Dim hMenu&, hSubMenu&
  Dim mnuItemCnt&, mnuItemID&, mnuItemText$
  Dim Mode&, X%, Result&, Buffer$
  
    hMenu = GetMenu(Me.hwnd)
    hSubMenu = GetSubMenu(hMenu, 0)
    
    If Check1.Value = vbChecked Then
      Mode = MF_MENUBARBREAK
    Else
      Mode = MF_MENUBREAK
    End If
    
    mnuItemCnt = GetMenuItemCount(hSubMenu)
    For X = 6 To mnuItemCnt Step 5
      
      Buffer = Space$(256)
      Result = GetMenuString(hSubMenu, X - 1, Buffer, _
                             Len(Buffer), MF_BYPOSITION)
      mnuItemText = Left$(Buffer, Result)

      mnuItemID = GetMenuItemID(hSubMenu, X - 1)
      Call ModifyMenu(hSubMenu, X - 1, MF_BYPOSITION Or Mode, _
                      mnuItemID, mnuItemText)
    Next X
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Archivierte Nutzerkommentare 

Klicken Sie diesen Text an, wenn Sie die 2 archivierten Kommentare ansehen möchten.
Diese stammen noch von der Zeit, als es noch keine direkte Forenunterstützung für Fragen und Kommentare zu einzelnen Artikeln gab.
Aus Gründen der Vollständigkeit können Sie sich die ausgeblendeten Kommentare zu diesem Artikel aber gerne weiterhin ansehen.