 You
may encounter the need to quickly duplicate the contents of a listbox to another listbox, or to a combo box (or vice-versa). While
there is no non-looping method available the use of SendMessage can speed up the copying, especially in situations where a large amount of
data is to be duplicated.
This project contains two routines, one to copy from a list to a
second list, and one to copy from a list to a combo. Other permutations are easily obtained by modifying this code. |
Option Explicit
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Copyright ©1996-2011 VBnet/Randy Birch, All Rights Reserved.
' Some pages may also contain other copyrights by the author.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
' Distribution: You can freely use this code in your own
' applications, but you may not reproduce
' or publish this code on any web site,
' online service, or distribute as source
' on any media without express permission.
''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
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 Const LB_GETCOUNT = &H18B
Private Const LB_GETTEXT = &H189
Private Const LB_ADDSTRING = &H180
Sub Form_Load()
'add the system's screen fonts to List1.
Dim i As Long
Dim max As Long
max = Screen.FontCount
For i = 0 To max -1
List1.AddItem Screen.Fonts(i)
Next
End Sub
Private Sub Command1_Click()
Dim success As Long
success = CopyListToList(List1, List2)
Label1.Caption = CStr(success) & " items copied."
End Sub
Private Sub Command2_Click()
Dim success As Long
success = CopyListToCombo(List1, Combo1)
Label1.Caption = CStr(success) & " items copied."
If success Then Combo1.ListIndex = 0
End Sub
Private Sub Command3_Click()
Unload Me
End Sub
Private Function CopyListToList(source As ListBox, target As ListBox) As Long
Dim c As Long
'get the number of items in the list
Dim numitems As Long
Dim sItemText As String * 255
'get the number of items in the source list
numitems = SendMessage(source.hWnd, LB_GETCOUNT, 0&, ByVal 0&)
'if it has contents, copy the items
If numitems > 0 Then
For c = 0 To numitems - 1
Call SendMessage(source.hWnd, LB_GETTEXT, c, ByVal sItemText)
Call SendMessage(target.hWnd, LB_ADDSTRING, 0&, ByVal sItemText)
Next
End If
'get the number of items in the target list
'and return that as the function value
CopyListToList = SendMessage(target.hWnd, LB_GETCOUNT, 0&, ByVal 0&)
End Function
Private Function CopyListToCombo(source As ListBox, target As ComboBox) As Long
Dim c As Long
Const LB_GETCOUNT = &H18B
Const LB_GETTEXT = &H189
Const CB_GETCOUNT = &H146
Const CB_ADDSTRING = &H143
'get the number of items in the list
Dim numitems As Long
Dim sItemText As String * 255
'get the number of items in the source list
numitems = SendMessage(source.hWnd, LB_GETCOUNT, 0&, ByVal 0&)
'if it has contents, copy the items
If numitems > 0 Then
For c = 0 To numitems - 1
Call SendMessage(source.hWnd, LB_GETTEXT, c, ByVal sItemText)
Call SendMessage(target.hWnd, CB_ADDSTRING, 0&, ByVal sItemText)
Next
End If
'get the number of items in the target combo
'and return that as the function value
CopyListToCombo = SendMessage(target.hWnd, CB_GETCOUNT, 0&, ByVal 0&)
End Function |
| Run the project, and and press the buttons. The font data
will be copied. To test the performance of this method, try adding 32000 items to List1, then compare the SendMessage method against
the List.ListCount, List.Additem method.
To copy over any ItemData from List1 to the other controls, just add
the necessary LB_ or CB_ ITEMDATA constants and retrieve to ItemData and reassign in separate calls. ItemData is a Long, so
the
SendMessage call will also pass lParam (now containing the ItemData
value) as ByVal. |
