Listview and colored line
 

Hi,

I would like to color 1 line over 2 in my listview.
till now i've just found how to color font of its items, but not row by
itself.

is it possible to color rows of a Listview component ?
if yes, how ?
thx,

Maileen

Listview and colored line
 

You can't format the individual items in the list.

--
Cordially,
Chip Pearson
Microsoft MVP - Excel
Pearson Software Consulting, LLC
www.cpearson.com


"Maileen" wrote in message
...
Hi,

I would like to color 1 line over 2 in my listview.
till now i've just found how to color font of its items, but
not row by itself.

is it possible to color rows of a Listview component ?
if yes, how ?
thx,

Maileen

Listview and colored line
 

If you want to colour all of the listitems, do a search for: Const
LVM_SETTEXTBKCOLOR

I dont know of a way to colour individual rows

--
Rob van Gelder - http://www.vangelder.co.nz/excel


"Maileen" wrote in message
...
Hi,

I would like to color 1 line over 2 in my listview.
till now i've just found how to color font of its items, but not row by
itself.

is it possible to color rows of a Listview component ?
if yes, how ?
thx,

Maileen

Listview and colored line
 

Hi Maileen;
You can try this for demo.
Place a listview on an userform and:
In UserForm module:

Option Explicit
Private Declare Function SetWindowLong& Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long _
, ByVal wCmd As Long) As Long
Private Const GWL_WNDPROC As Long = (-4&)
Private hWnd As Long

Private Sub UserForm_Initialize()
Dim i&
hWnd = GetWindow(FindWindow(vbNullString, Me.Caption), 5)
With Me.ListView1
..ColumnHeaders.Add , , "Item Column", .Width * 1 / 3
..ColumnHeaders.Add , , "Subitem 1", .Width * 1 / 3
..ColumnHeaders.Add , , "Subitem 2", .Width * 1 / 3
For i = 0 To 99
With .ListItems.Add(, , "Item " & Format(i, "00"))
..SubItems(1) = "Subitem 1"
..SubItems(2) = "Subitem 2"
End With
Next
End With
OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call SetWindowLong(hWnd, GWL_WNDPROC, OldProc)
End Sub

In standard module:
Option Explicit
' Constants used for customdraw routine
Private Const NM_CUSTOMDRAW = (-12&)
Private Const WM_NOTIFY As Long = &H4E&
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&

' The NMHDR structure contains information about a notification message.
' The pointer to this structure is specified as the lParam member of a
WM_NOTIFY message.
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

' Struct of the NMCUSTOMDRAW struct
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' Generic customdraw struct
Private 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
NMCW As NMCUSTOMDRAW
ForeColorText As Long
BackColorText As Long
' if IE = 4.0 this member of the struct can be used
'iSubItem As Integer
End Type

' Function used to manipulate memory data
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(lpDest As Any, lpSource As Any, ByVal cBytes&)
' Function used to call the next window proc in the "chain" for the
subclassed window
Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal
lParam&)
' This var will hold a pointer to the original message handler so we MUST
' save it so that it can be restored before we exit the app. if we don't
' restore it.... CRASH!!!!
Public OldProc As Long

' WARNING -----------------------------------------------
' Do not try to step through this function in debug mode !
' You will crash also, do no set any break points in this function !
' You will crash subclassing is non-trivial and should be handled with
' extreame care !
' There are ways to use a "Debug" dll to allow you to set breakpoints in
' subclassed code in the IDE but this was not implimented for this demo.
' WARNING -----------------------------------------------

' This is implementation of the message handling routine
' determine which message was recieved
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
' If it's a WM_NOTIFY message copy the data from the
' address pointed to by lParam into a NMHDR struct
Dim UDT_NMHDR As NMHDR
CopyMemory UDT_NMHDR, ByVal lParam, 12&
With UDT_NMHDR
If .code = NM_CUSTOMDRAW Then
' If the code member of the struct is NM_CUSTOMDRAW, copy
' the data pointed to by lParam into a NMLVCUSTOMDRAW struct
Dim UDT_NMLVCUSTOMDRAW As NMLVCUSTOMDRAW
' This is now OUR copy of the struct
CopyMemory UDT_NMLVCUSTOMDRAW, ByVal lParam, Len(UDT_NMLVCUSTOMDRAW)
With UDT_NMLVCUSTOMDRAW.NMCW
' Determine whether or not this is one of the messages we are interested in
Select Case .dwDrawStage
' If it's a prepaint message, tell windows WE want first dibs on
' painting for each item and then exit without letting VB get this message
Case CDDS_PREPAINT
WindowProc = CDRF_NOTIFYITEMDRAW
Exit Function
Case CDDS_ITEMPREPAINT
' Set the forecolor for items in the listview.
' Set the backcolor for items in the listview.
If (.dwItemSpec Mod 2) = 0 Then
UDT_NMLVCUSTOMDRAW.ForeColorText = vbRed
UDT_NMLVCUSTOMDRAW.BackColorText = &HC0C0C0
' Copy our copy of the struct back to the memory address pointed to by
lParam
CopyMemory ByVal lParam, UDT_NMLVCUSTOMDRAW, Len(UDT_NMLVCUSTOMDRAW)
End If
' Tell windows that we changed the font and do not allow VB to get this
message
WindowProc = CDRF_NEWFONT
Exit Function
End Select
End With
End If
End With
End Select
' Pass all messages on to VB and then return the value to windows
WindowProc = CallWindowProc(OldProc, hWnd, iMsg, wParam, lParam)
End Function

Sub CustomListView()
UserForm1.Show
End Sub

Regards,
MP

"Maileen" a écrit dans le message de
...
Hi,

I would like to color 1 line over 2 in my listview.
till now i've just found how to color font of its items, but not row by
itself.

is it possible to color rows of a Listview component ?
if yes, how ?
thx,

Maileen

Listview and colored line
 

Michel,

Hooking the WinProc event handler... Now that's impressive.


--
Rob van Gelder - http://www.vangelder.co.nz/excel


"Michel Pierron" wrote in message
...
Hi Maileen;
You can try this for demo.
Place a listview on an userform and:
In UserForm module:

Option Explicit
Private Declare Function SetWindowLong& Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long _
, ByVal wCmd As Long) As Long
Private Const GWL_WNDPROC As Long = (-4&)
Private hWnd As Long

Private Sub UserForm_Initialize()
Dim i&
hWnd = GetWindow(FindWindow(vbNullString, Me.Caption), 5)
With Me.ListView1
.ColumnHeaders.Add , , "Item Column", .Width * 1 / 3
.ColumnHeaders.Add , , "Subitem 1", .Width * 1 / 3
.ColumnHeaders.Add , , "Subitem 2", .Width * 1 / 3
For i = 0 To 99
With .ListItems.Add(, , "Item " & Format(i, "00"))
.SubItems(1) = "Subitem 1"
.SubItems(2) = "Subitem 2"
End With
Next
End With
OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
Call SetWindowLong(hWnd, GWL_WNDPROC, OldProc)
End Sub

In standard module:
Option Explicit
' Constants used for customdraw routine
Private Const NM_CUSTOMDRAW = (-12&)
Private Const WM_NOTIFY As Long = &H4E&
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&

' The NMHDR structure contains information about a notification message.
' The pointer to this structure is specified as the lParam member of a
WM_NOTIFY message.
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

' Struct of the NMCUSTOMDRAW struct
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' Generic customdraw struct
Private 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
NMCW As NMCUSTOMDRAW
ForeColorText As Long
BackColorText As Long
' if IE = 4.0 this member of the struct can be used
'iSubItem As Integer
End Type

' Function used to manipulate memory data
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(lpDest As Any, lpSource As Any, ByVal cBytes&)
' Function used to call the next window proc in the "chain" for the
subclassed window
Declare Function CallWindowProc& Lib "user32" Alias "CallWindowProcA" _
(ByVal lpPrevWndFunc&, ByVal hWnd&, ByVal Msg&, ByVal wParam&, ByVal
lParam&)
' This var will hold a pointer to the original message handler so we MUST
' save it so that it can be restored before we exit the app. if we don't
' restore it.... CRASH!!!!
Public OldProc As Long

' WARNING -----------------------------------------------
' Do not try to step through this function in debug mode !
' You will crash also, do no set any break points in this function !
' You will crash subclassing is non-trivial and should be handled with
' extreame care !
' There are ways to use a "Debug" dll to allow you to set breakpoints in
' subclassed code in the IDE but this was not implimented for this demo.
' WARNING -----------------------------------------------

' This is implementation of the message handling routine
' determine which message was recieved
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
' If it's a WM_NOTIFY message copy the data from the
' address pointed to by lParam into a NMHDR struct
Dim UDT_NMHDR As NMHDR
CopyMemory UDT_NMHDR, ByVal lParam, 12&
With UDT_NMHDR
If .code = NM_CUSTOMDRAW Then
' If the code member of the struct is NM_CUSTOMDRAW, copy
' the data pointed to by lParam into a NMLVCUSTOMDRAW struct
Dim UDT_NMLVCUSTOMDRAW As NMLVCUSTOMDRAW
' This is now OUR copy of the struct
CopyMemory UDT_NMLVCUSTOMDRAW, ByVal lParam, Len(UDT_NMLVCUSTOMDRAW)
With UDT_NMLVCUSTOMDRAW.NMCW
' Determine whether or not this is one of the messages we are interested
in
Select Case .dwDrawStage
' If it's a prepaint message, tell windows WE want first dibs on
' painting for each item and then exit without letting VB get this message
Case CDDS_PREPAINT
WindowProc = CDRF_NOTIFYITEMDRAW
Exit Function
Case CDDS_ITEMPREPAINT
' Set the forecolor for items in the listview.
' Set the backcolor for items in the listview.
If (.dwItemSpec Mod 2) = 0 Then
UDT_NMLVCUSTOMDRAW.ForeColorText = vbRed
UDT_NMLVCUSTOMDRAW.BackColorText = &HC0C0C0
' Copy our copy of the struct back to the memory address pointed to by
lParam
CopyMemory ByVal lParam, UDT_NMLVCUSTOMDRAW, Len(UDT_NMLVCUSTOMDRAW)
End If
' Tell windows that we changed the font and do not allow VB to get this
message
WindowProc = CDRF_NEWFONT
Exit Function
End Select
End With
End If
End With
End Select
' Pass all messages on to VB and then return the value to windows
WindowProc = CallWindowProc(OldProc, hWnd, iMsg, wParam, lParam)
End Function

Sub CustomListView()
UserForm1.Show
End Sub

Regards,
MP

"Maileen" a écrit dans le message de
...
Hi,

I would like to color 1 line over 2 in my listview.
till now i've just found how to color font of its items, but not row by
itself.

is it possible to color rows of a Listview component ?
if yes, how ?
thx,

Maileen

Listview and colored line
 

Hi Rob,

Hooking the WinProc event handler... Now that's impressive.

... and *very* dangerous in an interpreted environment! Save regularly!

Regards

Stephen Bullen
Microsoft MVP - Excel
www.oaltd.co.uk

Listview and colored line
 

Stephen Bullen wrote:
Hooking the WinProc event handler... Now that's impressive.

.. and *very* dangerous in an interpreted environment! Save regularly!

Regards

Stephen Bullen

I think it looks impressive too, but for me crashes every time! Despite
fully heeding all safety warnings. VBE closed (no breaks), running from
Alt-F8, xl2k/w98se.

Regards,
Peter T

Listview and colored line
 

It worked for me just fine - XL2003

Some of the line wrapping on that post screwed me up.
There was one that I missed were the line contained the word Message. It was
accepted without error by VBA, but was in fact a comment from the previous
line.

--
Rob van Gelder - http://www.vangelder.co.nz/excel


"Peter T" <peter_t@discussions wrote in message
...
Stephen Bullen wrote:
Hooking the WinProc event handler... Now that's impressive.

.. and *very* dangerous in an interpreted environment! Save regularly!

Regards

Stephen Bullen

I think it looks impressive too, but for me crashes every time! Despite
fully heeding all safety warnings. VBE closed (no breaks), running from
Alt-F8, xl2k/w98se.

Regards,
Peter T

Listview and colored line
 

Rob van Gelder wrote:
It worked for me just fine - XL2003

Some of the line wrapping on that post screwed me up.
There was one that I missed were the line contained the word Message. It
was
accepted without error by VBA, but was in fact a comment from the previous
line.

Hi Rob,

I'm very pleased you made me have another look. I thought I had carefully
"un line wrapped". I caught the line ending in "Message" which as you say
did not glow red. But there was another one I missed - lParam at the end of
the commented line starting "Copy our copy". After removing the stray
"lParam" all works fine.

Michel - please accept my apologies for casting aspersions on your amazing
code!!

I hope you will not mind if I take the liberty of reposting your code,
exactly as original but (hopefully) without any line wrapping.

Regards,
Peter T

Michel Pierron's code:

