adjuntar archivos con su icono en un RichTextBox

5v5 · #1 (**permalink**) 15/10/2005, 08:58

Buen dia....

Espero me puedan ayudar...gracias..

bueno..he buscado por la web y solo he encontrado poco...

Como puedo adjuntar archivos a mi programa de la forma de arrastrar & soltar del explorador a mi programa y que se edjunten con su respectivo icono y con la opcion de abrirlos y guardarlos....por ejemplo.

tengo abierto mi form y necesito un archivo que esta en el escritorio de windows....lo que necesito es jalar ese archivo que esta en el escritorio hacia mi form y que en mi form aparezca una copia de ese archivo pero con su respectivo icono........l

lo he intentado con un RichTextBox pero no he podido lograr que me paresca el icono de dicho archivo...

bueno espero me puedan ayudar ...mil gracias por su atencion

LeandroA · #2 (**permalink**) 15/10/2005, 15:01

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

LeandroA · #3 (**permalink**) 15/10/2005, 15:08

y con el richtextbox es facil pero poco util dira yo

RichTextBox1.OLEObjects.Add , , "C:\Documents and Settings\Escritorio\22.mid"

5v5 · #4 (**permalink**) 17/10/2005, 08:16

ok...muchas gracias...lo estudiare.....hasta pornto......gracias

5v5 · #5 (**permalink**) 18/10/2005, 14:39

buen dia...nuevamente molestando....cheque el code LeandroA...y nuevamente gracias pero...esta casi perfecto....bueno para mis propositos....he buscado por la web pero nada.....lo que necesito es que estos archivos adjuntados...como el de tu code...se puedan guardar, copiar...drag-drop(hacia el escritorio)....espero me puedas orientar nuevamente....si es que se puede hacer......gracias....

LeandroA · #6 (**permalink**) 18/10/2005, 20:21

Hola mira yo tambien estuve buscando hace un monton lo inverso es decir guardar haciendo drag & drop pero no pude encotrar nada si llego o vos llegas o alguien de este foro que sepa a que nos referimos porfavor avisar

Bien nos vemos cualquiero otra duda si puedo te ayudo

5v5 · #7 (**permalink**) 21/10/2005, 17:32

k onda LeandroA...he checado algunos links..pero aun no he encontrado lo necesario...supongo que se pueden guardar o imprimir, etc...si logramos obtener el handle de los objetos(archivos y/o iconos)..y utilizar sendmessage....o utilizar el portapapeles....bueno solo es una hipotesis..no he logradop encontrar el handle de los objetos que incrustamos...y no se si sea posible....

si alguien del foro tiene otra sugerencia...se los agradeciriamos mucho.....hasta pronto

LeandroA · #8 (**permalink**) 21/10/2005, 22:03

el tema seria solo obtener la ruta en donde soltamos el drag & drop luegos seria cuestion de open for binary y listo pero como carajo obtener la ruta???

alguien los sabe ?

5v5 · #9 (**permalink**) 24/10/2005, 11:18

Buen dia...nuevamente...

Mira LeandroA, buscando por el oraculo encontre este link....quiza sirva de algo...aun no lo he estudiado..pero si lo prove y funciona...se trata de lo siguiente...

lo que vamos hacer es que cuando le des clik a los archivos dentro del listview...se copien al portapapeles...y asi los podemos pegar en donde sea...

bueno con respecto a obtener la ruta en donde soltamos el drag & drop ...aun no la he encontrado...pero esto puede servir...

Aqui esta el hilo http://www.developerfusion.co.uk/show/224/

saludos y hsta pronto

LeandroA · #10 (**permalink**) 24/10/2005, 18:47

hola lo e chequeado pero por mi igorancia no se como se utiliza es decir no se como llamar a la funcion: ClipboardPasteFiles se me complica por el arrray, me tiras un ejemplo como seria yo ise esto pero no me funiona
ClipboardCopyFiles("C:\divujo.bmp") = True
tambien explicame como es para pegar

