[RESOLVED] How to load the data fast from database into listview?

[Mustaphi]

Hello vbForums
I'm using Krool's listview control and sqlite3 as database and Olaf's RC6\
I'm populating about 1700 records into listview.
It takes about 5 to 6 seconds for the form to show.
this is my code in form load event

Set RS = Cnn.OpenRecordset("SELECT m_name, pos, qtite FROM db_tbl order by m_name Collate NoCase")
If Not RS.EOF Then

lvw.Redraw = False

Dim Lst As LvwListItem
Do While Not RS.EOF
Set Lst = lvw.ListItems.Add(, , RS.Fields("mname").Value)
Lst.SubItems(1) = RS.Fields("pos").Value
Lst.SubItems(2) = RS.Fields("qtite ").Value

RS.MoveNext
Loop
End If
lvw.Redraw = True
lvw.Visible = True

[bahbahbah]

That seems to work fine for me - I've set up a test SQLite database with 3 columns and 2000 rows and added them to Krool's listview and it only takes 300ms (in IDE, code is below). Even if I have it redraw every time it only takes 1000ms.

Set a breakpoint on the line "If Not RS.EOF Then" and see how long it takes to get there - I'm thinking it's got to be the query that's the time sink?



Here's the code I used for testing:

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private Sub cmdGo_Click()

Dim lStart As Long, lFinish As Long
lStart = GetTickCount

Dim lst As LvwListItem
lv.ColumnHeaders.Add , "test", "test"
lv.ColumnHeaders.Add , "test2", "test2"
lv.ColumnHeaders.Add , "test3", "test3"

Dim xCon As cConnection
Set xCon = New_c.Connection(App.Path & "\db.sqlite")

Dim xRec As cRecordset
Set xRec = New_c.Recordset

Set xRec = xCon.OpenRecordset("select * from TestTable ORDER BY TestCol3")

If Not xRec.EOF Then
    
    lv.Redraw = False
    
    Do While Not xRec.EOF
        Set lst = lv.ListItems.Add(, , xRec.Fields("TestCol1").Value)

        lst.SubItems(1) = xRec.Fields("TestCol2").Value
        lst.SubItems(2) = xRec.Fields("TestCol3").Value
        
        xRec.MoveNext
    Loop
End If
lv.Redraw = True

lFinish = GetTickCount
Debug.Print lFinish - lStart
End Sub

[xiaoyao]

you can use virtual listview ,so you only set data in recordset ,no need lv.ListItems.Add
you only set rows,cols

[Mustaphi]

you can use virtual listview ,so you only set data in recordset ,no need lv.ListItems.Add
you only set rows,cols

could you please provide link or example?

[Mustaphi]

bahbahbah

Debug.Print lFinish - lStart

I get 1828

[bahbahbah]

You can use the virtual mode like the below. Takes 40ms on my computer.

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private xRec As cRecordset

Private Sub cmdGo_Click()
    Dim lStart As Long, lFinish As Long
    lStart = GetTickCount
    
    Dim lst As LvwListItem
    lv.Redraw = False
    lv.ColumnHeaders.Add , "test", "test"
    lv.ColumnHeaders.Add , "test2", "test2"
    lv.ColumnHeaders.Add , "test3", "test3"
    
    Dim xCon As cConnection
    Set xCon = New_c.Connection(App.Path & "\db.sqlite")
    
    Set xRec = New_c.Recordset
    Set xRec = xCon.OpenRecordset("select * from TestTable ORDER BY TestCol3")
    
    lv.VirtualItemCount = xRec.RecordCount
    lv.Redraw = True
    
    lFinish = GetTickCount
    Debug.Print lFinish - lStart
End Sub

Private Sub lv_GetVirtualItem(ByVal ItemIndex As Long, ByVal SubItemIndex As Long, ByVal VirtualProperty As VBCCR17.LvwVirtualPropertyConstants, Value As Variant)
    If VirtualProperty = LvwVirtualPropertyText Then
    
        xRec.AbsolutePosition = ItemIndex

        Value = xRec.Fields(SubItemIndex).Value
    End If
