Wednesday, November 23, 2011

Drag And Drop Pada Dua ListBox - VB6 Souce Code

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