| Hola te paso un ejemplo que hice esta bueno, arrastras (drag & drop) un archivo al listview y este te muestra el icono, el nombre , la ruta , el tamaño , y el tipo de un archivo
agrega lo siguiente
1 ListView1
1 Imagelist1
1 command1
1 picture1
1 modulo
el codigo para el form:
Option Explicit
Private Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Private Declare Function DrawIcon Lib "user32" (ByVal hDC As Long, ByVal x As Long, ByVal y As Long, ByVal hIcon As Long) As Long
Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Const SHGFI_DISPLAYNAME = &H200
Const SHGFI_TYPENAME = &H400
Const MAX_PATH = 260
Private Type SHFILEINFO
hIcon As Long
iIcon As Long
dwAttributes As Long
szDisplayName As String * MAX_PATH
szTypeName As String * 80
End Type
Private Declare Function SHGetFileInfo Lib "shell32.dll" Alias "SHGetFileInfoA" (ByVal pszPath As String, ByVal dwFileAttributes As Long, psfi As SHFILEINFO, ByVal cbFileInfo As Long, ByVal uFlags As Long) As Long
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hWnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private Sub Command1_Click()
If ListView1.View = lvwIcon Then
ListView1.View = lvwReport
Else
ListView1.View = lvwIcon
End If
End Sub
Private Sub Form_DblClick()
ShellExecute 0, vbNullString, ListView1.SelectedItem.SubItems(2), vbNullString, vbNullString, 1
End Sub
Private Sub Form_Load()
DragAcceptFiles hWnd, True ' get ready to accept files
lProcOld = SetWindowLong(hWnd, GWL_WNDPROC, AddressOf FileDropHandler)
With ListView1
.ColumnHeaders.Add , , "Fichero", 2000
.ColumnHeaders.Add , , "Ruta", 5000
.ColumnHeaders.Add , , "Tamaño", 2000
.ColumnHeaders.Add , , "Tipo", 2000
.HideColumnHeaders = False
.View = lvwReport
End With
With Picture1
.BackColor = vbWhite
.AutoRedraw = True
.Width = 540
.Height = 540
.Visible = False
End With
Command1.Caption = "Vista"
End Sub
Sub ExtraerIconos(Ruta As String)
On Error Resume Next
Dim mIcon As Long
Dim Fichero As String
Dim i As Integer
Dim FI As SHFILEINFO
SHGetFileInfo (Ruta), 0, FI, Len(FI), SHGFI_DISPLAYNAME Or SHGFI_TYPENAME
Fichero = StripTerminator(FI.szDisplayName)
If Fichero = "" Then Fichero = Ruta
mIcon = ExtractAssociatedIcon(App.hInstance, Ruta, 2)
Picture1.Cls
DrawIcon Picture1.hDC, 0, 0, mIcon
DestroyIcon mIcon
ImageList1.ListImages.Add Key:=Fichero, Picture:=Picture1.Image
With ListView1.ListItems.Add(, Key:=Fichero, Text:=Fichero)
.SubItems(1) = Ruta
.SubItems(2) = Format$(Format$((FileLen(Ruta) \ 1024) + 1, "##,###,##0") & " KB", "@@@@@@@@@@@@")
.SubItems(3) = StripTerminator(FI.szTypeName)
End With
Dim LI As ListItem
Set ListView1.SmallIcons = ImageList1
Set ListView1.Icons = ImageList1
For Each LI In ListView1.ListItems
LI.SmallIcon = LI.Key
LI.Icon = LI.Key
Next LI
End Sub
Function StripTerminator(sInput As String) As String
Dim ZeroPos As Integer
ZeroPos = InStr(1, sInput, vbNullChar)
If ZeroPos > 0 Then
StripTerminator = Left$(sInput, ZeroPos - 1)
Else
StripTerminator = sInput
End If
End Function
Private Sub Form_Unload(Cancel As Integer)
DragAcceptFiles hWnd, False
SetWindowLong hWnd, GWL_WNDPROC, lProcOld
End Sub
Private Sub ListView1_DblClick()
ShellExecute 0, vbNullString, ListView1.SelectedItem.SubItems(1), vbNullString, vbNullString, 1
End Sub
-------------------------------------------
El codigo para el modulo:
Public Declare Sub DragAcceptFiles Lib "shell32.dll" (ByVal hWnd As Long, ByVal fAccept As Long)
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
Public Const WM_DROPFILES = &H233
Public Const GWL_WNDPROC = -4
Public lProcOld As Long
Public Function FileDropHandler(ByVal hWnd As Long, ByVal iMsg As Long, ByVal wParam As Long, ByVal lParam As Long) As Long
Dim filename As String * 128
If iMsg = WM_DROPFILES Then
Anzahl = DragQueryFile(wParam, -1, filename, 127)
For x = 1 To Anzahl
DragQueryFile wParam, x - 1, filename, 127
Form1.ExtraerIconos (filename)
Next x
Exit Function
End If
FileDropHandler = CallWindowProc(lProcOld, hWnd, iMsg, wParam, lParam)
End Function |