Tipp 0519 Farbige ListBox-Einträge
Autor/Einsender:
Datum:
  Gottfried Mehling
30.10.2006
Entwicklungsumgebung:   VB 6
Da eine VB-ListBox keine Möglichkeit bietet, den einzelnen Einträgen (Items) verschiedene Farben zu geben, muss man hierzu API-Funktionen zu Hilfe nehmen, wenn man diese Funktionalität nutzen möchte.
Um sicherstellen, dass die Schrift und die Farben auch immer an der richtigen Position neu gesetzt wird, wenn die Listbox neu gezeichnet wird, da die Listbox ja selbst nicht weiß, dass in ihr "rumgemalt" wird, und sie kein Paint-Event zur Verfügung stellt, muss man sich solch eine Routine per Subclassing (Hook) selbst erstellen.
Hierzu werden zwei Datenfelder (Arrays) benötigt, die die jeweiligen Farben (Schrift und Hintergrund) enthalten. Die Datenfelder sind so dimensioniert, dass der jeweilige Listindex auch der zugehörige Array-Index ist.
 
Private MlngLstColor()   As Long   '// Schriftfarbe der ListItems
Private MlngLstBKColor() As Long '// Hintergrundfarbe der ListItems
 
Die eigentliche Arbeit macht die Routine Listbox_Paint(), und wird von der Hook-Funktion bei der WM_PAINT-Message und an anderen Stellen (z.B. ListBox-Click-, ListBox-Scroll-Ereignisse usw.) aufgerufen, wenn ein Neuzeichnen erforderlich ist.
 
Public Sub Listbox_Paint()
  Dim fntMetrics As TEXTMETRIC
  Dim recPos As RECT
  Dim hdcLst As Long

  Dim lngItem As Long

  Dim hdlNewFont As Long
  Dim hdlOldFont As Long
  Dim hdlNewPen As Long
  Dim hdlOldPen As Long
  Dim hdlNewBrush As Long
  Dim hdlOldBrush As Long
  Dim lngBold As Long

  Dim lngColor As Long
  Dim lngBkColor As Long

  hdcLst = GetDC(Me.lstColor.hwnd)
  GetTextMetrics hdcLst, fntMetrics
  If Me.lstColor.Font.Bold Then
    lngBold = 700
  Else
    lngBold = 400
  End If

  With fntMetrics
    hdlNewFont = CreateFont(-MulDiv(Me.lstColor.Font.Size, _
          GetDeviceCaps(hdcLst, LOGPIXELSY), 72), 0, _
          0, 0, lngBold, .tmItalic, .tmUnderlined, .tmStruckOut, _
          .tmCharSet, 4, &H10, 2, .tmPitchAndFamily, _
          Me.lstColor.Font.Name)
  End With

  hdlOldFont = SelectObject(hdcLst, hdlNewFont)

  For lngItem = 0 To Me.lstColor.ListCount - 1
    If Not Me.lstColor.Selected(lngItem) Then
      SendMessage Me.lstColor.hwnd, LB_GETITEMRECT, lngItem, _
            VarPtr(recPos)

      lngColor = TranslateSystemColor(MlngLstColor(lngItem))
      lngBkColor = TranslateSystemColor(MlngLstBKColor(lngItem))

      If Me.chkBkColor.Value = 1 Then
        hdlNewPen = CreatePen(PS_SOLID, 1, lngBkColor)
        hdlOldPen = SelectObject(hdcLst, hdlNewPen)
        hdlNewBrush = CreateSolidBrush(lngBkColor)
        hdlOldBrush = SelectObject(hdcLst, hdlNewBrush)
        Rectangle hdcLst, recPos.Left, recPos.Top, recPos.Right, _
              recPos.Bottom

        SelectObject hdcLst, hdlOldBrush
        SelectObject hdcLst, hdlOldPen
        DeleteObject hdlNewPen
        DeleteObject hdlNewBrush
      End If

      SetBkColor hdcLst, lngBkColor
      SetTextColor hdcLst, lngColor

      TextOut hdcLst, 2 + recPos.Left, recPos.Top, _
            Me.lstColor.List(lngItem) & " ", _
            Len(Me.lstColor.List(lngItem)) + 1
    End If
  Next lngItem

  SelectObject hdcLst, hdlOldFont
  DeleteObject hdlNewFont
  ReleaseDC Me.lstColor.hwnd, hdcLst
End Sub
 
Durch entsprechende eigene Änderungen ist es außerdem möglich
tabulatorgetrennten Text in die Items schreiben
  Dazu muss nur die API-Funktion TextOut durch die API-Funktion TabbedTextOut (der man die Tabs mitgibt) ersetzt werden.
den gewählten Eintrag nicht markieren bzw. anders markieren
  Soll das gewählte Item nicht markiert werden, ist lediglich in der Schleife die Abfrage auf
 
 If Not Me.lstColor.Selected(lngItem) Then
 
  weg zu lassen.
  Eine andere Markierung ist nach dem Weglassen der eigentlichen Markierung z.B. mit der API-Funktion DrawFocusRect möglich. Dazu ist es sinnvoll, immer die ganze Zeile zu zeichnen.
verschiedenen Schriftarten bei den verschiedenen Einträgen
  Da sowieso die Schriftart zum Schreiben gesetzt wird, kann an dieser Stelle jede beliebige andere Schriftart verwendet werden, und wenn das Setzen der Schriftart in der Item-Schleife erfolgt, sogar für jedes Item extra. Bei verschiedenen großen Schriftarten muss dann natürlich auch entsprechend die Höhe der einzelnen Items mit der Message LB_SETITEMHEIGHT gesetzt werden. (Dadurch wird vermutlich die WM_PAINT-Message der Listbox ausgelöst, daher diese dann nicht verarbeiten (Static-Flag)).
Weitere Links zum Thema
Farbige Listbox (TreeView-Steuerelement)

Windows-Version
95
98
ME
NT
2000
XP
Vista
Win 7
VB-Version
VBA 5
VBA 6
VB 4/16
VB 4/32
VB 5
VB 6


Download  (8 kB) Downloads bisher: [ 1068 ]

Vorheriger Tipp Zum Seitenanfang Nächster Tipp

Startseite | Projekte | Tutorials | API-Referenz | VB-/VBA-Tipps | Komponenten | Bücherecke | VB/VBA-Forum | VB.Net-Forum | DirectX-Forum | Foren-Archiv | DirectX | VB.Net-Tipps | Chat | Spielplatz | Links | Suchen | Stichwortverzeichnis | Feedback | Impressum

Seite empfehlen Bug-Report
Letzte Aktualisierung: Sonntag, 15. Mai 2011