15 мая 2023 года "Исходники.РУ" отмечают своё 23-летие!
Поздравляем всех причастных и неравнодушных с этим событием!
И огромное спасибо всем, кто был и остаётся с нами все эти годы!

Главная Форум Журнал Wiki DRKB Discuz!ML Помощь проекту


Как перетаскивать элементы одного ListBox в другой

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

Private Sub Form_Load()
    ' Заполняем список
    List1.AddItem "James"
    List1.AddItem "Frederick"
    List1.AddItem "Ann"
    List1.AddItem "Paul"
    List1.AddItem "Sarah"
    List1.OLEDropMode = 1
    List2.OLEDropMode = 1
End Sub

' Код управления перетаскиванием
Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    List1.OLEDrag    ' Начало перетаскивания
End Sub
Private Sub List1_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
    ' Разрешить только перемещение
    AllowedEffects = vbDropEffectMove
    ' Наначаем выбор в ListBox на DataObject
    Data.SetData List1
End Sub
Private Sub List2_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim strList As String
    ' Проверяем формат DataObject
    If Not Data.GetFormat(vbCFText) Then Exit Sub
    ' Получаем текст из DataObject
    strList = Data.GetData(vbCFText)
    ' Если элемент не был перемещён сам на себя
    If Not strList = List2.Text Then
        List2.AddItem strList
        'Удаляем элемент из ListBox
        List1.RemoveItem List1.ListIndex
    End If
End Sub
''
''
'' Код управления перетаскиванием
''
''
Private Sub List2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    List2.OLEDrag    ' Начало перетаскивания
End Sub
Private Sub List2_OLEStartDrag(Data As DataObject, AllowedEffects As Long)
    ' Разрешить только перемещение
    AllowedEffects = vbDropEffectMove
    ' Наначаем выбор в ListBox на DataObject
    Data.SetData List2
End Sub
Private Sub List1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single)
    Dim strList As String
    ' Проверяем формат DataObject
    If Not Data.GetFormat(vbCFText) Then Exit Sub
    ' Получаем текст из DataObject
    strList = Data.GetData(vbCFText)
    ' Если элемент не был перемещён сам на себя
    If Not strList = List1.Text Then
        List1.AddItem strList
        'Удаляем элемент из ListBox
        List2.RemoveItem List2.ListIndex
    End If
End Sub