Débora
não registrado
|
|
ENUNCIADA !
|
|
|
Postada em 12/08/2004 10:37 hs
Bom dia, Estou precisando exibir o meu ListView zebrado (Ex.: Uma linha inteira verde, outra linha branca) com certa urgência. Peguei o exemplo deste site porém esta dando erro. Alguém tem algum exemplo para me passar. Agradecida Débora Segue o Exemplo 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
|
|
|
|
|
Postada em 12/08/2004 11:45 hs
Alguém tem noção de como resolver este problema.
|
|
|
|
Postada em 07/12/2004 10:01 hs
vc não poderia utilizar o truedbgrid? ele é mais facil para fazer isso, se quiser eu te mando ele
Humberto Pereira "Ninguém jamais concordará em rastejar se sentir impulso de voar".
|
|
|
|
Postada em 07/12/2004 11:15 hs
Débora qual o problema , sempre utilizei esta dica e nunca me ocorreu nada
|
|
|
Sandro
não registrado
|
|
ENUNCIADA !
|
|
|
Postada em 07/12/2004 12:45 hs
Nunca usei este recurso, mas onde ocorre o erro? Pergunto isso pois o que você está fazendo na verdade é chamado de subclassificação de janelas, pois você intercepta as mensagens do Windows para o seu formulário. Até aí tudo bem, mas você deve ter cuidado de não parar o programa (stop no menu ou na barra de ferramentas VB) sem fechar normalmente a janela, pois você irá causar um erro interno no VB e derrubar o IDE. Mas concordo com o amigo Invictor, de que o TrueDBGrid é mais prático, mas você também pode usar o MSFlexGrid alterando a cor dee fundo das células.
|
|
|
Allan
não registrado
|
|
ENUNCIADA !
|
|
|
Postada em 20/04/2009 16:14 hs
Eu usei este código, mas não deu certo aqui. Meu VBA trava toda vez que tento executá-lo.
|
|
|
|