vbAccelerator - Contents of code file: fTest.frm

VERSION 5.00
Object = "{8245A918-4CF7-11D2-8E21-10B404C10000}#8.1#0"; "vbalIml.ocx"
Begin VB.Form frmIlsTest 
   Caption         =   "vbAccelerator Image List Tester"
   ClientHeight    =   6360
   ClientLeft      =   3510
   ClientTop       =   2040
   ClientWidth     =   6465
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "fTest.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   6360
   ScaleWidth      =   6465
   Begin vbalIml.vbalImageList vbalImageList1 
      Left            =   2520
      Top             =   1620
      _ExtentX        =   953
      _ExtentY        =   953
      IconSizeX       =   24
      IconSizeY       =   24
      ColourDepth     =   32
      Size            =   196800
      Images          =   "fTest.frx":014A
      Version         =   131072
      KeyCount        =   80
      Keys            =   $"fTest.frx":3022A
   End
   Begin vbalIml.vbalImageList ilsAlpha 
      Left            =   5820
      Top             =   2340
      _ExtentX        =   953
      _ExtentY        =   953
      IconSizeX       =   48
      IconSizeY       =   48
      ColourDepth     =   32
      Size            =   9660
      Images          =   "fTest.frx":30504
      Version         =   131072
      KeyCount        =   1
      Keys            =   ""
   End
   Begin VB.CommandButton cmdSave 
      Caption         =   "&Save"
      Height          =   315
      Left            =   120
      TabIndex        =   23
      Top             =   840
      Width           =   1575
   End
   Begin VB.CommandButton cmdLoad 
      Caption         =   "&Load"
      Height          =   315
      Left            =   120
      TabIndex        =   22
      Top             =   480
      Width           =   1575
   End
   Begin VB.PictureBox picStrip 
      AutoSize        =   -1  'True
      Height          =   615
      Left            =   1800
      ScaleHeight     =   555
      ScaleWidth      =   3615
      TabIndex        =   20
      Top             =   5640
      Width           =   3675
   End
   Begin VB.CommandButton cmdStrip 
      Caption         =   "Get Picture Strip->"
      Height          =   375
      Left            =   60
      TabIndex        =   19
      Top             =   5640
      Width           =   1515
   End
   Begin VB.CommandButton cmdSaveIcon 
      Caption         =   "&Save Icon"
      Height          =   315
      Left            =   120
      TabIndex        =   15
      Top             =   4200
      Width           =   1455
   End
   Begin VB.CommandButton cmdClear 
      Caption         =   "Clear"
      Height          =   315
      Left            =   120
      TabIndex        =   14
      Top             =   1260
      Width           =   1575
   End
   Begin VB.OptionButton optStyle 
      Appearance      =   0  'Flat
      Caption         =   "Cu&t"
      ForeColor       =   &H80000008&
      Height          =   195
      Index           =   3
      Left            =   120
      TabIndex        =   7
      Top             =   2940
      Width           =   1575
   End
   Begin VB.OptionButton optStyle 
      Appearance      =   0  'Flat
      Caption         =   "&Disabled"
      ForeColor       =   &H80000008&
      Height          =   195
      Index           =   2
      Left            =   120
      TabIndex        =   6
      Top             =   2700
      Width           =   1575
   End
   Begin VB.OptionButton optStyle 
      Appearance      =   0  'Flat
      Caption         =   "&Selected"
      ForeColor       =   &H80000008&
      Height          =   195
      Index           =   1
      Left            =   120
      TabIndex        =   5
      Top             =   2460
      Width           =   1575
   End
   Begin VB.OptionButton optStyle 
      Appearance      =   0  'Flat
      Caption         =   "&Normal"
      ForeColor       =   &H80000008&
      Height          =   195
      Index           =   0
      Left            =   120
      TabIndex        =   4
      Top             =   2220
      Value           =   -1  'True
      Width           =   1575
   End
   Begin VB.PictureBox picIcon 
      Height          =   555
      Left            =   120
      ScaleHeight     =   495
      ScaleWidth      =   615
      TabIndex        =   3
      Top             =   3540
      Width           =   675
   End
   Begin VB.CommandButton cmdGetPic 
      Caption         =   "Get Picture"
      Height          =   315
      Left            =   120
      TabIndex        =   2
      Top             =   3180
      Width           =   1515
   End
   Begin vbalIml.vbalImageList ilsMono 
      Left            =   5820
      Top             =   1440
      _ExtentX        =   953
      _ExtentY        =   953
      IconSizeX       =   24
      IconSizeY       =   24
      ColourDepth     =   24
      Size            =   63960
      Images          =   "fTest.frx":32AE0
      Version         =   131072
      KeyCount        =   26
      Keys            =   ""
   End
   Begin VB.CommandButton cmdGet 
      Caption         =   "Get Resource"
      Height          =   315
      Left            =   120
      TabIndex        =   1
      Top             =   60
      Width           =   1575
   End
   Begin VB.CommandButton cmdShow 
      Caption         =   "Show"
      Height          =   315
      Left            =   120
      TabIndex        =   0
      Top             =   1860
      Width           =   1575
   End
   Begin vbalIml.vbalImageList ilsTest 
      Left            =   5820
      Top             =   900
      _ExtentX        =   953
      _ExtentY        =   953
      IconSizeX       =   24
      IconSizeY       =   24
      ColourDepth     =   24
      Size            =   63960
      Images          =   "fTest.frx":424D8
      Version         =   131072
      KeyCount        =   26
      Keys            =   $"fTest.frx":51ED0
   End
   Begin VB.Label lblAddress 
      Caption         =   "/index.html"
      Height          =   195
      Left            =   4620
      TabIndex        =   21
      Top             =   420
      Width           =   1875
   End
   Begin VB.Label lblCount 
      Caption         =   "Image Count:"
      Height          =   255
      Left            =   1860
      TabIndex        =   18
      Top             =   780
      Width           =   1095
   End
   Begin VB.Label lblImageCount 
      Height          =   255
      Left            =   2940
      TabIndex        =   17
      Top             =   780
      Width           =   1095
   End
   Begin VB.Image imgVBAccelerator 
      Height          =   360
      Left            =   5100
      Picture         =   "fTest.frx":51F7D
      Top             =   60
      Width           =   1290
   End
   Begin VB.Label lblWarning 
      Caption         =   "Warning - the SavePicture method crashes VB for
       icons which aren't 16x16 or 32x32"
      Height          =   1035
      Left            =   120
      TabIndex        =   16
      Top             =   4560
      Width           =   1515
   End
   Begin VB.Label lblY 
      Height          =   255
      Left            =   2940
      TabIndex        =   13
      Top             =   540
      Width           =   1095
   End
   Begin VB.Label lblHeight 
      Caption         =   "Height"
      Height          =   255
      Left            =   1860
      TabIndex        =   12
      Top             =   540
      Width           =   1095
   End
   Begin VB.Label lblX 
      Height          =   255
      Left            =   2940
      TabIndex        =   11
      Top             =   300
      Width           =   1095
   End
   Begin VB.Label lblWidth 
      Caption         =   "Width:"
      Height          =   255
      Left            =   1860
      TabIndex        =   10
      Top             =   300
      Width           =   1095
   End
   Begin VB.Label lblDepth 
      Height          =   255
      Left            =   2940
      TabIndex        =   9
      Top             =   60
      Width           =   1095
   End
   Begin VB.Label lblColour 
      Caption         =   "Colour Depth:"
      Height          =   255
      Left            =   1860
      TabIndex        =   8
      Top             =   60
      Width           =   1095
   End
