Einzelne Zeilen im ListView färben (Hintergrund und Schrift) Das Einfärben einzelner ListView Zeilen ist beim ListView von Haus aus leider nicht gestattet. Hier ein Tipp, wie man es mit Subclassing doch hinbekommen kann.
Autor:   VBMichi	Bewertung:     [ Jetzt bewerten ]	Views:  21.250
www.michael-kaupp.com	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

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

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Das Einfärben einzelner ListView Zeilen ist beim ListView von Haus aus leider nicht gestattet. Hier ein Tipp, wie man es mit Subclassing doch hinbekommen kann.

ACHTUNG: Das Subclassing muss beim Unload unbedingt wieder deaktiviert werden, sonst stürzt VB ab. Beim Testen bitte NICHT den Stop-Button der VB-Entwicklungsumgebung verwenden.

Folgenden Code in ein Modul kopieren:

Option Explicit
 
' Benötigte API Deklarationen
Public Declare Function SetWindowLong Lib "user32.dll" _
  Alias "SetWindowLongA" ( _
  ByVal hWnd As Long, _
  ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
 
Public Declare Sub CopyMemory Lib "kernel32.dll" _
  Alias "RtlMoveMemory" ( _
  Destination As Any, _
  Source As Any, _
  ByVal Length As Long)
 
Public Declare Function CallWindowProc Lib "user32.dll" _
  Alias "CallWindowProcA" ( _
  ByVal lpPrevWndFunc As Long, _
  ByVal hWnd As Long, _
  ByVal Msg As Long, _
  ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
' Benötigte öffentliche Konstante
Public Const GWL_EXSTYLE = -20
Public Const GWL_HINSTANCE = -6
Public Const GWL_HWNDPARENT = -8
Public Const GWL_ID = -12
Public Const GWL_STYLE = -16
Public Const GWL_USERDATA = -21
Public Const GWL_WNDPROC = -4
Public Const DWL_DLGPROC = 4
Public Const DWL_MSGRESULT = 0
Public Const DWL_USER = 8
 
Public Const NM_CUSTOMDRAW = (-12&)
Public Const WM_NOTIFY As Long = &H4E&
Public Const CDDS_PREPAINT As Long = &H1&
Public Const CDRF_NOTIFYITEMDRAW As Long = &H20&
Public Const CDDS_ITEM As Long = &H10000
Public Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
Public Const CDRF_NEWFONT As Long = &H2&
 
Public Type NMHDR
  hWndFrom As Long   ' Fenster Handle des sendenden Controls
  idFrom As Long     ' ID des sendenden Controls
  code  As Long      ' Code
End Type
 
' Substruktur der NMCUSTOMDRAW Struktur
Public Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
 
' generische CustomDraw Struktur
Public Type NMCUSTOMDRAW
  hdr As NMHDR
  dwDrawStage As Long
  hDC As Long
  rc As RECT
  dwItemSpec As Long
  uItemState As Long
  lItemlParam As Long
End Type
 
' ListView spezifische CustomDraw Struktur
Public Type NMLVCUSTOMDRAW
  nmcd As NMCUSTOMDRAW
  clrtext As Long
  clrtextbk As Long
  ' Falls der IE >= 4.0, kann dieses Mitglied der Struktur auch verwendet werden:
  'iSubItem As Integer
End Type
 
' Öffentliche Variablen
Public g_addProcOld As Long
Public g_MaxItems As Long
Public clrtextbk() As Long
Public clrtext() As Long

' Öffentliche Funktion zum "ReDrawen" des ListViews
Public Function WindowProc(ByVal hWnd As Long, _
  ByVal iMsg As Long, ByVal wParam As Long, _
  ByVal lParam As Long) As Long
 
  Select Case iMsg
    Case WM_NOTIFY
      Dim udtNMHDR As NMHDR
      CopyMemory udtNMHDR, ByVal lParam, 12&
 
      With udtNMHDR
        If .code = NM_CUSTOMDRAW Then
          Dim udtNMLVCUSTOMDRAW As NMLVCUSTOMDRAW
          CopyMemory udtNMLVCUSTOMDRAW, ByVal lParam, Len(udtNMLVCUSTOMDRAW)
 
          With udtNMLVCUSTOMDRAW.nmcd
 
            Select Case .dwDrawStage
              Case CDDS_PREPAINT
                WindowProc = CDRF_NOTIFYITEMDRAW
                Exit Function
 
              Case CDDS_ITEMPREPAINT
                If clrtext(.dwItemSpec) <> 0 Or clrtextbk(.dwItemSpec) <> 0 Then
                  ' Farbe des Textes, des Eintrages,
                  ' wird mit der nächsten Zeile bestimmt:
                  If clrtext(.dwItemSpec) <> 0 Then
                    udtNMLVCUSTOMDRAW.clrtext = clrtext(.dwItemSpec)
                  End If
                  If clrtextbk(.dwItemSpec) <> 0 Then
                    udtNMLVCUSTOMDRAW.clrtextbk = clrtextbk(.dwItemSpec)
                  End If
                  CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW)
                End If
                WindowProc = CDRF_NEWFONT
                Exit Function
            End Select
 
          End With
        End If
      End With
 
  End Select
 
  WindowProc = CallWindowProc(g_addProcOld, hWnd, iMsg, wParam, lParam)
End Function

' Öffentliche Funktion, um die Hintergrundfarbe eines ListView Eintrages zu ändern
Public Sub SetLIBackColor(lv As ListView, nitem As Integer, BkColor As Long)
  clrtextbk(nitem - 1) = BkColor
  lv.Refresh
End Sub

' Öffentliche Funktion, um die Schriftfarbe eines ListView Eintrages zu ändern
Public Sub SetLIForeColor(lv As ListView, nitem As Integer, ForeColor As Long)
  clrtext(nitem - 1) = ForeColor
  lv.Refresh
End Sub

Jetzt auf die Form folgende Controls platzieren:

• ListView1 (ListView)
• Command1 (CommandButton)

Folgenden Code in den Code-Teil der Form einfügen:

Option Explicit
 
Private Sub Form_Load()
  With ListView1
    ' ListView Darstellung
    .View = lvwReport
    .FullRowSelect = True
    .GridLines = True
    .Width = 5600
    .Height = 2300
 
    ' ListView-Spalten hinzufügen
    .ColumnHeaders.Add 1, , "ID"
    .ColumnHeaders.Add 2, , "Vorname"
    .ColumnHeaders.Add 3, , "Nachname"
 
    ' Spalten-Breiten festlegen
    .ColumnHeaders(1).Width = 1500
    .ColumnHeaders(2).Width = 2000
    .ColumnHeaders(3).Width = 2000
 
    ' Vier Einträge hinzufügen
    .ListItems.Add 1, , "1"
    .ListItems(1).SubItems(1) = "Martin"
    .ListItems(1).SubItems(2) = "Mustermann"
    .ListItems.Add 2, , "2"
    .ListItems(2).SubItems(1) = "Max"
    .ListItems(2).SubItems(2) = "Mustermann"
    .ListItems.Add 3, , "3"
    .ListItems(3).SubItems(1) = "Michael"
    .ListItems(3).SubItems(2) = "Mustermann"
    .ListItems.Add 4, , "4"
    .ListItems(4).SubItems(1) = "Marco"
    .ListItems(4).SubItems(2) = "Mustermann"
  End With
 
  Command1.Caption = "Färbe Zeile 3 rot ein, " & _
    "und ändere ihre Schriftfarbe in gelb!"
 
  ' Subclassing aktivieren
  ReDim Preserve clrtext(ListView1.ListItems.Count)
  ReDim Preserve clrtextbk(ListView1.ListItems.Count)
  g_MaxItems = ListView1.ListItems.Count - 1
  g_addProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub Command1_Click()
  ' ListView einfärben (Funktionsaufruf im Modul)
  SetLIBackColor ListView1, 3, vbRed
  SetLIForeColor ListView1, 3, vbYellow
End Sub

' --------------------------------------------------------------
' !!!!WICHTIG!!!!
' --------------------------------------------------------------
' Das Programm muss unbedingt über die Unload-Funktion
' beendet werden, sonst stürzt Visual Basic ab!
'
' Zum Beenden des Programmes NICHT den VB-Stoppknopf
' verwenden, sondern das Programm über das rote X schließen !!!
' --------------------------------------------------------------
Private Sub Form_Unload(Cancel As Integer)
  ' Subclassing deaktivieren
  SetWindowLong hWnd, GWL_WNDPROC, g_addProcOld
End Sub