ListView Tipo Cebra para la version LV 5

[Ever Cerna]

Hola, como estan bueno, queria pedirles una ayudadita estoy usando el LitView 5, lo uso mas que todo por la apariencia de windows que toma con el MANIFEST, ahora estaba biendo esto, http://www.leandroascierto.com.ar/foro/index.php?topic=75.0, pero me percarte que usa el ListView 6 quise probar el codigo con el ListView 5 y no logro hacer ese efecto Cebra, haber si alguien me ayuda.

Salu2.

[lucius]

A los listview 6 tambien se les puede dar la apariencia de windows xp si te interesa puedes cambiarlo en tus proximos proyectos ya la version 6 es mejor aqui el ejemplo
http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/484-explorador-con-skin.htm

Esto no responde a tu pregunta pero hace tiempo tambien utilizaba el listview 5 por la apariencia de xp y le faltaban varias cosas que se tenian que resolver metiendo bastante codigo y el listview 6 las tiene como cualquier otra propiedad.

Aqui hay otro ejemplo y me parece que es el mismo que tu has mencionado
http://www.recursosvisualbasic.com.ar/htm/listado-api/263-listview-xp.htm

[LeandroA]

Jack06 te paso una rutina para implemtarlo al la version 5 de Microsoft windows common controls

Aplica el estilo cebra, lineas de la grilla, y el Full Row select

Código: (vb) [Seleccionar]

Option Explicit
'Autor: Leandro Ascierto
'Web:   www.leandroascierto.com.ar
'Refencia: http://www.leandroascierto.com.ar/foro/index.php?topic=75.0
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hdc As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hdc As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function SetPixelV Lib "gdi32.dll" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long
Private Declare Function GetVersion Lib "kernel32" () As Long

Private Type LVBKIMAGE
    ulFlags         As Long
    hbm             As Long
    pszImage        As String
    cchImageMax     As Long
    xOffsetPercent  As Long
    yOffsetPercent  As Long
End Type

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

Private Const LVM_FIRST                     As Long = &H1000
Private Const LVM_GETITEMRECT               As Long = (LVM_FIRST + 14)
Private Const LVM_GETHEADER                 As Long = (LVM_FIRST + 31)
Private Const LVM_SETTEXTBKCOLOR            As Long = (LVM_FIRST + 38)
Private Const LVM_SETBKIMAGE                As Long = (LVM_FIRST + 68)
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE  As Long = (LVM_FIRST + 54)
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE  As Long = (LVM_FIRST + 55)

Private Const HDM_FIRST                     As Long = &H1200
Private Const HDM_GETITEMRECT               As Long = (HDM_FIRST + 7)

Private Const LVS_EX_GRIDLINES              As Long = &H1
Private Const LVS_EX_FULLROWSELECT          As Long = &H20
Private Const LVBKIF_STYLE_TILE             As Long = &H10
Private Const LVBKIF_FLAG_TILEOFFSET        As Long = &H100
Private Const LVBKIF_SOURCE_HBITMAP         As Long = &H1
Private Const CLR_NONE                      As Long = &HFFFFFFFF

Public Sub AltLVBackGround(LV As ListView, ByVal BackColorOne As OLE_COLOR, ByVal BackColorTwo As OLE_COLOR)

    Dim lExStyle As Long
    Dim hdc As Long
    Dim DC As Long
    Dim hBMP As Long
    Dim OldBmp As Long
    Dim i As Long
    Dim tLBI As LVBKIMAGE
    Dim hHeader As Long
    Dim LVItemHeight As Long
    Dim CHItemHeight As Long
    Dim Rec As RECT
   
    If LV.View = lvwReport And LV.ListItems.Count Then
   
        hHeader = SendMessage(LV.hwnd, LVM_GETHEADER, 0&, ByVal 0&)
        Call SendMessage(hHeader, HDM_GETITEMRECT, 0&, Rec)
        CHItemHeight = Rec.Bottom - Rec.Top
       
        Call SendMessage(LV.hwnd, LVM_GETITEMRECT, 0&, Rec)
        LVItemHeight = Rec.Bottom - Rec.Top
       
        hdc = GetDC(0)
        DC = CreateCompatibleDC(0)
        hBMP = CreateCompatibleBitmap(hdc, 1, LVItemHeight * 2)
        ReleaseDC 0&, hdc
        OldBmp = SelectObject(DC, hBMP)
       
        For i = 0 To LVItemHeight - 1
            SetPixelV DC, 0, i, BackColorOne
            SetPixelV DC, 0, LVItemHeight + i, BackColorTwo
        Next
       
        If (GetVersion And &HFF) > 5 Then tLBI.yOffsetPercent = LVItemHeight - CHItemHeight
        tLBI.ulFlags = LVBKIF_SOURCE_HBITMAP Or LVBKIF_FLAG_TILEOFFSET Or LVBKIF_STYLE_TILE
        tLBI.hbm = hBMP

        SendMessage LV.hwnd, LVM_SETBKIMAGE, 0&, tLBI
        SendMessage LV.hwnd, LVM_SETTEXTBKCOLOR, 0&, ByVal CLR_NONE
                   
        DeleteObject SelectObject(DC, OldBmp)
        DeleteDC DC

        lExStyle = SendMessage(LV.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, ByVal 0&)
        lExStyle = lExStyle Or LVS_EX_GRIDLINES Or LVS_EX_FULLROWSELECT
        SendMessage LV.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, ByVal lExStyle
       
    End If
   
