Shading rows of Listview

Is there anyway to shade the row of a listview with a different colors? I have a listview I'd like to fill with employees...Each can have one of 3 different types of status. I'd like to color code the status. so when I load the listview depending on what status they have the row would have a specific background color to the status.

Thanks
Keith

comliments of Aaron Young

Code:

---

' bas module code
' Hook system and color the backcolor of listview rows different colors
' as with hooking if you unload using the stop button of Visual Basic
' and you don't use the unloadquerry (the X on the form)
' then windows will crash
'
Option Explicit

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 ' Window handle of control sending message
idFrom As Long ' Identifier of control sending message
code As Long ' Specifies the notification code
End Type

' sub struct of the NMCUSTOMDRAW struct
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' generic customdraw struct
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 specific customdraw struct
Public Type NMLVCUSTOMDRAW
nmcd As NMCUSTOMDRAW
clrText As Long
clrTextBk As Long
' if IE >= 4.0 this member of the struct can be used
'iSubItem As Integer
End Type

Public g_addProcOld As Long
Public g_MaxItems As Long
Public clr() As Long


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

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 clr(.dwItemSpec) <> 0 Then
'change the color of the text display if wanted
'udtNMLVCUSTOMDRAW.clrText = vbBlue
udtNMLVCUSTOMDRAW.clrTextBk = clr(.dwItemSpec)
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

Public Sub SetLIBackColor(lv As ListView, nitem As Integer, BkColor As Long)
clr(nitem - 1) = BkColor
lv.Refresh
End Sub

Public Sub SetLIForeColor(lv As ListView, ForeColor As Long)
clr(nitem - 1) = ForeColor
lv.Refresh
End Sub

'<<<<<<<<<<<<<<<<<<<<<<<<<< >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
'
'Form Code.

Option Explicit

Private Sub Form_Load()

ListView1.FullRowSelect = True
ListView1.View = lvwReport

With ListView1
.ColumnHeaders.Add , , "Item Column"
.ColumnHeaders.Add , , "Subitem 1"
.ColumnHeaders.Add , , "Subitem 2"
Dim i&
For i = 1 To 30
With .ListItems.Add(, , "Item " & CStr(i))
.SubItems(1) = "Subitem 1"
.SubItems(2) = "Subitem 2"
End With
Next
End With

' Don't forget to redim array if you add/remove listview items
ReDim Preserve clr(ListView1.ListItems.Count)
g_MaxItems = ListView1.ListItems.Count - 1
g_addProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)


End Sub

Private Sub Command1_Click()
'set the rows to different colors
SetLIBackColor ListView1, 1, vbYellow
SetLIBackColor ListView1, 2, vbRed
SetLIBackColor ListView1, 3, vbMagenta
End Sub

Private Sub Form_Unload(Cancel As Integer)

Call SetWindowLong(hWnd, GWL_WNDPROC, g_addProcOld)
End Sub

---

I'm sure it will work...thanks for your time

Hey HeSaidJoe,

That's really slick !!! Where did you learn how to use API's in creative ways like that ??? Is there a book that shows you how to do some of the not-so-obvious things with Windows using APIs ??? I have only used a few API calls, but I'd love to learn more!!

I really would like to to the color part as I'm loading the list...I'll see if I can get it to do that...but it might be faster if I just reloop through the list after...so I don't have to redim after every add...as it seems I have to. right?