Перетаскивание элементов ListBox - VB
Формулировка задачи:
На форме находятся 2 ListBox.Должна быть возможность поочерёдного перемещения элементов из одного списка в другой.Перетаскивание осуществляентся мышью.
Решение задачи: «Перетаскивание элементов ListBox»
textual
Листинг программы
- 'В данном примере показано, как разрешить пользователю перетаскивать элементы между двумя листбоксами. Добавьте два листбокса на форму и вставьте следующий код.
- 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
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д