Option Explicit
 
Private Const cKey = "|"
 
Private Sub InitColorTextCombo()
  On Error Resume Next
 
  ' Combobox sperren
  imgColorTextCombo.ComboItems.Clear
  imgColorTextCombo.Locked = True
 
  ' PictureBox anpassen
  picColorText.Visible = False
  picColorText.BorderStyle = vbBSNone
  picColorText.Height = imgColorTextCombo.Height - (8 * Screen.TwipsPerPixelY)
  picColorText.Width = imgColorTextCombo.Width - (8 * Screen.TwipsPerPixelY)
 
  ' ImageList anpassen
  ImageList1.ListImages.Clear
  'ImageList1.MaskColor = imgColorTextCombo.BackColor 'Verhindert die _
    Markierung innerhalb der Combobox
End Sub
 
Private Sub cmdClose_Click()
  Unload Me
End Sub
 
Private Sub Form_Load()
  Dim i As Long, lDist As Long
 
  lDist = 240
 
  With imgColorTextCombo
    .Top = lDist
    .Left = lDist
    .Width = ScaleWidth - (2 * lDist)
    .ToolTipText = "<ESC> setzt die Auswahl zurück"
  End With
 
  With lblClickOutput
    .Top = imgColorTextCombo.Top + imgColorTextCombo.Height + lDist
    .Left = lDist
    .Caption = ""
    .AutoSize = True
  End With
 
  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
 
  i = AddColorText("Rot, ", vbRed)
    AddColorText " Blau, ", vbBlue, i
    AddColorText " Grün", vbGreen, i
 
  i = AddColorText("Schwarz, ", vbBlack)
    AddColorText " Lila, ", vbMagenta, i
    AddColorText " Gelb", vbYellow, i
 
  ' Combobox füllen
  FillColorTextCombo
End Sub
 
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, s As String
 
  With picColorText
    .AutoRedraw = True
    .Picture = Nothing
    .Cls
    .BackColor = imgColorTextCombo.BackColor
 
    If Index > 0 Then
      s = ImageList1.ListImages(Index).Key
      s = Mid(s, Len(cKey) + 1, Len(s))
      Set .Picture = ImageList1.ListImages(Index).Picture
 
      .CurrentX = 2 * Screen.TwipsPerPixelX + (.TextWidth(s))
      .CurrentY = (.ScaleHeight - .TextHeight(sText)) \ 2
      .ForeColor = Color
 
      picColorText.Print sText
 
      .Picture = .Image
 
      ImageList1.ListImages.Remove Index
      i = ImageList1.ListImages.Add(Index, cKey & s & sText, .Picture).Index
 
    Else
      s = ""
      .CurrentX = 2 * Screen.TwipsPerPixelX
      .CurrentY = (.ScaleHeight - .TextHeight(sText)) \ 2
      .ForeColor = Color
 
      picColorText.Print sText
 
      .Picture = .Image
 
      i = ImageList1.ListImages.Add(, cKey & sText, .Picture).Index
    End If
 
    .AutoRedraw = False
 
  End With
 
  AddColorText = i
 
End Function
 
Private Sub FillColorTextCombo()
  Dim i As Long
 
  ' zunächst alle Einträge löschen
  imgColorTextCombo.ComboItems.Clear
 
  ' jetzt die Abbildungsliste zuweisen
  imgColorTextCombo.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 Sub
 
Private Sub Form_Unload(Cancel As Integer)
  Set Form1 = Nothing
End Sub
 
Private Sub imgColorTextCombo_Click()
  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)
  Call imgColorTextCombo_Click
End Sub

Viel Spass,
R@lf