Cargar recordset en Listview 5.0

[zxs23]

Solo he encontrado como cargar un Listview con la version 6.0 es posible hacerlo con la version5 ya que en esta no estan presentes algunas propiedades, dejo el codigo.
Microsoft Windows Common Controls 5.0 (SP2)
Microsoft Windows Common Controls 6.0 (SP6)

Código: [Seleccionar]

Private Sub Command7_Click()
 
    Dim Campo As Integer

    'Variable para los SubItem del LV
    Dim Item As ListItem
    Dim i As Long
   
    Set rs = New Recordset
    rs.Open "SELECT * FROM producto", dbConex, adOpenStatic, adLockPessimistic
 
    With ListView1
        'Vista de reporte
        .View = lvwReport
        ' Elimina los item y los encabezado de columna
        .ListItems.Clear
        .ColumnHeaders.Clear
        '.FullRowSelect = True
        '.GridLines = True
    End With

    'Agrega los nombres campo junto con los encabezados de columna para el ListView
    For Campo = 0 To rs.Fields.Count - 1
        ListView1.ColumnHeaders.Add , , rs.Fields(Campo).Name
    Next

    ' Recorre todos los registros del Recordset
    While Not rs.EOF
        'Agrega el Item
        Set Item = ListView1.ListItems.Add(, , rs.Fields(0))
        i = 1

        'Agrega los SubItem al ListView mediante la variable ITEM
        For Campo = 1 To rs.Fields.Count - 1
   
            'si el dato no es de tipo Null lo agrega
            If Not IsNull(rs.Fields(Campo)) Then
                Item.SubItems(i) = rs.Fields(Campo)
            End If
            i = i + 1
        Next
   
    'Siguiente registro
    rs.MoveNext
    Wend
   
End Sub


[LeandroA]

Hola no dijiste donde esta el Error pero por lo que puedo intuir vos tenes cagado seguramente las dos versiones en el proyecto la 6 y la 5 y el confilicto es cuando declaras Dim Item As ListItem  al hacer esto vb interpreta a Item como una clase de la version 6 y luego le pasas una clase de la version 5 entonses esto produce un error, lo mejor es trabajar con una sola version.
de igual forma si queres seguir con las dos tenes que declarar a Item como un objeto

dim Item as Object

Saludos.

[zxs23]

Tienes razon con tantos ejemplos no me daba cuenta , lo que pasaba es que si tenia cargadas las 2 versiones solo la ultima funciona, ya quite la version 6 y funciona.
Una ultima cosa en la version 5 no existen estas propiedades
  .FullRowSelect = True
  .GridLines = True
Es posible lograr su funcionalidad de alguna forma o cuales debo utilizar por que no encuentro nada.

saludos

[zxs23]

Ya encontre un par de ejemplos
En un modula bas

Código: [Seleccionar]

Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2009 VBnet, Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
'               applications, but you may not reproduce
'               or publish this code on any web site,
'               online service, or distribute as source
'               on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Public Declare Function SendMessage Lib "user32" _
   Alias "SendMessageA" _
  (ByVal hwnd As Long, _
   ByVal Msg As Long, _
   ByVal wParam As Long, _
   lParam As Any) As Long

Public Const LVM_FIRST = &H1000
Public Const LVM_SETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 54)
Public Const LVM_GETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 55)
Public Const LVS_EX_FULLROWSELECT = &H20
Public Const LVS_EX_GRIDLINES = &H1

Para llamar a la funciona algo asi p.e:

Código: [Seleccionar]

Option Explicit

Private Sub Check1_Click()
   Dim state As Long
   state = Check1.Value = 1

   Call SendMessage(ListView1.hwnd, _
                    LVM_SETEXTENDEDLISTVIEWSTYLE, _
                    LVS_EX_GRIDLINES, ByVal state)

End Sub

Private Sub Check2_Click()
   Dim state As Long
  state = Check2.Value = 1
   
  Call SendMessage(ListView1.hwnd, _
                        LVM_SETEXTENDEDLISTVIEWSTYLE, _
                        LVS_EX_FULLROWSELECT, ByVal state)
End Sub

Fuente:
http://vbnet.mvps.org/index.html?code/comctl/lvgridlines.htm
http://vbnet.mvps.org/index.html?code/comctl/lvfullrowselect.htm

saludos

[LeandroA]

hola a lo mismo que el ejemplo que pusiste tenes que agregar la constante LVS_EX_GRIDLINES

Código: [Seleccionar]

