|
|
|
|
|
|
|
|
Dicas
|
|
|
Visual Basic (ActiveX/Controles/DLL)
|
|
 |
Título da Dica: Listview Zebrado
|
 |
|
|
|
Postada em 7/10/2003 por ^HEAVY-METAL^
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
idFrom As Long
code As Long
End Type
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
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
Public Type NMLVCUSTOMDRAW
nmcd As NMCUSTOMDRAW
clrText As Long
clrTextBk As Long
End Type
Public g_addProcOld As Long
Public g_MaxItems 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 Val(Form1.ListView1.ListItems(.dwItemSpec + 1).Text) 100 Then
udtNMLVCUSTOMDRAW.clrText = vbBlack
Else
udtNMLVCUSTOMDRAW.clrText = vbRed
End If
'I used Listitem.Tag Property To Set color, though you can use Text etc.
udtNMLVCUSTOMDRAW.clrTextBk = Val(Form1.ListView1.ListItems(.dwItemSpec + 1).Tag)
CopyMemory ByVal lParam, udtNMLVCUSTOMDRAW, Len(udtNMLVCUSTOMDRAW)
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
'No formulário. coloque esse código:
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 Form_Load()
With ListView1
.FullRowSelect = True
.View = lvwReport
.ColumnHeaders.Add , , "Item Column"
.ColumnHeaders.Add , , "Subitem 1"
.ColumnHeaders.Add , , "Subitem 2"
Dim i&
For i = 1 To 30
With .ListItems.Add(, , CStr(Int(200 * Rnd)))
.SubItems(1) = "Subitem 1"
.SubItems(2) = "Subitem 2"
.Tag = QBColor(15)
If i Mod 2 Then .Tag = CStr(QBColor(14))
End With
Next
g_MaxItems = .ListItems.Count - 1
End With
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
T+,
|
|
|
|
|