End
Attribute VB_Name = "frmIlsTest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' =========================================================================
' vbAccelerator Image List Control Demonstrator
' Copyright  1998 Steve McMahon (steve@vbaccelerator.com)
'
' Demonstrates the vbAccelerator Image List. Try out the
' ImageList properties at design time to check out the
' implementation.
'
' Visit vbAccelerator at www.dogma.demon.co.uk
' =========================================================================

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 cmdLoad_Click()
On Error GoTo ErrHandler
   ' Loads a data file created by the ImageList:
    ilsTest.LoadFromFile App.Path & "\Test2.dat"
    cmdShow_Click
    Exit Sub
ErrHandler:
   MsgBox "Error Loading: " & Err.Description, vbExclamation
   Exit Sub
End Sub

Private Sub cmdSave_Click()
On Error GoTo ErrHandler
   ' Saves the image list pictures to a data file:
    ilsTest.SaveToFile App.Path & "\Test2.dat"
    Exit Sub
ErrHandler:
   MsgBox "Error Loading: " & Err.Description, vbExclamation
   Exit Sub
End Sub

Private Sub cmdClear_Click()
Dim i As Long
   ' Remove all the icons in the image list.
   For i = ilsTest.ImageCount To 1 Step -1
      ilsTest.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:
   '    ilsTest.Create
   ' This will change the ilsTest.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.
   
   ilsTest.ColourDepth = ilsTest.SystemColourDepth
   Form_Load
   If (ilsTest.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)
      ilsTest.AddFromHandle stdPic.Handle, IMAGE_BITMAP, , &HFFFF00
      Set stdPic = Nothing
   Else
      ilsTest.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 = ilsTest.ItemPicture(1)
   
End Sub


Private Sub cmdSaveIcon_Click()
   ' This (used to) crash VB unless the icon is 16x16 or 32x32.
   SavePicture picIcon, App.Path & "/home/VB/Code/Controls/ImageList/vbAccelerator_Image_List_Control/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
   
   lblImageCount.Caption = ilsTest.ImageCount

   ' Display all the icons in the ImageList in the style
   ' specified by the options:
   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 ilsTest.ImageCount
       ilsTest.DrawImage i, Me.hDC, x, y, bSel, bCut, bDis, Me.BackColor
       y = y + ilsTest.IconSizeY + 2
       If (y + ilsTest.IconSizeY + 2 > cmdStrip.Top \ Screen.TwipsPerPixelY)
        Then
        y = cmdClear.Top \ Screen.TwipsPerPixelY
        x = x + ilsTest.IconSizeX + 2
     End If
   Next i
   
   ilsAlpha.DrawImage 1, Me.hDC, Me.ScaleWidth \ Screen.TwipsPerPixelX - 60,
    Me.ScaleHeight \ Screen.TwipsPerPixelY - 60
   
End Sub

Private Sub cmdStrip_Click()
   Set picStrip.Picture = ilsTest.ImagePictureStrip(, , &H80FF00)
End Sub

Private Sub Form_Activate()
   cmdShow_Click
End Sub

Private Sub Form_Load()
   
   ' Display info about the image list:
   Select Case ilsTest.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 = ilsTest.IconSizeX
   lblY.Caption = ilsTest.IconSizeY
   lblImageCount.Caption = ilsTest.ImageCount
   
End Sub

Private Sub optStyle_Click(Index As Integer)
   cmdShow_Click
End Sub