Shading rows of Listview

[bitwise]

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

[HeSaidJoe]

comliments of Aaron Young

' 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

[bitwise]

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

[techman2553]

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!!

[bitwise]

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?