Private Sub Form_Load()
  ' WindowProc umleiten
  lCCHwnd = Me.ListView1.hwnd
  lWindowProcOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
 
Private Sub Form_Unload(Cancel As Integer)
  ' Sublassing umleitung beenden
  Call SetWindowLong(Me.hwnd, GWL_WNDPROC, lWindowProcOld)
End Sub

' modLSV_Color.bas
Option Explicit
 
  ' WM_NOTIFY
  Public Enum WinNotifications
    NM_FIRST = (-0&)
    NM_LAST = (-99&)
    NM_OUTOFMEMORY = (NM_FIRST - 1&)
    NM_CLICK = (NM_FIRST - 2&)
    NM_DBLCLK = (NM_FIRST - 3&)
    NM_RETURN = (NM_FIRST - 4&)
    NM_RCLICK = (NM_FIRST - 5&)
    NM_RDBLCLK = (NM_FIRST - 6&)
    NM_SETFOCUS = (NM_FIRST - 7&)
    NM_KILLFOCUS = (NM_FIRST - 8&)
    NM_CUSTOMDRAW = (NM_FIRST - 12&)
    NM_HOVER = (NM_FIRST - 13&)
  End Enum
 
  Public Const WM_NOTIFY As Long = &H4E&
 
  ' CustomDraw Konstanten
  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
 
  ' Notification Message Struktur
  ' Ist lParam einer WM_NOTIFY Message.
  Public Type NMHDR
    hWndFrom    As Long   ' Window handle of control sending message
    idFrom      As Long   ' Identifier of control sending message
    code        As Long   ' Specifies the notification code
  End Type
 
  ' rectangle siehe MSDN
  Public Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
  End Type
 
  ' NM_CUSTOMDRAW notification message
  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
 
  ' NM_CUSTOMDRAW von einem ListView
  Public Type NMLVCUSTOMDRAW
    nmcd        As NMCUSTOMDRAW
    clrText     As Long
    clrTextBk   As Long
    iSubItem    As Integer ' NUR IE >= 4.0
  End Type
 
  ' API Funktionen
  Public Declare Function CallWindowProc Lib "user32" _
    Alias "CallWindowProcA" _
    (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, _
    ByVal Msg As Long, ByVal wParam As Long, _
    ByVal lParam As Long) As Long
  Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
    (lpDest As Any, lpSource As Any, ByVal cBytes&)
 
  ' Pointer zum Original Message Handler des Forms
  Public lWindowProcOld     As Long
  ' Das Handle des CommonControl welches eigefärbt werden soll
  Public lCCHwnd            As Long
 
 
Public Function WindowProc(ByVal hwnd As Long, ByVal iMsg As Long, _
                           ByVal wParam As Long, ByVal lParam As Long) As Long
 
  Dim oNMHDR              As NMHDR          ' Die WM_NOTIFY message
  Dim oNMLVCUSTOMDRAW     As NMLVCUSTOMDRAW ' CustomDraw eines ListViews
 
  Select Case iMsg
    ' Uns interessieren nur WM_NOTIFY messages
    Case WM_NOTIFY
      ' Ah da is ja schon eine
 
      ' lParam in eine WM_NOTIFY Struktur kopieren
      CopyMemory oNMHDR, ByVal lParam, 12&
 
      If oNMHDR.hWndFrom = lCCHwnd Then
        ' Kommt die Message auch vom richtigen Control?
        If oNMHDR.code = NM_CUSTOMDRAW Then
          ' Ahh ein CommonControl zeichnet da etwas
          CopyMemory oNMLVCUSTOMDRAW, ByVal lParam, Len(oNMLVCUSTOMDRAW)
 
          With oNMLVCUSTOMDRAW.nmcd
            Select Case .dwDrawStage      ' Wo wird gerade gezeichnet
              Case CDDS_PREPAINT
                ' PrePaint des ListViews ignorieren
                ' Windows mitteilen das alle Items einzeln gezeichnet werden 
                ' sollen
                WindowProc = CDRF_NOTIFYITEMDRAW
                ' Funktion verlassen und Message dem Form "unterschlagen"
                Exit Function
 
              Case CDDS_ITEMPREPAINT
                ' Hier wird ein ListItem vorgezeichnet
                ' .dwItemSpec = ListItem Index
                If (.dwItemSpec Mod 2) = 0 Then
                  ' Bei jedem 2ten Listeneintrag die Farbe ändern
                  oNMLVCUSTOMDRAW.clrText = RGB(255, 0, 0)        ' Textfarbe
                  oNMLVCUSTOMDRAW.clrTextBk = RGB(100, 100, 100)  ' 
                  ' Hintergrundfarbe
 
                  ' Nun die CustomDraw Struktur wieder nach lParam kopieren
                  CopyMemory ByVal lParam, oNMLVCUSTOMDRAW, Len(oNMLVCUSTOMDRAW)
 
                  WindowProc = CDRF_NOTIFYITEMDRAW
                  Exit Function
                End If
            End Select
          End With
        End If ' .code = NM_CUSTOMDRAW
      End If ' oNMHDR.hWndFrom = lCCHwnd
  End Select ' iMsg
 
  ' Die Message an VB weitergeben
  WindowProc = CallWindowProc(lWindowProcOld, hwnd, iMsg, wParam, lParam)
 
End Function