.
http://infrangelux.hostei.com/index.php?option=com_content&view=article&id=25:20-clsimagelist&catid=15:catmoduloscls&Itemid=24
Este Modulo de Clase es solo una pequeña sustitucion al ImageList, no tiene gran cosa y no se parece en lo absoluto a los de Cobein, ya que este solo esta diseñado para que trabaje con iconos, aun que puede cargar BMP, Cursores e Iconos obviamente.
1.0 Cls_ImageList (http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/Modulos%20de%20Clase/Cls_ImageList&file=Cls_Imagelist.rar)
1.2 Cls_ImageList (http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/Modulos%20de%20Clase/Cls_ImageList&file=1.2%20Cls_Imagelist.rar)
1.3 Cls_ImageList (http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/Modulos%20de%20Clase/Cls_ImageList&file=1.3%20Cls_Imagelist.rar)
2.0 Cls_ImageList (http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/Modulos%20de%20Clase/Cls_ImageList&file=2.0%20Cls_Imagelist.zip)
' /////////////////////////////////////////////////////////////
' // ImageList.Cls 2.0 //
' // * ADD Events //
' // * ADD Convert Icons To Picture //
' // * Fix Swap //
' // * Fix Duplicate //
' /////////////////////////////////////////////////////////////
EDITO: --> Subi Nuevamente el Archivo ya que era una version Anterior.
Edito: ---> Agrego solo un ejemplo Basico...
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, 512, 512) = 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 .ImageListDuplicate(Str_BMP, Str_BMP2) Then
.ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50
If .ImageListSetSize(Str_BMP, 32, 32) Then
.ImageListDraw Str_BMP, lng_Index, Me.hDC, 20, 50
End If
.ImageListDestroy Str_BMP2 ' // Eliminamos la Coleccion de imagenes
.ImageListDraw Str_BMP2, lng_Index, Me.hDC, 20, 50 ' // esta linea ya no pictara nada ya que la coleccion ya esta destruida.
End If
End If
End With
Set a = Nothing
Refresh
End Sub
Temibles Lunas!¡.
.
.
@1.2 Cls_ImageList
* Agregue un algoritmo para buscar rapidamente (http://foro.elhacker.net/programacion_visual_basic/srcpoc_buscar_en_un_array_ordenado-t315340.0.html) la coleccion de imagenes la cual es ordenada con QSort()
* Correcion: Error en la Funcion ImageListDuplicate
* Correcion: Error en la funcion VerificImageList
1.2 Cls_ImageList (http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/Modulos%20de%20Clase/Cls_ImageList&file=1.2%20Cls_Imagelist.rar)
@1.3 Cls_ImageList
* Solo Impide crear Coleccion de imagenes con Keys Indenticas
1.3 Cls_ImageList (http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/Modulos%20de%20Clase/Cls_ImageList&file=1.3%20Cls_Imagelist.rar)
Temibles Lunas!¡.
.
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!¡.
Very nice Bro
Happy new Year
.
@2.0 ImageList
' /////////////////////////////////////////////////////////////
' // ImageList.Cls 2.0 //
' // * ADD Events //
' // * ADD Convert Icons To Picture //
' // * Fix Swap //
' // * Fix Duplicate //
' /////////////////////////////////////////////////////////////
2.0 Cls_ImageList (http://infrangelux.sytes.net/FileX/index.php?dir=/BlackZeroX/Programacion/vb6/Modulos%20de%20Clase/Cls_ImageList&file=2.0%20Cls_Imagelist.zip)
Temibles Lunas!¡.
.