ListView Colors...

[_Yoyo]

When using the ListView as a report and setting the GridLines property to True, Is it possible to color an specific cell of it?

[HeSaidJoe]

' 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

[_Yoyo]

You said i can't use the stop button 'cause Windows would crash but, after compiling it will work fine right? and does it color the whole row?

[Abashai]

I know this works, but I can't get it to work. It doesn't give me an error, but the color does not change.