API-переброс данных из массива в элемент ListBox

'Как вы знаете, у элементов ListBox или ComboBox существует метод AddItem,
'который просто-напросто добавляет в выбранный контрол некие значения,
'определяемые пользователем. Но с использованием API функций можно
'ускорить процесс занесения данных в указанные выше элементы.
'В данном примере вам понадобятся 4 элемента CommandButton, а также
'элемент ListBox (или ComboBox). При нажатии на кнопку 3, вы получите
'время загрузки 1000 элементов в ЛистБокс с использованием метода AddItem, при
'нажатии на кнопку 4 - при использовании API-функций. Заметили разницу?
'Ну а первые две кнопки всего лишь показывают работу функции ArrayToListBox.

'Что еще может функция ArrayToListBox? Как вы видите, в параметрах функции 5
'элементов. Два обязательных (контрол и массив данных), третий параметр при
'значении True очищает список элементов, а четвертый и пятый параметры всего
'лишь определяют, с какого элемента из массива данных (по порядковому номеру)
'начинать заносить в элемент ListBox и каким элементом (по порядковому номеру)
'заканчивать.

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" (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
Private Declare Function GetTickCount Lib "kernel32" () As Long

Dim adr()

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
' none of the above, exit
Exit Sub
End If

If IsMissing(First) Then First = LBound(arr)
If IsMissing(Last) Then Last = UBound(arr)

' disable redrawing
hWnd = ctrl.hWnd
LockWindowUpdate hWnd
' clear control If requested
If clearIt Then
SendMessage hWnd, msgReSet, 0, 0
End If

' add all items in the array
For index = First To Last
SendMessage hWnd, msgAdd, 0, ByVal CStr(arr(index))
Next

' re-enable redrawing
LockWindowUpdate 0
End Sub

Private Sub Command1_Click()
Call ArrayToListBox(List1, adr, False, 2, 9)
End Sub

Private Sub Command2_Click()
Call ArrayToListBox(List1, adr, True, 11, 18)
End Sub

Private Sub Command3_Click()
t1 = GetTickCount
List1.Clear

For i = 1 To 1000
List1.AddItem adr(i)
Next

t2 = GetTickCount
MsgBox t2 - t1
End Sub

Private Sub Command4_Click()
t1 = GetTickCount
Call ArrayToListBox(List1, adr, True)
t2 = GetTickCount
MsgBox t2 - t1
End Sub

Private Sub Form_Load()
ReDim adr(1000)

For i = 1 To 1000
adr(i) = str(i)
Next i

List1.AddItem "--"
List1.AddItem "--"
List1.AddItem "--"
End Sub

Обсудить статью на форуме

Если Вас заинтересовала или понравилась информация программирование на Visual Basic - "API-переброс данных из массива в элемент ListBox", Вы можете поставить закладку в социальной сети или в своём блоге на данную страницу:

Так же Вы можете задать вопрос по работе этого модуля или примера через форму обратной связи, в сообщение обязательно указывайте название или ссылку на статью!