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