ImageList Class Example, VB5 or VB6 (57K)
ImageList Control Documentation (2K)
VB5 ImageList Control Binary (33K)
VB5 ImageList Demonstration (89K)
VB5 ImageList Full Source (153K)
VB6 ImageList Control Binary (32K)
VB6 ImageList Demonstration (56K)
VB6 ImageList Full Source (121K)
Bugs: 6 / 6
Issues: 0 / 0
Questions: 0 / 0
29 Mar 2003
Fixed all problems with inconsistent indexes being returned by the methods. Indexes returned by the control are now always 1-based. The ItemPicture method consequently now works correctly.
Using the System Image List with (and without) vbAccelerator Controls
Displaying Alpha (32bit) Icons with ImageLists
vbAccelerator - Contents of code file: frmImageListClass.frm
VERSION 5.00
Begin VB.Form frmImageListClass
Caption = "vbAccelerator Image List Class Tester"
ClientHeight = 6285
ClientLeft = 3255
ClientTop = 1905
ClientWidth = 6525
Icon = "frmImageListClass.frx":0000
LinkTopic = "Form1"
ScaleHeight = 6285
ScaleWidth = 6525
Begin VB.CommandButton cmdShow
Caption = "Show"
Height = 315
Left = 60
TabIndex = 11
Top = 1440
Width = 1575
End
Begin VB.CommandButton cmdGet
Caption = "Get Resource"
Height = 315
Left = 60
TabIndex = 10
Top = 60
Width = 1575
End
Begin VB.CommandButton cmdGetPic
Caption = "Get Picture"
Height = 315
Left = 60
TabIndex = 9
Top = 2760
Width = 1515
End
Begin VB.PictureBox picIcon
Height = 555
Left = 60
ScaleHeight = 495
ScaleWidth = 615
TabIndex = 8
Top = 3120
Width = 675
End
Begin VB.OptionButton optStyle
Appearance = 0 'Flat
Caption = "&Normal"
ForeColor = &H80000008&
Height = 195
Index = 0
Left = 60
TabIndex = 7
Top = 1800
Value = -1 'True
Width = 1575
End
Begin VB.OptionButton optStyle
Appearance = 0 'Flat
Caption = "&Selected"
ForeColor = &H80000008&
Height = 195
Index = 1
Left = 60
TabIndex = 6
Top = 2040
Width = 1575
End
Begin VB.OptionButton optStyle
Appearance = 0 'Flat
Caption = "&Disabled"
ForeColor = &H80000008&
Height = 195
Index = 2
Left = 60
TabIndex = 5
Top = 2280
Width = 1575
End
Begin VB.OptionButton optStyle
Appearance = 0 'Flat
Caption = "Cu&t"
ForeColor = &H80000008&
Height = 195
Index = 3
Left = 60
TabIndex = 4
Top = 2520
Width = 1575
End
Begin VB.CommandButton cmdClear
Caption = "Clear"
Height = 315
Left = 60
TabIndex = 3
Top = 1080
Width = 1575
End
Begin VB.CommandButton cmdSaveIcon
Caption = "&Save Icon"
Height = 315
Left = 60
TabIndex = 2
Top = 3780
Width = 1455
End
Begin VB.CommandButton cmdStrip
Caption = "Get Picture Strip->"
Height = 375
Left = 0
TabIndex = 1
Top = 5220
Width = 1515
End
Begin VB.PictureBox picStrip
AutoSize = -1 'True
Height = 615
Left = 1740
ScaleHeight = 555
ScaleWidth = 3615
TabIndex = 0
Top = 5220
Width = 3675
End
Begin VB.Label lblDepth
Height = 255
Left = 2820
TabIndex = 21
Top = 60
Width = 1095
End
Begin VB.Label lblX
Height = 255
Left = 2820
TabIndex = 20
Top = 300
Width = 1095
End
Begin VB.Label lblY
Height = 255
Left = 2820
TabIndex = 19
Top = 540
Width = 1095
End
Begin VB.Label lblImageCount
Height = 255
Left = 2820
TabIndex = 18
Top = 780
Width = 1095
End
Begin VB.Label lblColour
Caption = "Colour Depth:"
Height = 255
Left = 1800
TabIndex = 17
Top = 60
Width = 1095
End
Begin VB.Label lblWidth
Caption = "Width:"
Height = 255
Left = 1800
TabIndex = 16
Top = 300
Width = 1095
End
Begin VB.Label lblHeight
Caption = "Height"
Height = 255
Left = 1800
TabIndex = 15
Top = 540
Width = 1095
End
Begin VB.Label lblWarning
Caption = "Warning - the SavePicture method crashes VB for
icons which aren't 16x16 or 32x32"
Height = 1035
Left = 60
TabIndex = 14
Top = 4140
Width = 1515
End
Begin VB.Image imgVBAccelerator
Height = 360
Left = 5040
Picture = "frmImageListClass.frx":030A
Top = 60
Width = 1290
End
Begin VB.Label lblCount
Caption = "Image Count:"
Height = 255
Left = 1800
TabIndex = 13
Top = 780
Width = 1095
End
Begin VB.Label lblAddress
Caption = "www.dogma.demon.co.uk"
Height = 195
Left = 4440
TabIndex = 12
Top = 480
Width = 1875
End
End
Attribute VB_Name = "frmImageListClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private m_cIL As cVBALImageList
Private m_bInDev As Boolean
Private Property Get InDev() As Boolean
' This function is called from a debug.assert call
' so m_bIndev is only ever set in DesignTime -
' debug.assert is not compiled into executables.
m_bInDev = True
InDev = m_bInDev
End Property
Private Sub cmdClear_Click()
Dim i As Long
' Remove all the icons in the image list.
For i = m_cIL.ImageCount To 1 Step -1
m_cIL.RemoveImage i
Next i
cmdShow_Click
' Note an alternative method, and quicker if you
' have a lot of icons, is to create a new ImageList:
' m_cIL.Create
' This will change the m_cIL.hIml handle value.
End Sub
Private Sub cmdGet_Click()
Dim idRes As Long
' This button loads either a 16 or 256 colour icon resource
' depending on the system colour depth.
' All the images are loaded from a single resource bitmap.
' A note on using Resources in VB.
' If you are running in EXE, the single AddFromResourceID call
' can be made.
' In the IDE, just use the LoadResPicture function. Note that
' LoadResPicture does not work correctly with icons that are not
' 32x32 or 16x16 and 16 colours - it returns a distorted or dithered
' icon.
m_cIL.ColourDepth = m_cIL.SystemColourDepth
If (m_cIL.ColourDepth >= ILC_COLOR16) Then
' We can handle 256 colours
idRes = 101
Else
' If we were ILC_COLOR8, we could handle 256 colours in
' theory, but palette issues in practice make it too tricky.
idRes = 102
End If
Debug.Assert (InDev() = True)
If (m_bInDev) Then
Dim stdPic As New StdPicture
Set stdPic = LoadResPicture(idRes, vbResBitmap)
m_cIL.AddFromHandle stdPic.Handle, IMAGE_BITMAP, , &HFFFF00
Set stdPic = Nothing
Else
m_cIL.AddFromResourceID idRes, App.hInstance, IMAGE_BITMAP, , False,
&HFFFF00
End If
cmdShow_Click
End Sub
Private Sub cmdGetPic_Click()
' Transfer an image to a VB picture object. StdPicture sucks
' for icons!
Set picIcon.Picture = m_cIL.ItemPicture(1)
End Sub
Private Sub cmdSaveIcon_Click()
' This will crash VB unless the icon is 16x16 or 32x32. Why?
SavePicture picIcon, App.Path & "\Test.ico"
End Sub
Private Sub cmdShow_Click()
Dim i As Long
Dim x As Long, y As Long
Dim bSel As Boolean, bDis As Boolean, bCut As Boolean
' Display all the icons in the ImageList in the style
' specified by the options:
lblImageCount = m_cIL.ImageCount
bSel = optStyle(1).Value
bDis = optStyle(2).Value
bCut = optStyle(3).Value
Me.Cls
x = cmdShow.left + cmdShow.Width
x = x \ Screen.TwipsPerPixelX
y = cmdClear.tOp \ Screen.TwipsPerPixelY
For i = 1 To m_cIL.ImageCount
m_cIL.DrawImage i, Me.hdc, x, y, bSel, bCut, bDis, Me.BackColor
y = y + m_cIL.IconSizeY + 2
If (y + m_cIL.IconSizeY + 2 > cmdStrip.tOp \ Screen.TwipsPerPixelY) Then
y = cmdClear.tOp \ Screen.TwipsPerPixelY
x = x + m_cIL.IconSizeX + 2
End If
Next i
End Sub
Private Sub cmdStrip_Click()
Set picStrip.Picture = m_cIL.ImagePictureStrip(, , &H80FF00)
End Sub
Private Sub Form_Activate()
cmdShow_Click
End Sub
Private Sub Form_Load()
Set m_cIL = New cVBALImageList
m_cIL.OwnerHDC = Me.hdc
m_cIL.ColourDepth = ILC_COLOR24
m_cIL.IconSizeX = 24
m_cIL.IconSizeY = 24
m_cIL.Create
m_cIL.AddFromFile App.Path & "\256-1.bmp", IMAGE_BITMAP, , True, &HFFFF00
' Display info about the image list:
Select Case m_cIL.ColourDepth
Case ILC_COLOR8
lblDepth.Caption = "256 colours"
Case ILC_COLOR4
lblDepth.Caption = "16 colours"
Case ILC_COLOR32
lblDepth.Caption = "32 bit"
Case ILC_COLOR24
lblDepth.Caption = "24 bit"
Case ILC_COLOR16
lblDepth.Caption = "16 bit"
Case ILC_COLOR
lblDepth.Caption = "Default"
End Select
lblX.Caption = m_cIL.IconSizeX
lblY.Caption = m_cIL.IconSizeY
lblImageCount.Caption = m_cIL.ImageCount
End Sub
