Mehrfarbige Einträge in der Combobox Hier zeigen wir Ihnen, wie Sie den Anwender mit einem kleinen Trick mit einer ComboBox überraschen können, in denen die Text mehrfarbig angezeigt werden.
Autor:   Ralf Hähnel	Bewertung:     [ Jetzt bewerten ]	Views:  14.906
www.hippsoft.de	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

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

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Wollten Sie schon immer einmal den Anwender mit einer ComboBox überraschen, in der die einzelnen Einträge mehrfarbig angezeigt werden?
Wie? Sie sagen, das geht nicht?

Abb.: ComboBox mit mehrfarbigen Einträgen

Stimmt! Mit der Standard ComboBox lässt sich das auch nicht so ohne Weiteres machen!

Verwenden Sie aber anstelle der VB-ComboBox das ImageComboBox-Control aus den "Windows Common Controls 6.0" lässt sich das ohne viel Aufwand realisieren. Wie der Name schon sagt, lassen sich mit der ImageComboBox Texte und Bilder anzeigen. Was liegt also näher, die farbigen Texte einfach als Bilder zu erstellen und zu verwenden?

Für das nachfolgende Beispiel benötigen Sie:

• 1 x ImageCombo (als imgColorTextCombo)
• 1 x ImageList (als ImageList1)
• 1 x PictureBox (als picColorText)
• 1 x Label (als lblClickOutput)
• 1 x CommandButton (als cmdClose)

Die Anordnung der Controls spielt keine Rolle; das übernehmen wir in unserem Beispiel zur Laufzeit.

Fügen Sie der Form jetzt noch folgenden Code hinzu:

Option Explicit
 
Private Const cKey = "|"

Private Sub Form_Load()
  Dim i As Long, lDist As Long
 
  lDist = 240
 
  ' ComboBox positionieren  
  With imgColorTextCombo
    .Top = lDist
    .Left = lDist
    .Width = ScaleWidth - (2 * lDist)
    .ToolTipText = "<ESC> setzt die Auswahl zurück"
  End With
 
  ' Ausgabe-Label positionieren
  With lblClickOutput
    .Top = imgColorTextCombo.Top + imgColorTextCombo.Height + lDist
    .Left = lDist
    .Caption = ""
    .AutoSize = True
  End With
 
  ' Schließen-Schaltfläche positionieren  
  With cmdClose
    .Cancel = False
    .Caption = "Schließen"
    .Height = 2 * lDist
    .Width = TextWidth(.Caption) + (2 * lDist)
    .Top = ScaleHeight - lDist - .Height
    .Left = ScaleWidth - lDist - .Width
  End With
 
  ' initialisieren
  InitColorTextCombo
 
  ' ein paar Testeinträge in unterschiedlichen Farben
  ' 1. Eintrag
  i = AddColorText("Rot, ", vbRed)
  AddColorText " Blau, ", vbBlue, i
  AddColorText " Grün", vbGreen, i
 
  ' 2. Eintrag
  i = AddColorText("Schwarz, ", vbBlack)
  AddColorText " Lila, ", vbMagenta, i
  AddColorText " Gelb", vbYellow, i
 
  ' Combobox füllen
  FillColorTextCombo
End Sub

Private Sub InitColorTextCombo()
  On Error Resume Next
 
  With imgColorTextCombo
    ' Einträge löschen
    .ComboItems.Clear
 
    ' Combobox sperren
    .Locked = True
 
    ' PictureBox anpassen
    picColorText.Visible = False
    picColorText.BorderStyle = vbBSNone
    picColorText.Height = .Height - (8 * Screen.TwipsPerPixelY)
    picColorText.Width = .Width - (8 * Screen.TwipsPerPixelY)
  End With
 
  ' ImageList löschen
  ImageList1.ListImages.Clear
 
  ' Verhindert die Markierung innerhalb der Combobox
  'ImageList1.MaskColor = imgColorTextCombo.BackColor
End Sub

' Farbigen Text erstellen
Private Function AddColorText(ByVal sText As String, _
  Optional ByVal Color As OLE_COLOR = vbWindowText, _
  Optional ByVal Index As Long = 0) As Long
 
  Dim i As Long
  Dim s As String
 
  With picColorText
    ' PictureBox löschen
    .AutoRedraw = True
    .Picture = Nothing
    .Cls
    .BackColor = imgColorTextCombo.BackColor
 
    If Index > 0 Then
      ' neuen Text an bestehenden Eintrag anhängen
      s = ImageList1.ListImages(Index).Key
      s = Mid$(s, Len(cKey) + 1, Len(s))
      Set .Picture = ImageList1.ListImages(Index).Picture
 
      ' Textausgabe-Position festlegen
      .CurrentX = 2 * Screen.TwipsPerPixelX + (.TextWidth(s))
      .CurrentY = (.ScaleHeight - .TextHeight(sText)) \ 2
 
      ' Textfarbe
      .ForeColor = Color
 
      ' Text in PictureBox ausgeben
      picColorText.Print sText
 
      ' Wichtig!
      ' Der Picture-Eigenschaft muss das Bild aus "Image" zugewiesen werden
      .Picture = .Image
 
      ' bestehenden Eintrag löschen
      ImageList1.ListImages.Remove Index
 
      ' Neuen Eintrag (Bild) an ursprünglicher Position einfügen
      i = ImageList1.ListImages.Add(Index, cKey & s & sText, .Picture).Index
 
    Else
      ' neuen farbigen Text eintrag erstellen
      .CurrentX = 2 * Screen.TwipsPerPixelX
      .CurrentY = (.ScaleHeight - .TextHeight(sText)) \ 2
 
      ' Textfarbe festlegen
      .ForeColor = Color
 
      ' Text in PictureBox ausgeben
      picColorText.Print sText
 
      ' Wichtig!
      ' Der Picture-Eigenschaft muss das Bild aus "Image" zugewiesen werden
      .Picture = .Image
 
      ' Neuen Eintrag (Bild) der ImageList zuweisen
      i = ImageList1.ListImages.Add(, cKey & sText, .Picture).Index
    End If
    .AutoRedraw = False
  End With
 
  ' Index des aktuellen Bildes in der ImageList zurückgeben
  AddColorText = i
End Function

Private Sub FillColorTextCombo()
  Dim i As Long
 
  With imgColorTextCombo
    ' zunächst alle Einträge löschen
    .ComboItems.Clear
 
    ' jetzt die Abbildungsliste zuweisen
    .ImageList = ImageList1
 
    ' und zu guter Letzt die Einträge erstellen
    For i = 1 To ImageList1.ListImages.Count
      With ImageList1.ListImages(i)
        imgColorTextCombo.ComboItems.Add , .Key, "", i, i
      End With
    Next i
  End With
End Sub

Private Sub imgColorTextCombo_Click()
  ' Auswahl im Klartext anzeigen
  ' hierzu wird die Key-Eigenschaft ausgelesen
  On Error Resume Next
 
  Dim s As String
 
  s = imgColorTextCombo.SelectedItem.Key
  s = Mid$(s, Len(cKey) + 1, Len(s))
 
  lblClickOutput.Caption = IIf(Err.Number <> 0, "<nix ausgewählt>", s)
End Sub

Private Sub imgColorTextCombo_KeyPress(KeyAscii As Integer)
  ' Bei Tastendruck, Click-Event auslösen
  Call imgColorTextCombo_Click
End Sub

Private Sub cmdClose_Click()
  ' Beenden
  Unload Me
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Set Form1 = Nothing
End Sub