Sección de códigos , trucos y ejemplos para visual basic

27 - Hacer un Drag Drop o arrastre de archivos

Contenido

Ejemplo actualizado
Drag de archivos con el Api
Drag&Drop de archivos sin el Api ( Usando los eventos y métodos de vb)
Comprobar al arrastrar que no se agreguen archivos repetidos o duplicados
Enlaces relacionados a Drag&Drop

Actualización

Ejemplo actualizado para poder arrastrar ficheros y directorios hacia nuestra aplicación utilizando un módulo de clase

El proyecto tiene un formulario que permite arrastrar los archivos hacia un ListBox. también tiene dos funciones para poder recuperar el ícono asociado mediante el Api ExtractAssociatedIcon, y la descripción del mismo usando la función Api SHGetFileInfo

Nota: El drag se puede realizar solo en controles que posean la propiedad Hwnd

Para usar el módulo se debe instanciar con WithEvents para poder usar el evento que se dispara cuando se están colocando archivos en el control.

Para obtener los elementos arrastrados se debe usar el evento DragFiles, que tiene como parámetro el Path, el Hwnd del objeto, y un parámetro opcional para saber el tipo : : Directorio, Archivo o Root Path

Para iniciar la operación de arrastre, ejecutar el método InitDrag, y para detener el método TerminateDrag, pasándole a las dos funciones los hwnd de los controles

Descargar

Drag de archivos

Ejemplo que muestra como podemos por ejemplo arrastrar archivos desde Windows hacia un ListBox, y que aparezcan las rutas de los mismos en el control.

Las funciones Api que se utilizan para realizar esto son: DragAcceptFiles, DragQueryFile, SetWindowLong y CallWindowProc

Formulario con las rutas al hacer el drag de los archivos y directorios

vista del formulario de ejemplo en vb para hacer un drag and drop de archivos hacia el control listbox

Ejemplo

Colocar un control ListBox llamado List1
luego arrastrar ficheros o carpetas al control

Código fuente en un módulo bas

' En un módulo BAS '''''''''''''''''''''''''''' Option Explicit '*************************************************************************** 'El formulario que va a recibir los archivos arrastrados desde el explorador 'debe registrarse en el sistema mediante una llamada a DragAcceptFiles 'y de esta menera poder habilitar el servicio de Drag 'Una vez registrado en el sistema, recibiremos el mensaje WM_DROPFILES cada 'vez que uno o varios archivos sean arrastrados desde el explorador de 'windows a nuestro formulario, por lo que debemos escribir el _ código necesario para su manejo '*************************************************************************** Public Declare Sub DragAcceptFiles Lib "shell32.dll" ( _ ByVal hWnd As Long, _ ByVal fAccept As Long) '*************************************************************************** 'La función DragQueryFile nos servirá para saber cuántos archivos están siendo 'arrastrados, el nombre de cada uno de ellos y el tamaño del buffer necesario 'para almacenar ese nombre '*************************************************************************** Private Declare Function DragQueryFile Lib "shell32.dll" Alias "DragQueryFileA" ( _ ByVal hDrop As Long, _ ByVal UINT As Long, _ ByVal lpStr As String, _ ByVal ch As Long) As Long Public Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" ( _ ByVal hWnd As Long, _ ByVal nIndex As Long, _ ByVal dwNewLong As Long) As Long Private Declare Function CallWindowProc Lib "user32" Alias "CallWindowProcA" ( _ ByVal lpPrevWndFunc As Long, _ ByVal hWnd As Long, _ ByVal Msg As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long 'Constantes y variables Public Const WM_DROPFILES = &H233 Public Const GWL_WNDPROC = -4 Public lProcOld As Long Public Function Drag_Drop_ListBox(ByVal hWnd As Long, _ ByVal Mensaje_Windows As Long, _ ByVal wParam As Long, _ ByVal lParam As Long) As Long Dim n_Archivos As Long Dim x As Long Dim Archivo As String * 128 If Mensaje_Windows = WM_DROPFILES Then 'Este bucle determina cuantos archivos se estàn arrastrando 'El -1 le indicamos que nos retorne todos los archivos que se arrastran n_Archivos = DragQueryFile(wParam, -1, Archivo, 127) 'Luego se hace un bucle For x = 1 To n_Archivos 'Esta llamada a DragQueryFile nos devuelve el nombre del archivo Call DragQueryFile(wParam, x - 1, Archivo, 127) 'Lo agregamos al List Form1.List1.AddItem (Archivo) Next x Exit Function End If Drag_Drop_ListBox = CallWindowProc(lProcOld, _ hWnd, Mensaje_Windows, _ wParam, lParam) End Function

Código fuente en un formulario

' En un formulario: '''''''''''''''''''''''''''' Option Explicit 'Colocar un ListBox y arrastrar archivos desde windows '**************************************************** Private Sub Form_Load() 'DragAcceptFiles permite registrar el drag de archivos, _ el segundo parametro lo habilita y False lo deshabilita Call DragAcceptFiles(hWnd, True) lProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf Drag_Drop_ListBox) End Sub Private Sub Form_Unload(Cancel As Integer) 'Lo deshabilitamos Call DragAcceptFiles(hWnd, False) Call SetWindowLong(hWnd, GWL_WNDPROC, lProcOld) End Sub

