[Src][ Update 03/Ene/2011 ] 2.0 Cls_ImageList (Coleccion de imagenes)

[BlackZeroX]

.

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
1.2 Cls_ImageList
1.3 Cls_ImageList

2.0 Cls_ImageList

Código [Seleccionar] Expandir



'   /////////////////////////////////////////////////////////////
'   //                  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...

Código (Vb) [Seleccionar] Expandir



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!¡.
.

[BlackZeroX]

.
@1.2 Cls_ImageList

* Agregue un algoritmo para buscar rapidamente 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

@1.3 Cls_ImageList

* Solo Impide crear Coleccion de imagenes con Keys Indenticas

1.3 Cls_ImageList

Temibles Lunas!¡.

[BlackZeroX]

.
Unos ejemplos...

Transpasar un Icono de una coleccion a otra

Código (Vb) [Seleccionar] Expandir



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...

Código (Vb) [Seleccionar] Expandir



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!¡.

[ntaryl]

Very nice Bro 
Happy new Year

[BlackZeroX]

.
@2.0 ImageList

Código [Seleccionar] Expandir



'   /////////////////////////////////////////////////////////////
'   //                  ImageList.Cls   2.0                    //
'   // *    ADD Events                                         //
'   // *    ADD Convert Icons To Picture                       //
'   // *    Fix Swap                                           //
'   // *    Fix Duplicate                                      //
'   /////////////////////////////////////////////////////////////



2.0 Cls_ImageList

Temibles Lunas!¡.
.