Ejemplos usando el Api de windows para Visual basic

131 - Drag Drop de archivos hacia un ListView

Volver al Listado Api - Anterior - Siguiente

Contenido

Ejemplo 1
Ejemplo 2
Ejemplos relacionados

Ejemplo 1

Muestra de como hacer un Drag and drop de archivos a un control ListView, y visualizar las rutas incluyendo los íconos de los ficheros

Este ejemplo utiliza las siguientes funciones del Api de windows: ImageList_Draw y SHGetFileInfo.

El mismo muestra como poder hacer en un control Listview, que tiene la propiedad OLEDropMode activada, para hacer un Drag and Drop de archivos desde el explorador y también ver a parte de la ruta , los íconos como muestra la imagen:

vista del control Listview con algunos archivos

El funcionamiento es resumidamente asi:

Al arrastrar los archivos al ListView, se ejecuta el evento OLEDragDrop del ListView.

Dentro del evento, se recorre en un bucle la colección Data.Files, que tiene la lista de archivos, es decir tiene los paths. En cada iteración del bucle, se llama a otra Rutina que se encarga de recuperar el ícono asociado, pasandole el path. El ícono se dibuja mediante el api ImageList_Draw en un control Picturebox, y luego se pasa la imagen del icono dibujada en el picture a un ImageList, que se asocia luego al control ListView en tiempo de ejecución

Controles

Colocar un control ListView llamado ListView1 y un control ImageList llamado ImageList1.

Nota: el ejemplo está hecho para visualizar solo en vista de Iconos, por eso si cambiamos la propiedad View del Listview a otra vista diferente, el ícono no se verá, solo se visualizará la ruta

Código fuente en el formulario

Option Explicit ' Declaración de constantes Private Const SHGFI_DISPLAYNAME = &H200 Private Const SHGFI_EXETYPE = &H2000 Private Const SHGFI_SYSICONINDEX = &H4000 Private Const SHGFI_SHELLICONSIZE = &H4 Private Const SHGFI_TYPENAME = &H400 Private Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME Or _ SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX Or _ SHGFI_DISPLAYNAME Or SHGFI_EXETYPE ' UDT para usar con el Api SHGetFileInfo Private Type SHFILEINFO hIcon As Long iIcon As Long dwAttributes As Long szDisplayName As String * 260 szTypeName As String * 80 End Type ' Funciones Api 'Dibuja el ícono en un HDC, en este caso en un PictureBox _ para luego cargarlo en un control ImageList Private Declare Function ImageList_Draw Lib "comctl32.dll" _ (ByVal himl As Long, _ ByVal i As Long, _ ByVal hDCDest As Long, _ ByVal x As Long, _ ByVal y As Long, _ ByVal flags As Long) As Long ' SHGetFileInfo Para recuperar información sobre los iconos de los archivos _ a arrastrar en el ListView Private Declare Function SHGetFileInfo Lib "shell32.dll" _ Alias "SHGetFileInfoA" _ (ByVal pszPath As String, _ ByVal dwFileAttributes As Long, _ psfi As SHFILEINFO, _ ByVal cbSizeFileInfo As Long, _ ByVal uFlags As Long) As Long 'Variable de tipo PictureBox para crearlo en tiempo de ejecución. _ que tendrá el ícono que se agregará al ImageList Private Pic As PictureBox Private Sub Form_Load() ' Crea un PictureBox en tiempo de ejecución Set Pic = Me.Controls.Add("Vb.PictureBox", "Pic1") ' Habilita el Drop en el ListView ListView1.OLEDropMode = rtfOLEDropManual ListView1.View = lvwIcon 'Propiedad del picturebox With Pic .AutoSize = True .AutoRedraw = True .Height = 495 .Width = 495 .Appearance = 0 End With Me.Caption = " Ejemplo de Drag de archivos en un ListView" End Sub 'Recibe al soltar en el ListView los archivos Private Sub ListView1_OLEDragDrop(Data As MSComctlLib.DataObject, _ Effect As Long, Button As Integer, _ Shift As Integer, x As Single, y As Single) On Local Error GoTo ErrSub Dim i As Integer 'Recorre uno por uno los archivos, y la función Insertar_Icono_Listview _ se encarga de agregar el icono en el imagelist para luego enlazarlo al LV For i = 1 To Data.Files.Count Insertar_Icono_Listview Data.Files(i) Next Exit Sub 'Error ErrSub: If Err.Number = 461 Then Resume Next End If End Sub 'funcíón que inserta el ícono en el al item Private Sub Insertar_Icono_Listview(path As String) On Local Error GoTo ErrSub Dim h_Icono As Long, name_Archivo As String Dim clave_Icono As String, ret As Long, shi As SHFILEINFO h_Icono = SHGetFileInfo(path, _ 0&, _ shi, _ Len(shi), _ BASIC_SHGFI_FLAGS Or &H0) ' Remueve los carcteres nulos del path name_Archivo = Replace(shi.szTypeName, vbNullChar, vbNullString) If h_Icono > 0 Then ret = Dibujar_Icono_En_Picture(h_Icono, shi) ImageList1.ListImages.Add , path, Pic.Picture clave_Icono = path Else MsgBox "" End If ' Enlaza el control ListView al ImageList If ListView1.Icons Is Nothing Then Set ListView1.Icons = ImageList1 End If 'Agrega el archivo al listview con el icono ListView1.ListItems.Add , , LCase(path), _ ImageList1.ListImages(clave_Icono).Key Exit Sub ErrSub: 'Este error es por si se intenta añadir un archivo _ que ya estaba en el ListView, ya que da error de " la clave " _ no es única dentro de la colección If Err.Number = 35602 Then Exit Sub End If End Sub Private Function Dibujar_Icono_En_Picture(hImage As Long, _ sInfo As SHFILEINFO) As Long Dim ret As Long 'Limpia el gráfico del PitureBox Pic.Picture = LoadPicture() 'Dibuja en el picture el icono mediante el Api ImageList_Draw ret = ImageList_Draw(hImage, _ sInfo.iIcon, _ Pic.hDC, 0, 0, _ &H1) 'Le asigna a la propiedad Picture la propiedad image ' ya que no se puede pasar la propiedad image al control ImageList Pic.Picture = Pic.Image Pic.Height = 495: Pic.Width = 495 Dibujar_Icono_En_Picture = ret End Function