In UserForm module:
'''start code Userform
Option Explicit
Private Declare Function SetWindowLong& Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd&, ByVal nIndex&, ByVal dwNewLong&)
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function GetWindow Lib "user32" (ByVal hWnd As Long _
, ByVal wCmd As Long) As Long
Private Const GWL_WNDPROC As Long = (-4&)
Private hWnd As Long

Private Sub UserForm_Initialize()
Dim i&
hWnd = GetWindow(FindWindow(vbNullString, Me.Caption), 5)
With Me.ListView1
..ColumnHeaders.Add , , "Item Column", .Width * 1 / 3
..ColumnHeaders.Add , , "Subitem 1", .Width * 1 / 3
..ColumnHeaders.Add , , "Subitem 2", .Width * 1 / 3
For i = 0 To 99
With .ListItems.Add(, , "Item " & Format(i, "00"))
..SubItems(1) = "Subitem 1"
..SubItems(2) = "Subitem 2"
End With
Next
End With
OldProc = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, _
CloseMode As Integer)
Call SetWindowLong(hWnd, GWL_WNDPROC, OldProc)
End Sub
'''end code Userform
In standard module:

''''''start code standard module
Option Explicit
' Constants used for customdraw routine
Private Const NM_CUSTOMDRAW = (-12&)
Private Const WM_NOTIFY As Long = &H4E&
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&

' The NMHDR structure contains information about a
' notification message.
' The pointer to this structure is specified as the lParam member of
'a WM_NOTIFY message.
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

' Struct of the NMCUSTOMDRAW struct
Private Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type

' Generic customdraw struct
Private 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
NMCW As NMCUSTOMDRAW
ForeColorText As Long
BackColorText As Long
' if IE = 4.0 this member of the struct can be used
'iSubItem As Integer
End Type

' Function used to manipulate memory data
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(lpDest As Any, lpSource As Any, ByVal cBytes&)
' Function used to call the next window proc in the "chain" for the
' subclassed Window
Declare Function CallWindowProc& Lib "user32" Alias _
"CallWindowProcA" (ByVal lpPrevWndFunc&, ByVal hWnd&, _
ByVal Msg&, ByVal wParam&, ByVal lParam&)
' This var will hold a pointer to the original message handler
' so we MUST save it so that it can be restored before we
' exit the app.
' if we don't restore it.... CRASH!!!!
Public OldProc As Long

' WARNING -----------------------------------------------
' Do not try to step through this function in debug mode !
' You will crash also, do no set any break points in this function !
' You will crash subclassing is non-trivial and should be handled with
' extreame care !
'There are ways to use a "Debug" dll to allow you to set breakpoints in
' subclassed code in the IDE but this was not implimented for this demo.
' WARNING -----------------------------------------------

' This is implementation of the message handling routine
' determine which message was recieved
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
' If it's a WM_NOTIFY message copy the data from the
' address pointed to by lParam into a NMHDR struct
Dim UDT_NMHDR As NMHDR
CopyMemory UDT_NMHDR, ByVal lParam, 12&
With UDT_NMHDR
If .code = NM_CUSTOMDRAW Then
' If the code member of the struct is NM_CUSTOMDRAW, copy
' the data pointed to by lParam into a NMLVCUSTOMDRAW struct
Dim UDT_NMLVCUSTOMDRAW As NMLVCUSTOMDRAW
' This is now OUR copy of the struct
CopyMemory UDT_NMLVCUSTOMDRAW, ByVal lParam, Len(UDT_NMLVCUSTOMDRAW)
With UDT_NMLVCUSTOMDRAW.NMCW
' Determine whether or not this is one of the messages we are
' interested in
Select Case .dwDrawStage
' If it's a prepaint message, tell windows WE want first dibs on
' painting for each item and then exit without letting VB get
' this message
Case CDDS_PREPAINT
WindowProc = CDRF_NOTIFYITEMDRAW
Exit Function
Case CDDS_ITEMPREPAINT
' Set the forecolor for items in the listview.
' Set the backcolor for items in the listview.
If (.dwItemSpec Mod 2) = 0 Then
UDT_NMLVCUSTOMDRAW.ForeColorText = vbRed
UDT_NMLVCUSTOMDRAW.BackColorText = &HC0C0C0
' Copy our copy of the struct back to the memory address pointed
' to by lParam
CopyMemory ByVal lParam, UDT_NMLVCUSTOMDRAW, Len(UDT_NMLVCUSTOMDRAW)
End If
' Tell windows that we changed the font and do not allow VB to
' get this Message
WindowProc = CDRF_NEWFONT
Exit Function
End Select
End With
End If
End With
End Select
' Pass all messages on to VB and then return the value to windows
WindowProc = CallWindowProc(OldProc, hWnd, iMsg, wParam, lParam)
End Function

Sub CustomListView()
UserForm1.Show
End Sub

''''''end code standard module