Autor
|
Tema: mExtractIcons {Extraer Iconos de EXE o DLL} (Leído 2,717 veces)
|
skyweb07
Desconectado
Mensajes: 122
The ghost of the network
|
Bueno este es un simple modulo que sirve para extraer los iconos de archivos EXE o DLL , es muy simple y funciona bien, si encuentran algun bug o algo solo reportenlo y se arreglara =) , aqui les dejo el codigo del modulo y un ejemplo de uso =) Option Explicit
'************************************************************** '************************************************************** '** Module : mExtractIcons ** '** Author : Skyweb07 ** '** Email : skyweb09@hotmail.es ** '** Date : 03/10/2009 - 15:20 ** '** Purpose : Extraer Iconos desde Archivos EXE o DLL ** '************************************************************** '**************************************************************
'************************************************************** '************************************************************** '** APIS para dibujar los iconos ** '************************************************************** '**************************************************************
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 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
Public Function Extract_Icons(hFile As String, Listview As Listview, Picture As PictureBox, IL As ImageList)
Dim hCount As Long Dim hIcon As Long Dim i As Integer
Listview.ListItems.Clear ' // Limpiamos los Items de la Listview
Set Listview.Icons = Nothing ' // Quitamos las referencias de las imagelist de el Listview para que no de error
IL.ListImages.Clear ' // Limpiamos las imagenes de la Imagelist
Do ' // Hacemos un Loop por todos los iconos de el archivo
ExtractIconEx hFile, hCount, hIcon, 0, 1 ' // Extraemos el Icono y lo almacenamos en la variable hIcon
If hIcon = 0 Then Exit Do ' // Si retorna 0 es que no hay mas iconos entonces Salimos del bucle
With Picture
.Cls ' // Limpiamos la Picturebox .AutoRedraw = True ' // Activamos el AutoRedraw .BackColor = vbWhite ' // Le ponemos a la Imagen un color Blanco de fondo para que se vea bien en la Listview
DrawIcon .hdc, 0, 0, hIcon ' // Dibujamos el Icono DestroyIcon hIcon ' // Destruimos el Icono para liberar el espacio utilizado en la memoria
With IL
.ListImages.Add , , Picture.Image ' // Anadimos el icono a la Imagelist .ListImages(.ListImages.Count).Tag = .ListImages.Count & "-" & Right$(hFile, Len(hFile) - InStrRev(hFile, "\")) ' // Anadimos el tag de la Imagen el Nombre del Archivo
End With
hCount = hCount + 1 ' // Incrementamos la variable hCount
End With
Loop ' // Bucle
If IL.ListImages.Count > 0 Then ' // Si la Imagelist tiene Iconos
Set Listview.Icons = IL ' // Le asignamos a la Listview el Imagelist
For i = 1 To IL.ListImages.Count ' // Recorremos todos los iconos de la IMagelist
Listview.ListItems.Add , , IL.ListImages.Item(i).Tag, i ' // Anadimos el Icono a la Listview
Next i ' // Icono Siguiente
End If
End Function PD: El Codigo de ejemplo esta comentado en ingles porque el primer post que hice lo hice para un foro en ingles {Solo para que no hallan problemas} LINK : http://www.megaupload.com/?d=RLHVXEF0
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
Ammm esta bien, pero recuerda que un EXE tiene varios iconos no solo el que se ve. Algo Importante ExtractIconEx devuelve el Numero total de iconos xP es decir deberia ser algo asi: Public Function ContarIconos(StrRuta As String) As Integer ContarIconos = ExtractIconEx(StrRuta, -1, 0, 0, 0) End Function
Aquì dejo algo mas sencillo!¡. Const DI_MASK = &H1 Const DI_IMAGE = &H2 Const DI_NORMAL = DI_MASK Or DI_IMAGE 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 DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long Private Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long Public Sub ObtenerIcono(StrRuta As String, hdc As Long, Optional ByVal NumIcon As Integer = 0, Optional ByVal LargeIcons As Boolean = True) Dim LIcons As Long, SIcons As Long, counticon As Integer counticon = ContarIconos(StrRuta) NumIcon = IIf(NumIcon > counticon, counticon, IIf(NumIcon < 0, 0, NumIcon)) ' //Solo un simple arreglo en la variable NumIcon (Arreglo del Rango Permitido) Call ExtractIconEx(StrRuta, NumIcon, LIcons, SIcons, 1) If LargeIcons Then ' // Call DrawIconEx(hdc, 0, 0, LIcons, 32, 32, 0, 0, DI_NORMAL) Call DrawIconEx(hdc, 0, 0, LIcons, 0, 0, 0, 0, DI_NORMAL) Else ' // Call DrawIconEx(hdc, 0, 0, SIcons, 16, 16, 0, 0, 3) Call DrawIconEx(hdc, 0, 0, SIcons, 0, 0, 0, 0, DI_NORMAL) End If DestroyIcon LIcons DestroyIcon SIcons End Sub Public Function ContarIconos(StrRuta As String) As Integer ContarIconos = ExtractIconEx(StrRuta, -1, 0, 0, 0) End Function
P.D.: No le pogno autor por el simple hecho que esto ya en la internet ya esta muy Documentado!¡. Dulces Lunas!¡.
|
|
« Última modificación: 3 Octubre 2009, 23:33 pm por ░▒▓BlackZeroҖ▓▒░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
cobein
|
░▒▓BlackZeroҖ▓▒░ tenes que destruir los handles una vez que termines o coprar mucha ram xD
|
|
|
En línea
|
|
|
|
skyweb07
Desconectado
Mensajes: 122
The ghost of the network
|
Sip porque sino se peta la memoria si cargas muchos iconos al no ser que tengas 8GB de RAM
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
░▒▓BlackZeroҖ▓▒░ tenes que destruir los handles una vez que termines o coprar mucha ram xD
A tienes razon se me paso es minuculo (GRANDE) detalle jim DestroyIcon LIcons DestroyIcon SIcons
Dulces Lunas
|
|
« Última modificación: 3 Octubre 2009, 21:39 pm por ░▒▓BlackZeroҖ▓▒░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
cobein
|
░▓BlackZeroҖ▓▒░
Estaba mirando mas detenidamente la funcion y hay muchos errores, los flags estan mal en DrawIconEx y ExtractIconEx.
Las medidas, 32 y 16 las tenes que averiguar usando GetSystemMetrics para evitar problemas.
No hay necesidad de sacar los 2 handles y destruirlos si vas a usar uno solo.
Por otra parte cuando usas ExtractIconEx, los parametros phiconLarge y phiconSmal devuelven un array, el tema es que la declaracion de la API ExtractIconEx es incorrecta.
Bueno si alguno se anima a hacer esto bien seria interesante.
|
|
|
En línea
|
|
|
|
BlackZeroX
Wiki
Desconectado
Mensajes: 3.158
I'Love...!¡.
|
los phiconLarge y phiconSmal no se suponen que solo devuelven el punto al array correspondiente?. Lo de los flags se me paso el 1 era en ExtractIconEx y el 3 era en DrawIconEx y con GetSystemMetrics lo revisare, aunque con solo quitar 32,16 y sustituirlos por 0 de las apis basta para dejar los iconos en su tamaño natura (Aunque creo que en ese caso mejor devi haber usado DrawIcon y no DrawIconEx ). P.D.: Si no comentas ni encuenta, ya que lo habia escrito aquì en el foro con el compilador y probarlo!¡. Dulces Lunas
|
|
« Última modificación: 3 Octubre 2009, 23:31 pm por ░▒▓BlackZeroҖ▓▒░ »
|
En línea
|
The Dark Shadow is my passion.
|
|
|
cobein
|
nIconIndex indica el indice (icono) que queres extraer.
phiconLarge y phiconSmall devuelven un array conteniendo todas las "versiones" (distintas resoluciones, etc) de ese icono.
normalmente si se pasa phiconLarge o phiconSmall como long el ultimo parametro de la funcion tiene que ser 1 (otro valor no tiene efecto a no ser que sea 0), puesto que el "array" solo tiene espacio para 1 handle.
Para llamar correctamente a la funcion phiconLarge y phiconSmall tienen que ser punteros a un array y se declaran com byval en la API, el tamano de el srray es el que se usa como ultimo parametro ,nIcons.
|
|
|
En línea
|
|
|
|
|
|