End Sub

[Mustaphi]

You can use the virtual mode like the below. Takes 40ms on my computer.

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private xRec As cRecordset

Private Sub cmdGo_Click()
    Dim lStart As Long, lFinish As Long
    lStart = GetTickCount
    
    Dim lst As LvwListItem
    lv.Redraw = False
    lv.ColumnHeaders.Add , "test", "test"
    lv.ColumnHeaders.Add , "test2", "test2"
    lv.ColumnHeaders.Add , "test3", "test3"
    
    Dim xCon As cConnection
    Set xCon = New_c.Connection(App.Path & "\db.sqlite")
    
    Set xRec = New_c.Recordset
    Set xRec = xCon.OpenRecordset("select * from TestTable ORDER BY TestCol3")
    
    lv.VirtualItemCount = xRec.RecordCount
    lv.Redraw = True
    
    lFinish = GetTickCount
    Debug.Print lFinish - lStart
End Sub

Private Sub lv_GetVirtualItem(ByVal ItemIndex As Long, ByVal SubItemIndex As Long, ByVal VirtualProperty As VBCCR17.LvwVirtualPropertyConstants, Value As Variant)
    If VirtualProperty = LvwVirtualPropertyText Then
    
        xRec.AbsolutePosition = ItemIndex

        Value = xRec.Fields(SubItemIndex).Value
    End If
End Sub

thank you very much for your help
I copied your code with necessary changes of course.
the output of Debug.Print lFinish - lStart is 47
but the listview is empty.

[bahbahbah]

Ensure you have:

    lv.VirtualItemCount = xRec.RecordCount

and

Private Sub lv_GetVirtualItem(ByVal ItemIndex As Long, ByVal SubItemIndex As Long, ByVal VirtualProperty As VBCCR17.LvwVirtualPropertyConstants, Value As Variant)
    If VirtualProperty = LvwVirtualPropertyText Then
    
        xRec.AbsolutePosition = ItemIndex

        Value = xRec.Fields(SubItemIndex).Value
    End If
End Sub

Post your code.

[Mustaphi]

Private Declare Function GetTickCount Lib "kernel32" () As Lon

Private Sub Fill_lvw_Click()
    Dim lStart As Long, lFinish As Long
    lStart = GetTickCount
    
    Dim lst As LvwListItem
    lvw.Redraw = False
 lvw.ListItems.Clear
Set Cnn = New_c.Connection(MyDBPath, DBOpenFromFile)
lvw.ColumnHeaders.Add , , "medicament", lvw.Width * 0.6, LvwColumnHeaderAlignmentLeft
lvw.ColumnHeaders.Add , , "quantite", lvw.Width * 0.25, LvwColumnHeaderAlignmentLeft
lvw.ColumnHeaders.Add , , "posologie", lvw.Width * 0.6, LvwColumnHeaderAlignmentLeft


    Set RS = Cnn.OpenRecordset("SELECT m_name, pos, qtite FROM db_tbl order by m_name Collate NoCase")
    
    lvw.VirtualItemCount = RS .RecordCount
    lvw.Redraw = True
    
    lFinish = GetTickCount
    Debug.Print lFinish - lStart
End Sub

Private Sub lv_GetVirtualItem(ByVal ItemIndex As Long, ByVal SubItemIndex As Long, ByVal VirtualProperty As VBCCR18.LvwVirtualPropertyConstants, Value As Variant)
    If VirtualProperty = LvwVirtualPropertyText Then
    
        RS.AbsolutePosition = ItemIndex

        Value = RS.Fields(SubItemIndex).Value
    End If
End Sub

[bahbahbah]