Option Explicit
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 54)
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 55)
Private Const LVS_EX_GRIDLINES = &H1&
Private Const LVS_EX_FULLROWSELECT = &H20&
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal Hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Sub Form_Load()
    Dim lLvExStyle As Long
    lLvExStyle = SendMessage(ListView1.Hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
    lLvExStyle = lLvExStyle Or LVS_EX_GRIDLINES Or LVS_EX_FULLROWSELECT
    Call SendMessage(ListView1.Hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, ByVal lLvExStyle)
End Sub

lo que si la propiedad GRIDLINES en esta version provoca un repintado medio feo cuando precionas las puntas del scroll

Saludos.

[zxs23]

Tienes razon al moverse por el scroll se rayan las filas, por lo que veo no hay solucion o si?
Para terminar como puedo hacer mas altas las filas de Listview al igual que el control ucListview que por cierto tiene el mismo problema con el scroll, a

saludos

[LeandroA]

hola, la unica forma que se me ocurre es subclasificando a listview e interceptar cuando se hace clink en las flechas de el scroll vertical que es donde produce la falla.

En un modulo

Código: [Seleccionar]

Option Explicit

Private Declare Function RedrawWindow Lib "user32.dll" (ByVal hwnd As Long, ByRef lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

Private Const WM_VSCROLL = &H115
Private Const SB_LINEDOWN = 1
Private Const SB_LINEUP = 0

Public Const GWL_WNDPROC = (-4)
Dim PrevProc As Long


Public Sub HookLView(hwnd As Long)
    PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
End Sub

Public Sub UnHookLView(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, PrevProc
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
    WindowProc = CallWindowProc(PrevProc, hwnd, uMsg, wParam, lParam)

    If uMsg = WM_VSCROLL Then
        Select Case GetLoWord(wParam)
            Case SB_LINEDOWN
                RedrawWindow hwnd, 0&, 0&, 1
            Case SB_LINEUP
                RedrawWindow hwnd, 0&, 0&, 1
        End Select
    End If
   
End Function


Private Function GetLoWord(dw As Long) As Long
    If dw And &H8000& Then
        GetLoWord = &H8000 Or (dw And &H7FFF&)
    Else
        GetLoWord = dw And &HFFFF&
    End If
End Function

y en el form para probar.

Código: [Seleccionar]

Option Explicit
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 54)
Private Const LVM_GETEXTENDEDLISTVIEWSTYLE = (LVM_FIRST + 55)
Private Const LVS_EX_GRIDLINES = &H1&
Private Const LVS_EX_FULLROWSELECT = &H20&
Private Declare Function SendMessage Lib "user32.dll" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByRef lParam As Any) As Long

Private Sub Form_Load()
    Dim lLvExStyle As Long
    lLvExStyle = SendMessage(ListView1.hwnd, LVM_GETEXTENDEDLISTVIEWSTYLE, 0&, 0&)
    lLvExStyle = lLvExStyle Or LVS_EX_GRIDLINES Or LVS_EX_FULLROWSELECT
    Call SendMessage(ListView1.hwnd, LVM_SETEXTENDEDLISTVIEWSTYLE, 0&, ByVal lLvExStyle)
   
    HookLView ListView1.hwnd
   
    Dim i As Long
    For i = 0 To 100
        ListView1.ListItems.Add , , "item" & i
    Next
End Sub


Private Sub Form_Unload(Cancel As Integer)
    UnHookLView ListView1.hwnd
End Sub

El ejemplo que te pase esta echo para un solo listview para mas de uno a la vez ya hay que hacer unos pequeños retoques.

[zxs23]

Quedo estupendo tio, eres lo maximo cuando tengas unos minutos espero lo fixees para que funciona para varios listview, he estado revisando el ucListview para ver como se hizo para que las filas sean mas altas pero no doy para mas mis respetos por tu sabidaria jaja

[LeandroA]

Lo de las filas mas altas es solo porque tiene asociado un imagelist con iconos de 16x16 y es por eso que parece mas alto ya que el texto calculo que deve ser 13 pixels de alto, entoses o le pones la fuente mas grande o le pondes un imagelist con un icono 

y para lo del fix del grid con mas de un listview a la ves queda asi (tambien le agregue el pageup y pagedown que tambien probocaba el mal repintado.

Código: [Seleccionar]

Option Explicit

Private Declare Function RedrawWindow Lib "user32.dll" (ByVal hwnd As Long, ByRef lprcUpdate As Any, ByVal hrgnUpdate As Long, ByVal fuRedraw As Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetProp Lib "user32.dll" Alias "SetPropA" (ByVal hwnd As Long, ByVal lpString As String, ByVal hData As Long) As Long
Private Declare Function GetProp Lib "user32.dll" Alias "GetPropA" (ByVal hwnd As Long, ByVal lpString As String) As Long
Private Declare Function RemoveProp Lib "user32.dll" Alias "RemovePropA" (ByVal hwnd As Long, ByVal lpString As String) As Long

Private Const WM_VSCROLL = &H115

Private Const SB_LINEUP = 0
Private Const SB_LINEDOWN = 1
Private Const SB_PAGEUP = 2
Private Const SB_PAGEDOWN = 3

Public Const GWL_WNDPROC = (-4)

Public Sub HookLView(hwnd As Long)
    Dim PrevProc As Long
    PrevProc = SetWindowLong(hwnd, GWL_WNDPROC, AddressOf WindowProc)
    SetProp hwnd, "PrevProc", PrevProc
End Sub

Public Sub UnHookLView(hwnd As Long)
    SetWindowLong hwnd, GWL_WNDPROC, GetProp(hwnd, "PrevProc")
    RemoveProp hwnd, "PrevProc"
End Sub

Public Function WindowProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long

    WindowProc = CallWindowProc(GetProp(hwnd, "PrevProc"), hwnd, uMsg, wParam, lParam)

    If uMsg = WM_VSCROLL Then
        Select Case GetLoWord(wParam)
            Case SB_LINEDOWN, SB_LINEUP, SB_PAGEDOWN, SB_PAGEUP
                RedrawWindow hwnd, 0&, 1, 1
        End Select
    End If
   
End Function

Private Function GetLoWord(dw As Long) As Long
    If dw And &H8000& Then
        GetLoWord = &H8000 Or (dw And &H7FFF&)
    Else
        GetLoWord = dw And &HFFFF&
    End If
End Function

despues para llamarlo hace asi

    HookLView ListView1.hwnd
    HookLView ListView2.hwnd

[zxs23]

Se agradace por los minutos, funciona perfecto, cualquier cosa regreso por aqui.

saludos