Phiên bản mới đây. Tốc độ nhanh hơn bản cũ. Khắc phục tốc độ bị chậm khi dùng Shift để chọn nhiều item.
[GPECODE=vb]
Option Explicit
''''''''''''''
'
Set check sate with selected items in ListView
' By Nguyen Duy Tuan (duytuan@bluesofs.net)
www.giaiphapexcel.com
''''''''''''''
Private IdxOfFirst As Long, IdxOfSecond As Long
Private IsShiftKeyPressed As Boolean, IsCtrlKeyPressed As Boolean
Private MustClearAll As Boolean, IsClickCheck As Boolean
Dim CurrentItem As MSComctlLib.ListItem
Private Sub UserForm_Initialize()
Dim I As Long
With ListView1
.MultiSelect = True 'Cho phep chon nhieu item va chay CheckItemsWithSelectState trong ListView1_ItemClick
.ColumnHeaders.Add , , "VALUE", .Width - 4
.CheckBoxes = True
For I = 1 To 10000
.ListItems.Add , , "Item" & I
Next
IdxOfFirst = .SelectedItem.Index
IdxOfSecond = IdxOfFirst
End With
End Sub
Private Sub ListView1_ColumnClick(ByVal ColumnHeader As MSComctlLib.ColumnHeader)
ColumnHeader.Tag = Not CBool(IIf(ColumnHeader.Tag = "", 0, ColumnHeader.Tag))
CheckItems CBool(ColumnHeader.Tag), Nothing, True
MustClearAll = CBool(ColumnHeader.Tag)
End Sub
Private Sub ListView1_ItemClick(ByVal Item As MSComctlLib.ListItem)
Set CurrentItem = Item
End Sub
Private Sub ListView1_ItemCheck(ByVal Item As MSComctlLib.ListItem)
'when mouse click on item to set check state
MustClearAll = True
IsClickCheck = True
Item.Selected = Item.Checked
End Sub
Private Sub ListView1_MouseUp(ByVal Button As Integer, ByVal Shift As Integer, ByVal x As stdole.OLE_XPOS_PIXELS, ByVal y As stdole.OLE_YPOS_PIXELS)
If IsClickCheck Then
IsClickCheck = False
Exit Sub
End If
If Not CurrentItem Is Nothing Then
If ListView1.MultiSelect Then
CheckItemsWithSelectState CurrentItem
End If
End If
End Sub
Private Function CheckItems(ByVal bCheck As Boolean, ByVal Item As ListItem, ByVal bSelectIfChecked As Boolean) As Long
Dim I As Long, IdxCurrent As Long
If Not Item Is Nothing Then
IdxCurrent = Item.Index
End If
Dim ItemVisible As MSComctlLib.ListItem
Set ItemVisible = ListView1.GetFirstVisible
For I = ItemVisible.Index To ListView1.ListItems.Count
CheckItems = CheckItems + 1
If IdxCurrent <> I Then 'don't set state for current index
If ListView1.ListItems(I).Checked <> bCheck Then
ListView1.ListItems(I).Checked = bCheck
End If
If bSelectIfChecked Then
ListView1.ListItems(I).Selected = bCheck
End If
End If
DoEvents
Next I
For I = ItemVisible.Index To 1 Step -1
CheckItems = CheckItems + 1
If IdxCurrent <> I Then 'don't set state for current index
If ListView1.ListItems(I).Checked <> bCheck Then
ListView1.ListItems(I).Checked = bCheck
End If
If bSelectIfChecked Then
ListView1.ListItems(I).Selected = bCheck
End If
End If
DoEvents
Next I
End Function
Private Function CheckItemsWithSelectState(ByVal Item As ListItem) As Long
Dim I As Long
IsShiftKeyPressed = IsShiftKeyDown()
IsCtrlKeyPressed = IsControlKeyDown()
If IsCtrlKeyPressed Then
Item.Checked = Item.Selected
MustClearAll = True
Exit Function
End If
'If no shift, no ctrl press then check to clear check state for all items
If Not (IsShiftKeyPressed Or IsCtrlKeyPressed) Then
If MustClearAll Then
MustClearAll = False
Item.Checked = Item.Selected
CheckItems False, Item, False
End If
End If
'Clear old seleted items
For I = IdxOfFirst To IdxOfSecond
If I <> Item.Index Then
ListView1.ListItems(I).Checked = False
End If
Next I
' find IdxOfFirst from current index
For I = Item.Index To 1 Step -1
If Not ListView1.ListItems(I).Selected Then
Exit For
End If
IdxOfFirst = I
Next I
' find IdxOfSecond from current index
For I = Item.Index To ListView1.ListItems.Count
If Not ListView1.ListItems(I).Selected Then
Exit For
End If
IdxOfSecond = I
Next I
'Set check state for new selected items
Dim ItemVisible As MSComctlLib.ListItem
Set ItemVisible = ListView1.GetFirstVisible
For I = ItemVisible.Index To IdxOfSecond
ListView1.ListItems(I).Checked = ListView1.ListItems(I).Selected
DoEvents
Next I
For I = ItemVisible.Index To IdxOfFirst Step -1
ListView1.ListItems(I).Checked = ListView1.ListItems(I).Selected
DoEvents
Next I
End Function
[/GPECODE]
, không được mịn và chạy chậm. Cứ test với 10 000 items.
.
