Resumen Extraer iconos.   (2 mensajes )

Muy buenas, don Asdrubal y resto de personal.
Te envío como se hace básicamente lo que quieres, partiendo de ello, lo adaptas a tus necesidades.


'---------------esto en un módulo bas-----------------------------------
'===========================================
'Función para extraer iconos de los archivos
'===========================================
Public Const MAX_PATH = 260
Public Const SHGFI_DISPLAYNAME = &H200
Public Const SHGFI_EXETYPE = &H2000
Public Const SHGFI_SYSICONINDEX = &H4000 ' System icon index
Public Const SHGFI_LARGEICON = &H0 ' Large icon
Public Const SHGFI_SMALLICON = &H1 ' Small icon
Public Const ILD_TRANSPARENT = &H1 ' Display transparent
Public Const SHGFI_SHELLICONSIZE = &H4
Public Const SHGFI_TYPENAME = &H400
Public Const BASIC_SHGFI_FLAGS = SHGFI_TYPENAME _
   Or SHGFI_SHELLICONSIZE Or SHGFI_SYSICONINDEX _
   Or SHGFI_DISPLAYNAME Or SHGFI_EXETYPE

Public Type SHFILEINFO
    hIcon As Long
    iIcon As Long
    dwAttributes As Long
    szDisplayName As String * MAX_PATH
    szTypeName As String * 80
End Type

Public 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

Public Declare Function ImageList_Draw Lib "comctl32.dll" _
   (ByVal himl&, ByVal i&, ByVal hDCDest&, _
    ByVal x&, ByVal y&, ByVal flags&) As Long

Public shinfo As SHFILEINFO


'---------------esto en el lugar apropiado del form-------------------
    Dim r&, hImgSmall& , hImgLarge&
    Dim Fichero as String 'le tienes que asignar la ruta completa
   '---------para insertar el icono------------
    'borra los iconos anteriores
    Picture1.Picture = LoadPicture()
    'obtener los iconos asociados al archivo
    hImgSmall = SHGetFileInfo(Fichero, 0, shinfo, Len(shinfo), _
    BASIC_SHGFI_FLAGS Or SHGFI_SMALLICON)
    'hImgLarge = SHGetFileInfo(Fichero, 0, shinfo, Len(shinfo), _
    BASIC_SHGFI_FLAGS Or SHGFI_LARGEICON)
    'dibuja los iconos en los píctures
    r = ImageList_Draw(hImgSmall, shinfo.iIcon, Picture1.hDC, 0, 0, ILD_TRANSPARENT)
    'r = ImageList_Draw(hImgLarge, shinfo.iIcon, Picture1.hDC, 0, 0,ILD_TRANSPARENT)
    Picture1.Refresh
Picture1.Picture = Picture1.Image

Hola Asdrubal. Te adjunto una página que quizá te sirva de ayuda.
Tambien tengo por ahi la estructura de los archivos .ICO (no la encontré al momento de escribirte esto)
En cuanto la encuentre, te la envío.

Saludos.
Jose

Download icons32.htm  



Resumen Resumen

Visual Basic Página de Visual Basic

Página principal Página principal

www.jrubi.com