Chuyển từ mảng vào listbox

Liên hệ QC

challenge98

Thành viên chính thức
Tham gia
21/6/09
Bài viết
90
Được thích
5
Mình tìm được đoạn code sau nói về chuyển array vào listbox nhưng chưa sử dụng được vì chưa hiểu hết thấy bảo nó nhanh hơn là dùng additem, mình đình dùng thử hàm này nhưng không thấy chạy gì cả ai hiểu thì cùng chia sẻ nhé thanks!


Mã:
[COLOR=#ff6600][FONT=Arial][B]ArrayToListbox - Add an array of strings to a ListBox or ComboBox[/B][/FONT][/COLOR]
 [COLOR=DarkBlue]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 LockWindowUpdate Lib "user32" Alias "LockWindowUpdate" _
    (ByVal hwndLock As Long) As Long

Private Const LB_ADDSTRING = &H180
Private Const LB_RESETCONTENT = &H184
Private Const CB_ADDSTRING = &H143
Private Const CB_RESETCONTENT = &H14B

[COLOR=Green]' Add an array of string to a listbox or combo box[/COLOR]
[COLOR=Green]' using API functions, and optionally clearing it first[/COLOR]
[COLOR=Green]' This procedure is faster than the one based on AddItem methods,[/COLOR]
[COLOR=Green]' especially with ComboBox controls, and reduces flickering[/COLOR]
[COLOR=Green]'[/COLOR]
[COLOR=Green]' FIRST and LAST indicate which portion of the array[/COLOR]
[COLOR=Green]' should be considered; they default to the first[/COLOR]
[COLOR=Green]' and last element, respectively[/COLOR]

Sub ArrayToListBox(ctrl As Object, arr As Variant, Optional clearIt As Boolean, _
    Optional ByVal First As Variant, Optional ByVal Last As Variant)
    Dim msgReset As Long
    Dim msgAdd As Long
    Dim hWnd As Long
    Dim index As Long
    
    If TypeOf ctrl Is ListBox Then
        msgReset = LB_RESETCONTENT
        msgAdd = LB_ADDSTRING
    ElseIf TypeOf ctrl Is ComboBox Then
        msgReset = CB_RESETCONTENT
        msgAdd = CB_ADDSTRING
    Else
        [COLOR=Green]' none of the above, exit[/COLOR]
        Exit Sub
    End If
    
    If IsMissing(First) Then First = LBound(arr)
    If IsMissing(Last) Then Last = UBound(arr)
    
    [COLOR=Green]' disable redrawing[/COLOR]
    hWnd = ctrl.hWnd
    LockWindowUpdate hWnd
    
    [COLOR=Green]' clear control if requested[/COLOR]
    If clearIt Then
        SendMessage hWnd, msgReset, 0, 0
    End If
    
    [COLOR=Green]' add all items in the array[/COLOR]
    For index = First To Last
        SendMessage hWnd, msgAdd, 0, ByVal CStr(arr(index))
    Next
    [COLOR=Green]' re-enable redrawing[/COLOR]
    LockWindowUpdate 0
End Sub
[/COLOR]
 
Cái này dùng API nên chắc phải nhanh hơn dùng vòng lặp thông thường copy từng dữ liệu.
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom