Icon-Menü mit Schriftformatierung ohne Subclass Hier zeigen wir, wie sich über das Windows-API ein Menü mit Icons aus einer ImageList erstellen lässt.
Autor:   Jürgen Fienau	Bewertung:     [ Jetzt bewerten ]	Views:  12.400
computer.net-berlin.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 7 Bewertung insgesamt: gut Durchschnittliche Bewertung: 4.4 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Mit den bekannten API-Funktionen GetMenu und GetSubMenu sowie GetMenuItemID und ModifyMenu lassen sich Icons aus einer ImageListBox und die Inhalte einer PictureBox in das Menü einbinden. Mit den Einstellungen der PictureBoxen kann man dann die Schrift sowie Farben verändern.

Erstellen Sie ein neues Projekt, platzieren auf die Form eine PictureBox (Picture1 mit Index=0), ein Label-Control (lblMenu), sowie ein ImageList-Control mit 14 beliebigen Symbolen, die dann später im Menü angezeigt werden sollen. Erstellen Sie jetzt mit dem VB-Menüeditor noch ein Menü mit folgender Struktur:

Icon Menu (mnuDatei)
... (mnuDummy)

Fügen Sie nachfolgenden Code in den Allgemein-Teil der Form ein:

Option Explicit
 
' benötigte API-Deklarationen
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 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

Private Sub Form_Load()
  ' Menü dynamisch erstellen
  SetMenu
End Sub

In der Prozedur SetMenu erstellen wir jetzt dynamisch das gewünschte Menü mit 14 Einträgen, wobei jeder Eintrag mit Symbol angezeigt werden soll.

Private Sub SetMenu()
  Dim mHandle As Long
  Dim lRet As Long
  Dim sHandle As Long
  Dim MenuID As Long
  Dim x As Long
  Dim D As Long
 
  ' Handle des Hauptmenus (MEnuBar) ermitteln
  mHandle = GetMenu(hwnd)
 
  ' Handle des zweiten Untermenus ermitteln
  sHandle = GetSubMenu(mHandle, 0)
 
  ' Anzahl der Menueinträge bestimmen
  For x = 0 To 13
    ' Menü dynamisch laden
    If x > 1 Then
      Load mnuDummy(x)
      Load Picture1(x)
    End If
 
    With Picture1(x)
      ' Menu-Hintergrund
      .BackColor = &H80000004 
 
      ' Bitmaps in PictureBox setzen.
      .Picture = ImageList1.ListImages(x + 1).Picture
    End With
  Next x
 
  ' Schriftfarbe bestimmter Menü-Einträge ändern
  Picture1(2).ForeColor = vbBlue
  Picture1(5).ForeColor = vbBlue
  Picture1(13).ForeColor = vbRed
 
  ' Schrifteinstellungen (letzter Menüpunkt FETT)
  Picture1(13).FontBold = True
 
  ' Bildfelder mit neuen Texten
  Picture1(0).Print "         Enabled"
  Picture1(1).Print "         Öffnen"
  Picture1(2).Print "         Thumbnails"
  Picture1(3).Print "         Icon extrahieren"
  Picture1(4).Print "         Scannen/Kamera"
  Picture1(5).Print "         Quelle wählen"
  Picture1(6).Print "         Als Icon konvert"
  Picture1(7).Print "         Speichern"
  Picture1(8).Print "         Speichern unter..."
  Picture1(9).Print "         Schreibschutz entf."
  Picture1(10).Print "         Attribute"
  Picture1(11).Print "         Explorer öffnen"
  Picture1(12).Print "         Drucken"
  Picture1(13).Print "       Beenden"
 
  ' Bildfelder dem Menü zuweisen
  For x = 0 To 13
    With Picture1(x)
      .Picture = .Image
      MenuID = GetMenuItemID(sHandle, x)
      D = ModifyMenu(sHandle, MenuID, &H0 Or &H4, MenuID, CLng(.Picture))
    End With
  Next x
End Sub

Private Sub mnuDummy_Click(Index As Integer)
  ' Anzeige im Label-Control
  lblMenu.Caption = "Menu item  " & CStr(Index) & "  wurde ausgewählt."
 
  ' Menu Auswertung
  Select Case Index
    Case 0
      If mnuDummy(13).Enabled = True Then
        mnuDummy(13).Enabled = False
      Else
        mnuDummy(13).Enabled = True
      End If
    Case 1
 
    Case 3
 
    Case 4
 
    Case 5
 
    Case 6
 
    Case 7
 
    Case 13
      ' Beenden
      Unload Me
  End Select
End Sub