Duplikování obsahu ListBoxu

Postup:
Deklarujte v deklarační části formuláře:

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_RESETCONTENT = &H184 
Private Const LB_GETCOUNT = &H18B 
Private Const LB_GETTEXT = &H189 
Private Const LB_ADDSTRING = &H180 
Private Const LB_GETITEMDATA = &H199 
Private Const LB_SETITEMDATA = &H19A

Funkce pro duplikování obsahu jednoho ListBoxu do druhého:

Private Sub DuplicateListBox(Source As ListBox, Target As ListBox, _ 
   Optional AppendMode As Boolean) 

   'Pokud nezadáte AppendMode=True, pak bude obsah druhého ListBoxu nejprve vymazán
   Dim index As Long 
   Dim itmData As Long 
   Dim numItems As Long 
   Dim sItemText As String 

   sItemText = Space$(512) 
   LockWindowUpdate Target.hWnd 

   If Not AppendMode Then 
      SendMessage Target.hWnd, LB_RESETCONTENT, 0, ByVal 0& 
   End If 

   numItems = SendMessage(Source.hWnd, LB_GETCOUNT, 0&, ByVal 0&) 

   For index = 0 To numItems - 1 
      SendMessage Source.hWnd, LB_GETTEXT, index, ByVal sItemText 
      itmData = SendMessage(Source.hWnd, LB_GETITEMDATA, _
         index, ByVal 0&) 
      SendMessage Target.hWnd, LB_ADDSTRING, 0&, ByVal sItemText 
      SendMessage Target.hWnd, LB_SETITEMDATA, index, ByVal itmData 
   Next 

   LockWindowUpdate 0 

End Sub

Zpět