Tuesday, November 22, 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