End Sub

Forma de uso

Código: (vb) [Seleccionar]

Option Explicit

Private Sub Form_Load()

    Dim i As Long
    Dim LVItem As ListItem
   
    ListView1.View = lvwReport
    ListView1.ColumnHeaders.Add , , "Columna 1"
    ListView1.ColumnHeaders.Add , , "Columna 2"
   
    For i = 1 To 100
        Set LVItem = ListView1.ListItems.Add(, , "Item " & i)
        LVItem.SubItems(1) = "SubItem 1"
    Next
   
   Call AltLVBackGround(ListView1, RGB(209, 222, 252), RGB(255, 255, 255))
   
End Sub


Saludos.

[lucius]

muy bueno, gracias a Jack06 por preguntar y leandroA por el codigo, ahora le pondre estilo cebra a unos sistemas que tengo con el lv5.
Cuando no leandro con el buche lleno de codigos, saludos

[YAcosta]

A todo esto, es posible aplicar el estilo cebra en un control MSHFlexGird? o MSFlexGrid? aunque yo uso el primero de ellos en casi todo.
Una vez lo hice pero me va un poco lento cuando son cientos de registros y lo hice usando un for next y columna por columna pintando a mano, creo que no hay de otra y solo quedaría hacerlo asi, o no?

[LeandroA]

hice una porque olvide quitar el backcolor

Saludos.

[Ever Cerna]

Wowww gracias Leandro, no hay nada imposible para ti.

Salu2.

[ssccaann43]

A todo esto, es posible aplicar el estilo cebra en un control MSHFlexGird? o MSFlexGrid? aunque yo uso el primero de ellos en casi todo.
Una vez lo hice pero me va un poco lento cuando son cientos de registros y lo hice usando un for next y columna por columna pintando a mano, creo que no hay de otra y solo quedaría hacerlo asi, o no?

Aqui tienes para ambos objetos...!

Código: (vb) [Seleccionar]


'En un modulo bas
Public Sub AltLVBackGroundFlex(Flex As Object, _
ByVal BackColorOne As OLE_COLOR, _
ByVal BackColorTwo As OLE_COLOR)

    Dim Row            As Long
    Dim Col            As Integer

    With Flex

        .Redraw = False
       
        .BackColor = BackColorOne

        For Row = 1 To .Rows - 1 Step 2

            .Row = Row
           
            For Col = 0 To .Cols - 1
           
                .Col = Col
               
                .CellBackColor = BackColorTwo
               
            Next
           
        Next
       
        .Redraw = True
       
    End With
   
End Sub

'Luego en el Form donde este el Grid para usarlo

Private Sub CargarFlex_Click()
'Luego de realizar la carga de datos, colocas esto si es para el MSHFlexGrid
Call AltLVBackGroundFlex(MSHFlexGrid1, RGB(255, 255, 255), RGB(230, 222, 253))
'O este si es para el MSFlexGrid
Call AltLVBackGroundFlex(MSFlexGrid1, RGB(255, 255, 255), RGB(230, 222, 253))
End Sub

Pruebalos y cualquier cosa me comentas

[YAcosta]

Gracias Miguel, voy a probarlo.

[Ever Cerna]

Hola Leandro, el codigo esta espectacular, yo uso Win 7, y no se porque pinta desordenado. Todavia no lo pruebo en WIN XP a lo mejor alli si funciona normal.



Haber si me hechas otra manito.

Salu2.

[LeandroA]

Hola Leandro, el codigo esta espectacular, yo uso Win 7, y no se porque pinta desordenado. Todavia no lo pruebo en WIN XP a lo mejor alli si funciona normal.



Haber si me hechas otra manito.

Salu2.

Solucionado (modifique el primer post)

