When using the ListView as a report and setting the GridLines property to True, Is it possible to color an specific cell of it?
Printable View
When using the ListView as a report and setting the GridLines property to True, Is it possible to color an specific cell of it?
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
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?
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.