.
Unos ejemplos...
Transpasar un Icono de una coleccion a otra
Option Explicit
Private Sub Form_Load()
AutoRedraw = True
Dim a As Cls_ImageList
Const Str_BMP As String = "Angeles" ' // Aqui guardamos imagenes Grandes
Const Str_BMP2 As String = "AngelesMinis" ' // Nos servira solo para Redidibujar e mini
Dim lng_Index As Long
Set a = New Cls_ImageList
With a
If Not .ImageListCreate(Str_BMP, 128, 128) = 0 Then ' // Nos devuelve el Handle de la coleccion de imagenes.
lng_Index = .ImageList_ADDLoadFromFile(Str_BMP, App.Path & "\img\a1.bmp", IMAGE_BITMAP)
If Not .ImageListCreate(Str_BMP2, 32, 32) = 0 Then
lng_Index = .ImageList_ADDLoadFromHandle(Str_BMP2, .ImageListGetHIcon(Str_BMP, lng_Index), IMAGE_ICON)
.ImageListDraw Str_BMP, lng_Index, Me.hDC, 20, 50
.ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50
End If
End If
End With
Set a = Nothing
Refresh
End Sub
Agregas Iconos desde Instancias de colecciones ajenas...
Option Explicit
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_ICON = &H100
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 Sub Form_Load()
AutoRedraw = True
Dim a As Cls_ImageList
Const Str_BMP As String = "System" ' // Aqui guardamos imagenes Grandes
Const Str_BMP2 As String = "SystemMinis" ' // Nos servira solo para Redidibujar e mini
Dim lng_Index As Long
Dim lng_sys_himl As Long
Dim SHINFO As SHFILEINFO
Set a = New Cls_ImageList
With a
If Not .ImageListCreate(Str_BMP, 128, 128) = 0 Then ' // Nos devuelve el Handle de la coleccion de imagenes.
lng_sys_himl = SHGetFileInfo("c:\", 0, SHINFO, LenB(SHINFO), SHGFI_ICON Or SHGFI_LARGEICON)
If Not lng_sys_himl = 0 Then
lng_Index = .ImageList_ADDLoadFromHandle(Str_BMP, SHINFO.hIcon, IMAGE_ICON)
End If
If Not .ImageListCreate(Str_BMP2, 32, 32) = 0 Then
lng_Index = .ImageList_ADDLoadFromHandle(Str_BMP2, .ImageListGetHIcon(Str_BMP, lng_Index), IMAGE_ICON)
.ImageListDraw Str_BMP, lng_Index, Me.hDC, 20, 50
.ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50
End If
End If
End With
Set a = Nothing
Refresh
End Sub
Temibles Lunas!¡.