Terkadang dalam memprogram kita membutuhkan operasi drag and drop antara dua object ListBox, contohnya untuk pembuatan wizard dan lain sebagainya. Di bawah ini merupakan contoh source codenya. Dibuat oleh Luciano Esteban Lodola pemilik situs: http://www.recursosvisualbasic.com.ar
Option Explicit ' --------------------------------------------------------------------------------------- ' \ -- Autor : Luciano Lodola -- http://www.recursosvisualbasic.com.ar ' --------------------------------------------------------------------------------------- ' \ -- funciNn de windows para poder obtener un elemento (Indice) de un control de lista a partir de la psiciNn del mouse Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Integer, ByVal lParam As Any) As Long ' -- Constante / mensaje para recupera el Item a partir de la posiciNn del mouse ( con SendMessage ) Private Const LB_ITEMFROMPOINT = &H1A9 Public iX As Integer ' -------------------------------------------------------------------------------------- '\ -- Inicio ' -------------------------------------------------------------------------------------- Private Sub Form_Load() Dim i As Byte ' -- Agregar elementos de muestra para el ejemplo With List1 .AddItem "Impresora Epson" .AddItem "Impresora Lexmark" .AddItem "Monitor LG" .AddItem "Monitor Samsung" .AddItem "PC Pentium Dual Core" .AddItem "PC Pentium Core Duo" .AddItem "Impresora lDser HP - MonocromDtica" .AddItem "Impresora lDser Epson - MonocromDtica" .AddItem "Impresora lDser color" End With ' -- Importante !!!! Habilitar el Drag con el método OLEDragMode, y el Drop para el List2 List1.OLEDragMode = 1 List2.OLEDropMode = 1 End Sub ' -------------------------------------------------------------------------------------- '\ -- FunciNn que retorna el Jndice del Item del List2 ( Donde se encuentra el mouse ) ' -------------------------------------------------------------------------------------- Private Function pvGetItemFromPoint(X As Single, Y As Single, lBox As ListBox) As Long Dim indice As Long Dim XPoint As Long Dim YPoint As Long Dim ZPoint As Long ' -- Valor por defecto de retorno de la funciNn ( NingRn item estD seleccionado) indice = -1 XPoint = CLng(X / Screen.TwipsPerPixelX) YPoint = CLng(Y / Screen.TwipsPerPixelY) ZPoint = CLng(YPoint * &H10000 + XPoint) With lBox ' -- Recupera el item seleccionado (el Jndice ) indice = SendMessage(.hwnd, LB_ITEMFROMPOINT, 0, ByVal ZPoint) If indice >= 0 And indice <= .ListCount Then pvGetItemFromPoint = indice End If End With End Function ' -------------------------------------------------------------------------------------- '\ -- Iniciar Drag del item ' -------------------------------------------------------------------------------------- Private Sub List1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single) iX = X List1.OLEDrag End Sub ' -------------------------------------------------------------------------------------- '\ -- evento que se produce al soltar el item ' -------------------------------------------------------------------------------------- Private Sub List2_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) Dim lIndex As Long ' -- Obtener el Jndice pasando a la funciNn lIndex = pvGetItemFromPoint(X, Y, List2) ' -- Agregar con el método Additem en la posiciNn indicada por el Jndice If lIndex >= 0 Then List2.AddItem Data.GetData(1), lIndex Else List2.AddItem Data.GetData(1) End If ' -- seleccionar el dato If lIndex <> -1 Then List2.Selected(lIndex) = True ' -- Opcional - eliminar el elemento del List List1.RemoveItem (List1.ListIndex) End Sub