Por lo visto Seven Y  Vista, trabajan diferente comienzan a rendereizar el bitmap por devajo de las columnas, asi que puse la constante LVBKIF_FLAG_TILEOFFSET para indicar donde deve comenzar a pintar calculando el la diferencia entre el alto del item y el alto del columnHeder, ademas utilize apis para calcular el alto asi no hay problemas si el formulario esta en vbPixels o vbtwips

hay que dejar en claro que esto funciona estando presente los temas de windows en la aplicación (.manifest)

de yapa te dejo una para aplicar una selecion de items mas linda en caso de que corra vajo Seven o Vista

Código: [Seleccionar]

Private Declare Function SetWindowTheme Lib "uxtheme.dll" (ByVal hwnd As Long, ByVal pszSubAppName As Long, ByVal pszSubIdList As Long) As Long
Private Declare Function GetVersion Lib "kernel32" () As Long

Private Sub Form_Load()
   If (GetVersion And &HFF) > 5 Then Call SetWindowTheme(ListView1.hwnd, StrPtr("explorer"), 0)
End Sub

para mi gusto no es para este caso ya que la grilla come un pixel de la selecion pero para otros casos queda lindo.

Saludos.

[Ever Cerna]

  Gracias Leandro, ahora si funciona perfecto.

Salu2.

[ssccaann43]

Gracias Miguel, voy a probarlo.

Te funcionó sin problemas?

[YAcosta]

Gracias Miguel, voy a probarlo.

Te funcionó sin problemas?

Hola Miguel
Mira, lo he llevado al limite para probarlo y he cargado en un MSHFlexGrid unos 10,500 registros, cambie de color a la zebra, y lo puse para que pinte desde la columna 1, aplique la función y use filtros de búsquedas por cada pulsación de tecla para actualizar en el grid los resultados y va muuuuy bien. Lo que demora por pintar es casi imperceptible, casi no demora nada, creo que el truco esta en .Redraw = False, esa no la había probado.

Muy bien, gracias, he creado otra función que llama a la tuya para hacerlo mas digerible en mi programación, por ejemplo:
Call ZebraGrid(Grid1, 1)
Call ZebraGrid(Grid1, 2)
etc
Donde 1, 2, son los colores alternativos que usare para diferentes tipos de datos que cargare en los diferentes grids.

Saludos....

P.D:
Doc, aun estoy interesado en el otro tema, me avisas cuando consigas las claves de acceso al FBI que me indicaste y poder copypastear la lista NOD. Saludos.

Este mensaje se podría autodestruir en 5 segundos.

[YAcosta]

Otra vez levantando temas antiguos, sorry.
Uso AltLVBackGroundFlex y todo perfecto, logro el efecto Zebra y todo bien. Pero ahora el cliente me pide que quiere hacer clic en la cabecera del grid para ordenar los registros, eso ya lo tengo resuelto, el problema es que se jode la zebra, se vuelve un mapache je. Las filas empiezan a tener los colores desordenados, y a medida que le doy mas clic al grid en le cabecera, esta se va volviendo al final en un solo color.

Quise ponerle en la cabecera a que me pinte tdo de un solo color antes que entre a AltLVBackGroundFlex y no funca. En el grid puse esto:

Código: [Seleccionar]

If Grid1.MouseRow = 0 Then
   Grid1.BackColor = vbWhite  <--- Para que me pinte todo el grid en blanco y luego aplique el zebra
   Call ZebraGrid(Grid)
End Ify nada, sigue saliendo desordenado. Ven alguna forma de resolverlo?

ZebraGrid trae esto:

Código: [Seleccionar]

Public Sub ZebraGrid(Flex As Object)
Call AltLVBackGroundFlex(Flex, RGB(255, 255, 255), RGB(230, 243, 255))
End Sub
y AltLVBackGroundFlex trae esto:

Código: [Seleccionar]

Public Sub AltLVBackGroundFlex(Flex As Object, ByVal BackColorOne As OLE_COLOR, ByVal BackColorTwo As OLE_COLOR)
Dim Row            As Long
Dim Col            As Integer
With Flex
   .Redraw = False
   .BackColor = BackColorOne
   
   For Row = 1 To .Rows - 1 Step 2
      .Row = Row
      For Col = 1 To .Cols - 1
         .Col = Col
         .CellBackColor = BackColorTwo
      Next
   Next
   .Redraw = True
End With
End Sub

Ojala que la solucion no sea volver a recorrer todo el grid fila por fila y columna por columna para pintar de un solo color el grid y luego volver a pasar para pintarlo de Zebra, alli si estaria feo.