Перетаскивание элементов 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
                        