Alternate listview background color

[coolcurrent4u]

how do i alternate listview row color for comctrls v5 sp2?

[coolcurrent4u]

any help yet

[Cube8]

I don't know if it works for v5 but I've done it in v6 with subclassing.
Unfortunately, I'm at work right now. When I get home, I'll post the code, if you're interested.

[coolcurrent4u]

ok i'll be waiting for your answer....

[Cube8]

Here is the code I use.

Paste this in a module:

Private Const WM_NOTIFY As Long = 78
Private Const NM_CUSTOMDRAW As Long = -12
Public Const GWL_WNDPROC As Long = -4

Private Const CDDS_PREPAINT As Long = &H1
Private Const CDRF_NOTIFYITEMDRAW As Long = &H20
Private Const CDDS_ITEM As Long = &H10000
Private Const CDDS_ITEMPREPAINT As Long = CDDS_ITEM Or CDDS_PREPAINT
Private Const CDRF_NEWFONT As Long = &H2

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private 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

'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
Private Type NMLVCUSTOMDRAW
    nmcd As NMCUSTOMDRAW
    clrText As Long
    clrTextBk As Long
    iSubItem As Integer
End Type

Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (lpDest As Any, lpSource As Any, ByVal cBytes As Long)
Private Declare Function CallWindowProc Lib "user32" 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 Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long

Public procOld As Long


Public Function WindowProc(ByVal hWnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
If uMsg = WM_NOTIFY Then
    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
                    'Text color = dark blue
                    udtNMLVCUSTOMDRAW.clrText = RGB(0, 0, 128)
                    
                    'Set the alternating color (every 2 lines -Mod 2 condition-)
                    ' = teal blue
                    If Form1.ListView1.ListItems(.dwItemSpec + 1).Index Mod 2 = 0 Then udtNMLVCUSTOMDRAW.clrTextBk = RGB(64, 224, 224)
                    
                    CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW)
                    WindowProc = CDRF_NEWFONT
                    Exit Function
                End Select
            End With
        End If
    End With
End If

WindowProc = CallWindowProc(procOld, hWnd, uMsg, wParam, lParam)
End Function

The red numbers specify which lines will be highlighted. The first one defines the pattern (in this case: every 2 lines) and the second one defines which line will be the first to be highlighted.
Of course, the same rule can be applied to text color, with a slight modification to the code.


Add a form and a ListView control (Microsoft Windows Common Controls 6) with 2 columns, and then paste this into the form's code:

Private Sub Form_Load()
'Add some lines, to see the effect
ListView1.ListItems.Add Text:="abcd"
ListView1.ListItems(1).SubItems(1) = "1234"
ListView1.ListItems.Add Text:="efgh"
ListView1.ListItems(2).SubItems(1) = "5678"
ListView1.ListItems.Add Text:="ijkl"
ListView1.ListItems(3).SubItems(1) = "9012"
ListView1.ListItems.Add Text:="mnop"
ListView1.ListItems(4).SubItems(1) = "3456"
ListView1.ListItems.Add Text:="qrst"
ListView1.ListItems(5).SubItems(1) = "7890"

'Start subclassing
procOld = SetWindowLong(Me.hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub Form_Unload(Cancel As Integer)
'Stop subclassing
Call SetWindowLong(Me.hWnd, GWL_WNDPROC, procOld)
End Sub

I assume you know the risks of subclassing inside VB IDE...

I hope I helped.

[coolcurrent4u]

good work, but i found a solution using pictureboxes instead, but its noticably slow when looping through 12 cols and 5 rows!

i try as much as possible to avoid api excepty for making contriols. the reason is because it give so much error.

and as for subclassing inside the ide, i got an addin dll that just helps you do it withou vb crashing.

i'll post it later today

[Cube8]

You shouldn't avoid API, especially when it comes to speed. As you said, using pictureboxes is very slow.
The code I sent you is tested and working (otherwise I wouldn't post it ). The only things you can safely customize are the colors of text and row, and the row-color-pattern.
I've seen the picturebox-way but it is not reliable.