如何在VB中利用listview快速显示10000以上的记录
listview显示起来美观，可就是速度不行
比如下面的方式
For i = 0 To 10000
ListView1.ListItems.Add ListView1.ListItems.Count + 1, , ListView1.ListItems.Count + 1
ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(1) = ("你好啊")
ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(2) = ("你好啊")
ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(3) = ("你好啊")
Next i
用逐个添加速度很慢，看到一个avafind软件，几万行的数据显示出来只要零点几秒
请问各位高手如何在VB中实现listview的快速显示呢？只要没有停顿感就好。
如果能解决，可再加100分
[解决办法]
其实很简单，有种virtual模式就可以的啊，你可搜下相应的资料：）
[解决办法]
先禁止列表重绘，再添加数据
自己添加 LockWindowUpdate api，然后这样：
LockWindowUpdate hWndListView
for xxx。。。
给列表添加数据
next
LockWindowUpdate 0&
[解决办法]
LockWindowUpdate禁止LV控件重绘，然后开一个循环，不要加DoEvents，就直接添加全部数据，这样速度有显著提升。
[解决办法]
换个思路，这么多记录，就用分页啊。
[解决办法]
' 避免显示区域的闪动现象。
Call ValidateRect(cLvwMer.hwnd, rc)
DoEvents
p = p + 1
If p Mod 1000 = 0 Then
Call InvalidateRect(cLvwMer.hwnd, rc, True)
cLvwMer.Refresh
Call ValidateRect(cLvwMer.hwnd, rc)
End If
这样可以每1000行显示一次，2，3万行数据也就10来秒钟，基本没有停顿感
[解决办法]
在显示开始前，还要加这句
'获 得listview的显示区域。
Call GetClientRect(cLvwMer.hwnd, rc)
rc的定义
Public Type RECT '用来定义一个区域的坐标
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
[解决办法]
'本程序经过VB6测试，完美实现LISTVIEW动态增加记录的功能。
'Form1 Code
Option Explicit
Private Sub Form_Load()
Dim Index As Long
ListView1.ColumnHeaders.Add , , "Column 1"
ListView1.LabelEdit = lvwManual
ListView1.View = lvwReport
ListView2.ColumnHeaders.Add , , "Column 1"
ListView2.LabelEdit = lvwManual
ListView2.View = lvwReport
For Index = 1 To 1000
ListView1.ListItems.Add , , "Item " & CStr(Index)
' ListView2.ListItems.Add , , "Item " & CStr(Index)
Next
ListViewSubClass ListView1.hwnd '子类化
'ListViewSubClass ListView2.hwnd
End Sub
Public Sub Add1000() '滚动条移动一次增加1000条记录
Dim Index As Long
Dim I As Long
I = ListView1.ListItems.Count
If I < 30000 Then 'ListView1中当记录小于30000条时增加记录
For Index = I + 1 To I + 1000
ListView1.ListItems.Add , , "Item " & CStr(Index)
'ListView2.ListItems.Add , , "Item " & CStr(Index)
Next
End If
End Sub
'Module1 Code
Option Explicit
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias "GetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Private lpfnOldWinProcLV As Long 'old WindowProc address for ListView
Private Const GWL_WNDPROC As Long = (-4)
Private Const WM_VSCROLL As Long = &H115
Private Const WM_DESTROY As Long = &H2
Private Const SB_THUMBPOSITION As Long = 4
Private Const SB_THUMBTRACK As Long = 5
Private Const LVM_FIRST As Long = &H1000
Private Const LVM_SCROLL As Long = (LVM_FIRST + 20)
Public Function ListViewSubClass(hwnd As Long) As Boolean
'This function enables subclassing
ListViewSubClass = True
'Get the address for the previous window procedure
lpfnOldWinProcLV = GetWindowLong(hwnd, GWL_WNDPROC)
If lpfnOldWinProcLV = 0 Then
ListViewSubClass = False
Exit Function
End If
'The return value of SetWindowLong is the address of the previous procedure,
'so if it's not what we just got above, something went wrong.
If SetWindowLong(hwnd, GWL_WNDPROC, AddressOf ListViewWndProc) <> lpfnOldWinProcLV Then
ListViewSubClass = False
End If
End Function
Public Function ListViewUnSubClass(hwnd As Long) As Boolean
'Restore default window procedure
If SetWindowLong(hwnd, GWL_WNDPROC, lpfnOldWinProcLV) = 0 Then
ListViewUnSubClass = False
Else
ListViewUnSubClass = True
lpfnOldWinProcLV = 0
End If
End Function
Private Function ListViewWndProc(ByVal hwnd As Long, ByVal uMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Static bIgnore As Boolean
ListViewWndProc = CallWindowProc(lpfnOldWinProcLV, hwnd, uMsg, wParam, lParam)
If bIgnore Then
Exit Function
End If
'Determine the message that was received
Select Case uMsg
Case WM_VSCROLL '滚动条事件
'Debug.Print "1"
Call Form1.Add1000 '增加记录
Case WM_DESTROY
Call CallWindowProc(lpfnOldWinProcLV, hwnd, uMsg, wParam, lParam)
Call ListViewUnSubClass(hwnd)
ListViewWndProc = CallWindowProc(lpfnOldWinProcLV, hwnd, uMsg, wParam, lParam)
End Select
End Function
Public Function LoWord(num As Long) As Integer
LoWord = num Mod &H10000
End Function
Public Function HiWord(num As Long) As Integer
HiWord = (num And &HFFFF0000) / &H10000
End Function
[解决办法]
'分成两次加载
sub form_load
dim i as long
LockWindowUpdate listview1.hwnd
For i = 0 To 100
ListView1.ListItems.Add ListView1.ListItems.Count + 1, ,ListView1.ListItems.Count + 1
ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(1) = ("你好啊")
ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(2) = ("你好啊")
ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(3) = ("你好啊")
Next i
me.show
for i=101 to 10000
...
doevents
next
end sub
[解决办法]
窗体上放timer控件数组，下标0~9，我本地测试，显示效果为加载50000条数据约1秒，基本达到要求。实际上完全加载完约5秒，不过是分时加载，客户基本感觉不到
Private Sub Form_Load()
Dim Index As Long, i As Long
For i = 0 To 9
Timer1(i).Interval = 10
Timer1(i).Enabled = True
Next
End Sub
Private Sub Timer1_Timer(Index As Integer)
Dim i As Long
Static num As Long
Timer1(Index).Enabled = False
For i = num To num + 4999
ListView1.ListItems.Add ListView1.ListItems.Count + 1, , ListView1.ListItems.Count + 1
ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(1) = ("你好啊")
ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(2) = ("你好啊")
ListView1.ListItems.Item(ListView1.ListItems.Count).SubItems(3) = ("你好啊")
Next i
num = i
DoEvents
End Sub