Ejemplo 2

Este ejemplo es similar también utilizando la función del Api SHGetFileInfo para obtener el ícono del los archivos y carpetas, pero a diferencia del otro, no se utiliza un picturebox temporal para dibujar el ícono, si no que se utiliza la función OleCreatePictureIndirect para retornar la imagen y luego poder agregarla al control imagelist

formulario de ejemplo

Controles

Agregar un control ListView al formulario llamado LV

Código fuente en el form

Option Explicit ' udt para necesarias para la función SHGetFileInfo ' ------------------------------------------------------------------------------------ Private Type IconType cbSize As Long picType As PictureTypeConstants hIcon As Long End Type Private Type CLSIdType id(16) As Byte End Type Private Type ShellFileInfoType hIcon As Long iIcon As Long dwAttributes As Long szDisplayName As String * 260 szTypeName As String * 80 End Type ' -- Tamaño de íconos Private Enum eSizeIcon [Small] = 257 [Normal] = 256 End Enum '\\ -- Apis ' ------------------------------------------------------------------------------------ Private Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As ShellFileInfoType, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long Private Declare Function OleCreatePictureIndirect Lib "oleaut32.dll" (pDicDesc As IconType, riid As CLSIdType, ByVal fown As Long, lpUnk As Object) As Long ' ------------------------------------------------------------------------------------ '\\ -- Función para devolver en un IPictureDisp la imagen del ícono de los archivos ' ------------------------------------------------------------------------------------ Private Function GetIcon(sPathFile As String, lSize As eSizeIcon) As IPictureDisp Dim ret As Long Dim Unkown As IUnknown Dim Icon As IconType Dim CLSID As CLSIdType Dim ShellInfo As ShellFileInfoType 'lSize = Small ' 256 para el ícono chico 'lSize = Normal ' 257 para el ícono grande Call SHGetFileInfo(sPathFile, 0, ShellInfo, Len(ShellInfo), lSize) With Icon .cbSize = Len(Icon) .picType = vbPicTypeIcon .hIcon = ShellInfo.hIcon End With With CLSID .id(8) = &HC0 .id(15) = &H46 End With ret = OleCreatePictureIndirect(Icon, CLSID, 1, Unkown) Set GetIcon = Unkown ' retornar la imagen End Function ' ---------------------------------------------------------------------------------- ' \\ -- Inicio ' ---------------------------------------------------------------------------------- Private Sub Form_Load() ' -- Establecer propiedades para el listview With lv .View = lvwReport .ColumnHeaders.Add , , "Ruta" ' -- para poder habilitar el drag sobre el listview .OLEDropMode = ccOLEDropManual End With MsgBox "Arrastrar archivos y directorios desde windows hacia el listview", vbInformation End Sub ' ---------------------------------------------------------------------------------- ' \\ -- Redimensionar ' ---------------------------------------------------------------------------------- Private Sub Form_Resize() lv.Move 0, 0, Me.ScaleWidth, Me.ScaleHeight End Sub ' ---------------------------------------------------------------------------------- ' \\ -- Obtener los archivos al arrastrarlos hacia el ListView ' ---------------------------------------------------------------------------------- Private Sub lv_OLEDragDrop(Data As MSComctlLib.DataObject, Effect As Long, Button As Integer, Shift As Integer, x As Single, y As Single) On Error GoTo err_handler With Data ' -- comprobar que lo que se está arrastrando son archivos If .GetFormat(vbCFFiles) Then Dim i As Integer ' -- recorrer la colección de archivos For i = 1 To .Files.Count ' -- obtener el ícono del archivo Dim iPic As IPictureDisp Set iPic = GetIcon(.Files(i), Small) ' -- agregarlo al imagelist On Error Resume Next ImageList1.ListImages.Add , .Files(i), iPic ' -- si hubo error es por que ya existia, si no agregar la ruta al listview If Err.Number <> 35602 Then If lv.Icons Is Nothing Then Set lv.SmallIcons = ImageList1 ' asignar el ícono chico End If lv.ListItems.Add , , .Files(i), , .Files(i) End If ' -- limpiar el error On Error GoTo 0 Next End If End With ' -- Errores Exit Sub err_handler: If Err.Number <> 35602 Then MsgBox Err.Description, vbCritical End Sub

Recursos vb - Enlaces relacionados

Buscar en Recursos vb