Oh, right. I forgot to mention, you need to set VirtualMode = True in the listview (must be done at design time, can't be done through code).

[Mustaphi]

thank you but still no luck
this time I get the listview Column Headers filled aalso the vertical scrollbar is visible but data inside the listview is still invisible

[bahbahbah]

Set a breakpoint on "Value = RS.Fields(SubItemIndex).Value" and check that you are getting the correct result from RS.Fields(SubItemIndex).Value.

[Mustaphi]

Set a breakpoint on "Value = RS.Fields(SubItemIndex).Value" and check that you are getting the correct result from RS.Fields(SubItemIndex).Value.

I did but nothing happens

[bahbahbah]

What do you mean nothing happens? The breakpoint doesn't get hit, or RS.Value is not returning anything?

If you change this line
Value = RS.Fields(SubItemIndex).Value

To this:
Value = "Test"

What happens when you run it then?

[Mustaphi]

I apologize for lack of concentration
I missed this.
Private Sub lv_GetVirtualItem
it should be
Private Sub lvw_GetVirtualItem
now the form loads far better
thank you very much

[Mustaphi]

unfortunately I figured out that it is not possible to use listview chechbox
So I can't use virtual listview

[bahbahbah]

You can use checkboxes with a virtual listview - you've just got to track it manually. Below is an example.

Virtual mode can be a bit of a pain to deal with though. You might want to consider using a different control like this:
https://github.com/Planet-Source-Cod...32/tree/master




Code for checkboxes with virtual listview:

Option Explicit
Private Declare Function GetTickCount Lib "kernel32" () As Long

Private xRec As cRecordset

Private bListItemChecked() As Boolean

Private Sub cmdGo_Click()
    Dim lStart As Long, lFinish As Long
    lStart = GetTickCount
    
    Dim lst As LvwListItem
    lv.Redraw = False
    lv.Checkboxes = True
    lv.ColumnHeaders.Add , "test", "test"
    lv.ColumnHeaders.Add , "test2", "test2"
    lv.ColumnHeaders.Add , "test3", "test3"
    
    Dim xCon As cConnection
    Set xCon = New_c.Connection(App.Path & "\db.sqlite")
    
    Set xRec = New_c.Recordset
    Set xRec = xCon.OpenRecordset("select * from TestTable ORDER BY TestCol3")
    
    lv.VirtualItemCount = xRec.RecordCount
    
    ReDim bListItemChecked(0 To xRec.RecordCount)
    lv.Redraw = True
    
    lFinish = GetTickCount
    Debug.Print lFinish - lStart
End Sub

Private Sub lv_GetVirtualItem(ByVal ItemIndex As Long, ByVal SubItemIndex As Long, ByVal VirtualProperty As VBCCR17.LvwVirtualPropertyConstants, Value As Variant)
    If VirtualProperty = LvwVirtualPropertyText Then
    
        xRec.AbsolutePosition = ItemIndex

        Value = xRec.Fields(SubItemIndex).Value
    ElseIf VirtualProperty = LvwVirtualPropertyChecked Then
        Value = bListItemChecked(ItemIndex)
    End If
End Sub

Private Sub lv_ItemCheck(ByVal Item As VBCCR17.LvwListItem, ByVal Checked As Boolean)
    bListItemChecked(Item.Index) = Not bListItemChecked(Item.Index)
End Sub

[Mustaphi]

thank you sir but I;m getting
Subscript out of range here
Value = bListItemChecked(ItemIndex)

[bahbahbah]

Make sure you have this line after you've run the query:
ReDim bListItemChecked(0 To xRec.RecordCount)

[Mustaphi]

I'm so grateful to you sir
million thanks

[bahbahbah]

No problem. Let us know if you run into any more hiccups.

[Mustaphi]

No problem. Let us know if you run into any more hiccups.

thank you again
If I want to uncheck the lvw items , I get error

Dim i As Long
    
    For i = 1 To lvw.ListItems.count
        If lvw.ListItems.Item(i).Checked = True Then lvw.ListItems.Item(i).Checked = False
        Next i

[Schmidt]

thank you again
If I want to uncheck the lvw items , I get error

Dim i As Long
    
    For i = 1 To lvw.ListItems.count
        If lvw.ListItems.Item(i).Checked = True Then lvw.ListItems.Item(i).Checked = False
        Next i

When you work with virtual Lists, you're good advised to work as much as possible -
with only the externally (bound) data-containers (Rs' or Arrays) - leaving the ListView alone (data-wise).

Here's an example for Krools ListView in virtual mode:

Option Explicit

Private Rs As cRecordset, ArrChecked() As Boolean

Private Sub Form_Load()
  With New_c.MemDB
      .Exec "Create Table T(name Text, pos Text, qtite int)"
      Dim i As Long
      For i = 1 To 20000 'insert 20000 dummy records into the mem-db-table
        .ExecCmd "Insert Into T Values(?,?,?)", "Name " & i, i & " mg", i
      Next
      Set Rs = .GetRs("SELECT * From T")
      ReDim ArrChecked(1 To Rs.RecordCount) 'redim the bool-array to the same (record-)size as the Rs
  End With
  
  New_c.Timing True 'time the setup and filling of the Grid (after Rs-creation)
      lvw.ColumnHeaders.Add , , "medicament", lvw.Width * 0.3, LvwColumnHeaderAlignmentLeft
      lvw.ColumnHeaders.Add , , "posologie", lvw.Width * 0.4, LvwColumnHeaderAlignmentLeft
      lvw.ColumnHeaders.Add , , "quantite", lvw.Width * 0.2, LvwColumnHeaderAlignmentLeft
      
      lvw.VirtualItemCount = Rs.RecordCount
  Caption = New_c.Timing
End Sub

Private Sub lvw_GetVirtualItem(ByVal ItemIndex As Long, ByVal SubItemIndex As Long, ByVal VirtualProperty As LvwVirtualPropertyConstants, Value As Variant)
    If VirtualProperty = LvwVirtualPropertyText Then
        Value = Rs.ValueMatrix(ItemIndex - 1, SubItemIndex)
    ElseIf VirtualProperty = LvwVirtualPropertyChecked Then
        Value = ArrChecked(ItemIndex) 'reflect the bool-array-state into the (ListView-)Value
    End If
End Sub

Private Sub lvw_ItemCheck(ByVal Item As LvwListItem, ByVal Checked As Boolean)
  ArrChecked(Item.Index) = Checked 'capture potential inversions of the checked state in your external array
End Sub

Private Sub Form_Unload(Cancel As Integer)
  Dim i As Long 'read out only the checked Items from the external data-container-structures
  For i = LBound(ArrChecked) To UBound(ArrChecked)
     If ArrChecked(i) Then Debug.Print Rs.ValueMatrix(i - 1, 0), Rs.ValueMatrix(i - 1, 1), Rs.ValueMatrix(i - 1, 2)
  Next
End Sub

HTH

Olaf

[bahbahbah]

thank you again
If I want to uncheck the lvw items , I get error

Dim i As Long
    
    For i = 1 To lvw.ListItems.count
        If lvw.ListItems.Item(i).Checked = True Then lvw.ListItems.Item(i).Checked = False
        Next i

Yep, as Schmidt has said, use the external data and leave the listview alone. In our case we have the bListItemChecked array which you should loop through instead.

Dim i As Long
    
For i = lbound(bListItemChecked ) to ubound(bListItemChecked )
       bListItemChecked = False
Next i

Schmidt's code is much cleaner though - better to listen to him!

[Mustaphi]

Schmidt's code is much cleaner though - better to listen to him!

thank you bahbahbah
thank you Schmidt

Dim i As Long

For i = LBound(ArrChecked) To UBound(ArrChecked)
      If ArrChecked(i) = True Then ArrChecked(i) = False

Next i

This code does not seem to work
sorry for disturbing you

[Schmidt]

Dim i As Long

For i = LBound(ArrChecked) To UBound(ArrChecked)
      If ArrChecked(i) = True Then ArrChecked(i) = False

Next i

This code does not seem to work
sorry for disturbing you

What purpose shall this code have in the end?
It seems you want to reset all previously checked Arr-Members to False?

This can be achieved faster via a single line of code:
Redim ArrChecked(1 To Rs.RecordCount) 're-allocate and initialize all ArrMembers to False

FWIW, when you change the external Data directly (without knowledge of the ListView) -
you'll have to tell the ListView to refresh its GUI-related renderings, e.g. a simple:
lvw.Refresh 'tell the ListView, to re-render the externally changed contents
... afterwards should suffice ...

HTH

Olaf

[Mustaphi]

Redim ArrChecked(1 To Rs.RecordCount)

it worked
A last worry
what if I want to have only one row checked.

Dim count, idx As Integer
    Dim bln As Boolean

    bln = lvw.ListItems(Item.Index).Checked

    count = 0
    For idx = 1 To lvw.ListItems.count
        If lvw.ListItems(idx).Checked Then
            lvw.ListItems(idx).Checked = False
            

        End If
    Next
lvw.ListItems(Item.Index).Checked = bln

thank you again

[Schmidt]

...what if I want to have only one row checked.

Then I would throw out all the CheckBox-related stuff and Events -
and switch to "FullRowSelect = True"...
(which automatically takes care about only a single selection in the ListView).

Tracking a selection-change (the current "Lookup-index" for your Rs) is relatively simple via:

Private Sub lvw_ItemSelect(ByVal Item As LvwListItem, ByVal Selected As Boolean)
  If Selected Then Caption = "selected index: " & Item.Index Else Caption = "no selection"
End Sub

And setting "no selection at all" on the ListView can be done from anywhere on the Form via:

  lvw.SelectedItem.Selected = False
  lvw.Refresh

E.g. shortly after "binding the Rs" to it in the "Init-phase", to start with a "clean slate"...

Olaf

[Mustaphi]

Schmidt thank you very much but sorry to tell you that I couldn't reach what I need.
I want to have one row checked in the listview.
This is what I was doing in normal mode

Dim count, idx As Integer
    Dim bln As Boolean

    bln = lvw.ListItems(Item.Index).Checked

    count = 0
    For idx = 1 To lvw.ListItems.count
        If lvw.ListItems(idx).Checked Then
            lvw.ListItems(idx).Checked = False
            

        End If
    Next

I tried to modify your code to get what I wish but I get error

Private Sub lvw_ItemSelect(ByVal Item As LvwListItem, ByVal Selected As Boolean)
  If Selected Then Item.Checked = True Else Item.Checked = False
End Sub

thank you

[Schmidt]

I want to have one row checked in the listview.

If you only want to have a single entry "checked or selected" in your LV -
then you do not need a whole Array for the state of the checkboxes.

The example below has the ListView in virtual mode with:
- CheckBoxes = True
- FullRowSelect = True

Option Explicit

Private Rs As cRecordset, SelIndex As Long
 
Private Sub Form_Load()
  With New_c.MemDB
      .Exec "Create Table T(name Text, pos Text, qtite int)"
      Dim i As Long
      For i = 1 To 20000
        .ExecCmd "Insert Into T Values(?,?,?)", "Name " & i, i & " mg", i
      Next
      Set Rs = .GetRs("SELECT * From T")
  End With
  
  New_c.Timing True 'time the setup and filling of the Grid (after Rs-creation)
      lvw.ColumnHeaders.Add , , "medicament", lvw.Width * 0.3, LvwColumnHeaderAlignmentLeft
      lvw.ColumnHeaders.Add , , "posologie", lvw.Width * 0.4, LvwColumnHeaderAlignmentLeft
      lvw.ColumnHeaders.Add , , "quantite", lvw.Width * 0.2, LvwColumnHeaderAlignmentLeft
      
      lvw.VirtualItemCount = Rs.RecordCount
  Caption = New_c.Timing
End Sub

Private Sub lvw_GetVirtualItem(ByVal ItemIndex As Long, ByVal SubItemIndex As Long, ByVal VirtualProperty As LvwVirtualPropertyConstants, Value As Variant)
    If VirtualProperty = LvwVirtualPropertyText Then
        Value = Rs.ValueMatrix(ItemIndex - 1, SubItemIndex)
    ElseIf VirtualProperty = LvwVirtualPropertyChecked Then
        Value = CBool(SelIndex = ItemIndex) 'reflect the select-state in the value
    End If
End Sub

Private Sub lvw_ItemSelect(ByVal Item As LvwListItem, ByVal Selected As Boolean)
  If Selected Then SelIndex = Item.Index Else SelIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
  If SelIndex Then Debug.Print Rs.ValueMatrix(SelIndex - 1, 0), Rs.ValueMatrix(SelIndex - 1, 1), Rs.ValueMatrix(SelIndex - 1, 2)
End Sub

Olaf

[Mustaphi]

Schmidt
Tons of thanks

[Mustaphi]

Excuse me Schmidt
When I want to empty the listview I use

lvw.VirtualItemCount = 0

Am I correct?
thank you

[Schmidt]

Excuse me Schmidt
When I want to empty the listview I use

lvw.VirtualItemCount = 0

Am I correct?

Yes, you are telling the lvw that you have no external Data-records anymore -
and it should react accordingly by reflecting this info in its render-output.

Olaf

[Mustaphi]

Yes, you are telling the lvw that you have no external Data-records anymore -
and it should react accordingly by reflecting this info in its render-output.

Olaf

thank you sir

[Mustaphi]

Olaf please excuse me again
Is it possible to check the listview item directly without having to select the first item ?
in normal mode I usually check or uncheck the item by clicking directly the small box.

Option Explicit

Private Rs As cRecordset, ArrChecked() As Boolean, SelIndex As Long
 
Private Sub Form_Load()
  With New_c.MemDB
      .Exec "Create Table T(name Text, pos Text, qtite int)"
      Dim i As Long
      For i = 1 To 20000
        .ExecCmd "Insert Into T Values(?,?,?)", "Name " & i, i & " mg", i
      Next
      Set Rs = .GetRs("SELECT * From T")
       ReDim ArrChecked(1 To Rs.RecordCount)
  End With
  
  New_c.Timing True 'time the setup and filling of the Grid (after Rs-creation)
      lvw.ColumnHeaders.Add , , "medicament", lvw.Width * 0.3, LvwColumnHeaderAlignmentLeft
      lvw.ColumnHeaders.Add , , "posologie", lvw.Width * 0.4, LvwColumnHeaderAlignmentLeft
      lvw.ColumnHeaders.Add , , "quantite", lvw.Width * 0.2, LvwColumnHeaderAlignmentLeft
      
      lvw.VirtualItemCount = Rs.RecordCount
  Caption = New_c.Timing
End Sub
Private Sub lvw_ItemCheck(ByVal Item As LvwListItem, ByVal Checked As Boolean)
'  ArrChecked(Item.Index) = Checked 'capture potential inversions of the checked state in your external array
End Sub
Private Sub lvw_GetVirtualItem(ByVal ItemIndex As Long, ByVal SubItemIndex As Long, ByVal VirtualProperty As LvwVirtualPropertyConstants, Value As Variant)
    If VirtualProperty = LvwVirtualPropertyText Then
        Value = Rs.ValueMatrix(ItemIndex - 1, SubItemIndex)
    ElseIf VirtualProperty = LvwVirtualPropertyChecked Then
        Value = CBool(SelIndex = ItemIndex) 'reflect the select-state in the value
    End If
End Sub

Private Sub lvw_ItemSelect(ByVal Item As LvwListItem, ByVal Selected As Boolean)
  If Selected Then SelIndex = Item.Index Else SelIndex = 0
End Sub

Private Sub Form_Unload(Cancel As Integer)
'  If SelIndex Then Debug.Print Rs.ValueMatrix(SelIndex - 1, 0), Rs.ValueMatrix(SelIndex - 1, 1), Rs.ValueMatrix(SelIndex - 1, 2)
End Sub