Duplikování obsahu ComboBoxu

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 CB_RESETCONTENT = &H14B 
Private Const CB_GETCOUNT = &H146 
Private Const CB_GETITEMDATA = &H150 
Private Const CB_SETITEMDATA = &H151 
Private Const CB_GETLBTEXT = &H148 
Private Const CB_ADDSTRING = &H143

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

Private Sub DuplicateComboBox(Source As ComboBox, Target As       ComboBox, _ Optional AppendMode As Boolean) 

   'Pokud nezadáte AppendMode=True, pak bude obsah druhého ComboBoxu 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, CB_RESETCONTENT, 0, ByVal 0& 
   End If 

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

   
For index = 0 To numItems - 1 
      SendMessage Source.hWnd, CB_GETLBTEXT, index, ByVal sItemText 
      itmData = SendMessage(Source.hWnd, CB_GETITEMDATA, _
         index, ByVal 0&) 
      SendMessage Target.hWnd, CB_ADDSTRING, 0&, ByVal sItemText 
      SendMessage Target.hWnd, CB_SETITEMDATA, index, ByVal itmData 
   Next 

   LockWindowUpdate 0 

End Sub

Zpět

Autor: The Bozena