Is there a way to make the data displayed in a ListView control to display alternate background colors so as to imulate greenbar papaer, ie every other row green?
Rev. Michael L. Burns
Printable View
Is there a way to make the data displayed in a ListView control to display alternate background colors so as to imulate greenbar papaer, ie every other row green?
Rev. Michael L. Burns
See this topic
'have not tested this got it from another site I searched.
'if it works please drop me an email to let me know...then
'I won't waste time testing it..just add it to my sometime
'in the future code pile.
Code:'---Bas module code---
Option Explicit
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 Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes&)
Public Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hwnd&, ByVal Msg&, ByVal wParam&, ByVal lParam&)
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
' udtNMLVCUSTOMDRAW.clrText = vbRed
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
'---Form code---
' Add ListView (lvCustomDraw) with
'Report style, TextBox and Command Button
' Start App. Print ListItem Number at etxtbox end press command button
Option Explicit
Private Const GWL_WNDPROC As Long = (-4&)
Private Declare Function SetWindowLong& Lib "user32" Alias "SetWindowLongA" (ByVal hwnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Sub Command1_Click()
SetLIBackColor lvCustomDraw, Val(Text1), vbYellow
End Sub
Private Sub Form_Load()
lvCustomDraw.FullRowSelect = True
With lvCustomDraw
.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(lvCustomDraw.ListItems.Count)
g_MaxItems = lvCustomDraw.ListItems.Count - 1
g_addProcOld = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub
Private Sub Form_Unload(Cancel As Integer)
Call SetWindowLong(hwnd, GWL_WNDPROC, g_addProcOld)
End Sub
for some reason these smilies jump in the code so if you see a smilie it needs to be replace with whatever code puts the dumb thing on the page.
Works... I made a few changes but I'm not sure what..I think
some of it was to put the code in (where the smilies took it out and maybe one new set of constants.
Code:' bas module code
' hook system and color the backcolor of 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