tambien encontre otra forma mejor para obtener el icono es mas rapido y se puede extraer el icono pequeño y otros te paso el ejemplo del api guide utiliza el apiImageList_Draw

Private Const MAX_PATH = 260
Private Const SHGFI_DISPLAYNAME = &H200 ' get display name
Private Const SHGFI_EXETYPE = &H2000 ' return exe type
Private Const SHGFI_LARGEICON = &H0 ' get large icon
Private Const SHGFI_SHELLICONSIZE = &H4 ' get shell size icon
Private Const SHGFI_SMALLICON = &H1 ' get small icon
Private Const SHGFI_SYSICONINDEX = &H4000 ' get system icondex
Private Const SHGFI_TYPENAME = &H400 ' get type name
Private Const ILD_BLEND50 = &H4
Private Const ILD_BLEND25 = &H2
Private Const ILD_TRANSPARENT = &H1
Private Const CLR_NONE = &HFFFFFFFF
Private Const CLR_DEFAULT = &HFF000000
Private Type SHFILEINFO
hIcon As Long ' : icon
iIcon As Long ' : icondex
dwAttributes As Long ' : SFGAO_ flags
szDisplayName As String * MAX_PATH ' : display name (or path)
szTypeName As String * 80 ' : type name
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 ImageList_Draw Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal x As Long, ByVal y As Long, ByVal fStyle As Long) As Long
Private Declare Function ImageList_DrawEx Lib "comctl32.dll" (ByVal himl As Long, ByVal i As Long, ByVal hdcDst As Long, ByVal x As Long, ByVal y As Long, ByVal dx As Long, ByVal dy As Long, ByVal rgbBk As Long, ByVal rgbFg As Long, ByVal fStyle As Long) As Long
Private Sub Form_Load()
'KPD-Team 2000
'URL: http://www.allapi.net/
'E-Mail: [email protected]
Dim hImage As Long, udtFI As SHFILEINFO
'set the graphics mode of form1 to persistent
Me.AutoRedraw = True
'get the handle of the system image list that contains the large icon images
hImage = SHGetFileInfo("c:\", ByVal 0&, udtFI, Len(udtFI), SHGFI_SYSICONINDEX Or SHGFI_LARGEICON)
'draw the icon (normal)
ImageList_Draw hImage, udtFI.iIcon, Me.hDC, 0, 0, ILD_TRANSPARENT
'draw the icon (blended)
ImageList_DrawEx hImage, udtFI.iIcon, Me.hDC, 32, 0, 32, 32, CLR_NONE, CLR_DEFAULT, ILD_BLEND50

hImage = SHGetFileInfo("c:\", ByVal 0&, udtFI, Len(udtFI), SHGFI_SYSICONINDEX Or SHGFI_SMALLICON)

ImageList_Draw hImage, udtFI.iIcon, Me.hDC, 0, 40, ILD_TRANSPARENT
End Sub

5v5 · #11 (**permalink**) 25/10/2005, 08:42

ok...perdon....la forma de llamar es la siguiente....

Private Sub Copiar_Click()

Dim CopyArray(0) As String

CopyArray(0) = ListView1.SelectedItem.SubItems(1)
Call ClipboardCopyFiles(CopyArray)

End Sub

de esta forma al llamar a ClipboardCopyFiles... lo envia al portapapeles y asi lo puedes pegar en donde quieras...siempre y cuando el origen se diferente del destino...

Solo falta perfeccionarlo.....

solo lo he aplicado a tu code...de una manera rapida...pork apenas estoy estudiando el code...para poderlo aplicar mucho mas a detalle...por ejemplo....seguimos en contacto....y con respecto al nuevo code que acabas de poner...lo voy a probar....saludos...por si te late estar en contacto...te dejo mi e-mail: [email protected]dos..y gracias....