Hacer DragDrop sin el Api

Este ejemplo utiliza los eventos de vb, en este caso el evento Ole_DragDrop. El evento Ole_DragDrop posee un parámetro llamado Data. Este es un objeto que contiene, entre otros, una colección con los archivos que se están arrastrando. Entonces si ocurre el evento de Drag, se recorre mediante un bucle For Each Next, y se añaden a un control ListBox

Ejemplo

Colocar un control ListBox llamado List1
Pegar el siguiente código fuente en el formulario

Option Explicit ' ----------------------------------------------------------------------------- ' \\ -- Evento que Ocurre cuando los datos se colocan en un control mediante _ una operación arrastrar y colocar de OLE y además OLEDropMode _ está establecida como Manual. ' ----------------------------------------------------------------------------- Private Sub List1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) On Error GoTo error_handler With Data ' \\ -- Comprobar el formato de los datos If .GetFormat(vbCFFiles) Then ' \\ -- Si son los archivos, recorrerlos en la colección y agregar las rutas al control Dim xFile As Variant For Each xFile In .Files List1.AddItem xFile Next End If End With ' \\ -- Error Exit Sub error_handler: MsgBox Err.Description, vbCritical End Sub Private Sub Form_Load() MsgBox "Hacer Drag de archivos sobre el listbox", vbInformation ' \\ -- Configurar listbox With List1 .OLEDropMode = 1 End With End Sub Private Sub Form_Resize() List1.Move 10, 10, Me.ScaleWidth - 20, Me.ScaleHeight - 20 End Sub

Comprobar archivos repetidos o duplicados

Este ejemplo es idéntico al anterior, pero antes de añadirlos al control listbox, se agregan las rutas de los archivos a una colección. Como cada item tiene una clave, si se intenta añadir una clave que ya existe se producirá el error 457 "El item ya se encuentra asociado a un elemento de la colección" , en ese caso se ignora y no se añade para evitar los elementos repetidos.

Option Explicit Private colFiles As Collection Private Sub Form_Unload(Cancel As Integer) Set colFiles = Nothing End Sub ' ----------------------------------------------------------------------------- Private Sub List1_OLEDragDrop(Data As DataObject, Effect As Long, Button As Integer, Shift As Integer, X As Single, Y As Single) On Error GoTo error_handler With Data If .GetFormat(vbCFFiles) Then ' \\ -- Si son los archivos, recorrerlos _ en la colección y agrega la ruta y la clave Dim xFile As Variant For Each xFile In .Files colFiles.Add xFile, xFile Next ' \\ -- Agregar al list Dim i As Integer List1.Clear For i = 1 To colFiles.Count List1.AddItem colFiles.Item(i) Next End If End With ' \\ -- Errores Exit Sub error_handler: If Err.Number = 457 Then Resume Next ' Ignorar cuando se intenta añadir una ruta existente Else MsgBox Err.Description, vbCritical End If End Sub Private Sub Form_Load() MsgBox "Hacer Drag de archivos sobre el listbox", vbInformation ' \\ -- Configurar listbox With List1 .OLEDropMode = 1 End With Set colFiles = New Collection End Sub Private Sub Form_Resize() List1.Move 10, 10, Me.ScaleWidth - 20, Me.ScaleHeight - 20 End Sub

Recursos Visual basic - Enlaces relacionados:

Ejemplos varios relacionados con el Drag&Drop

Buscar en Recursos vb