vbAccelerator - Contents of code file: frmTestArListBar.frm

VERSION 5.00
Object = "{7577E59E-CA4E-455F-96E5-404B2365D6AD}#5.1#0"; "vbalARLB.ocx"
Begin VB.Form frmTestARListBar 
   BackColor       =   &H80000005&
   Caption         =   "Button ListBar Tester"
   ClientHeight    =   3900
   ClientLeft      =   2640
   ClientTop       =   2595
   ClientWidth     =   6585
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H80000016&
   Icon            =   "frmTestArListBar.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   260
   ScaleMode       =   3  'Pixel
   ScaleWidth      =   439
   Begin VB.TextBox txtDemo 
      Height          =   3375
      Left            =   1380
      MultiLine       =   -1  'True
      TabIndex        =   1
      Top             =   480
      Width           =   5115
   End
   Begin VB.PictureBox picBanner 
      AutoRedraw      =   -1  'True
      BackColor       =   &H80000010&
      BorderStyle     =   0  'None
      Height          =   375
      Left            =   1380
      ScaleHeight     =   375
      ScaleWidth      =   5115
      TabIndex        =   2
      TabStop         =   0   'False
      Top             =   60
      Width           =   5115
      Begin VB.Label lblSelected 
         BackStyle       =   0  'Transparent
         BeginProperty Font 
            Name            =   "Tahoma"
            Size            =   9.75
            Charset         =   0
            Weight          =   700
            Underline       =   0   'False
            Italic          =   0   'False
            Strikethrough   =   0   'False
         EndProperty
         ForeColor       =   &H80000005&
         Height          =   255
         Left            =   360
         TabIndex        =   3
         Top             =   60
         Width           =   4695
      End
   End
   Begin vbalARListBarLib.vbalARListBar barMain 
      Align           =   3  'Align Left
      Height          =   3900
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   1440
      _ExtentX        =   2540
      _ExtentY        =   6879
      BackColor       =   -2147483633
      BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
         Name            =   "Tahoma"
         Size            =   8.25
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ScaleMode       =   3
   End
   Begin VB.Menu mnuFileTOP 
      Caption         =   "&File"
      Begin VB.Menu mnuFile 
         Caption         =   "&New Window..."
         Index           =   0
         Shortcut        =   ^N
      End
      Begin VB.Menu mnuFile 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mnuFile 
         Caption         =   "E&xit"
         Index           =   2
      End
   End
   Begin VB.Menu mnuTestTOP 
      Caption         =   "Te&sts"
      Begin VB.Menu mnuTest 
         Caption         =   "&Clear All"
         Index           =   0
      End
      Begin VB.Menu mnuTest 
         Caption         =   "-"
         Index           =   1
      End
      Begin VB.Menu mnuTest 
         Caption         =   "Add &New..."
         Index           =   2
      End
      Begin VB.Menu mnuTest 
         Caption         =   "&Insert New..."
         Index           =   3
      End
      Begin VB.Menu mnuTest 
         Caption         =   "&Remove..."
         Index           =   4
      End
      Begin VB.Menu mnuTest 
         Caption         =   "-"
         Index           =   5
      End
      Begin VB.Menu mnuTest 
         Caption         =   "&Pinboard Notes Enabled"
         Index           =   6
      End
      Begin VB.Menu mnuTest 
         Caption         =   "Change First Item Ico&n"
         Index           =   7
      End
      Begin VB.Menu mnuTest 
         Caption         =   "Change First Item Ca&ption"
         Index           =   8
      End
      Begin VB.Menu mnuTest 
         Caption         =   "-"
         Index           =   9
      End
      Begin VB.Menu mnuTest 
         Caption         =   "Change &Width"
         Index           =   10
      End
   End
End
Attribute VB_Name = "frmTestARListBar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Private m_cIml As cVBALImageList
Private m_cImlSMall As cVBALImageList

Private Sub loadIcons(cIml As cVBALImageList)
Dim sFile As String
   sFile = App.Path & "\Res\"
   With cIml
      .AddFromFile sFile & "276.ico", IMAGE_ICON, "CALENDAR"
      .AddFromFile sFile & "21_19.ico", IMAGE_ICON, "TIMECARDS"
      .AddFromFile sFile & "167_6.ico", IMAGE_ICON, "NOTES"
      .AddFromFile sFile & "20_2.ico", IMAGE_ICON, "POSTITS"
      .AddFromFile sFile & "My Options.ico", IMAGE_ICON, "OPTIONS"
   End With
End Sub


Private Sub barMain_ItemClick(ByVal lIndex As Long)
   Debug.Print "ItemClick"
End Sub

Private Sub barMain_SelectionChanged(ByVal lIndex As Long)
   lblSelected.Caption = barMain.ItemCaption(lIndex)
   picBanner.Cls
   m_cImlSMall.DrawImage _
      barMain.ItemIcon(lIndex) + 1, _
      picBanner.hdc, _
      4, (picBanner.ScaleHeight \ Screen.TwipsPerPixelY -
       m_cImlSMall.IconSizeY) \ 2
   picBanner.Refresh
End Sub

Private Sub barMain_ItemRightClick(ByVal lIndex As Long, x As Single, y As
 Single)
   Me.PopupMenu mnuTestTOP, , x + barMain.tOp, y + barMain.left
End Sub

Private Sub barMain_Resize()
   Form_Resize
End Sub

Private Sub Form_Load()
   
   Set m_cIml = New cVBALImageList
   With m_cIml
      .IconSizeX = 32
      .IconSizeY = 32
      .ColourDepth = ILC_COLOR32
      .Create
   End With
   loadIcons m_cIml
   Set m_cImlSMall = New cVBALImageList
   With m_cImlSMall
      .IconSizeX = 16
      .IconSizeY = 16
      .ColourDepth = ILC_COLOR32
      .Create
   End With
   loadIcons m_cImlSMall
   
   With barMain
      .ImageList = m_cIml.hIml
   
      .Add "CALENDAR", "Check Your Work &Calendar", 0
      .Add "TIMECARDS", "Book &Timecards", 1, "Book and submit your weekly
       timecards, and track your time."
      .Add "NOTES", "Contact &Notes", 2, "View meeting and lead notes"
      .Add "POSTITS", "&Pinboard Notes", 3, , False
      .Add "OPTIONS", "Confi&gure Options", 4, "Set up offline options and
       configure the program"
      
      .ItemSelected("CALENDAR") = True
   End With
   
End Sub

Private Sub Form_Resize()
On Error Resume Next
   picBanner.Move _
      barMain.Width + Me.ScaleX(4, vbPixels, Me.ScaleMode), _
      Me.ScaleY(4, vbPixels, Me.ScaleMode), _
      Me.ScaleWidth - (barMain.Width + Me.ScaleX(8, vbPixels, Me.ScaleMode))
   txtDemo.Move _
      picBanner.left, _
      txtDemo.tOp, _
      picBanner.Width, _
      Me.ScaleHeight - txtDemo.tOp - Me.ScaleY(4, vbPixels, Me.ScaleMode)
End Sub

Private Sub Form_Terminate()
   If (Forms.Count = 0) Then
      UnloadApp
   End If
End Sub

Private Sub mnuFile_Click(Index As Integer)
   Select Case Index
   Case 0
      Dim f As New frmTestARListBar
      f.Move Me.left + 8 * Screen.TwipsPerPixelX, Me.tOp + 8 *
       Screen.TwipsPerPixelY
      f.Show
   Case 2
      Unload Me
   End Select
End Sub

Private Sub mnuTest_Click(Index As Integer)
Dim sI As String
Dim sPrompt As String
Dim i As Long
Dim sI2 As String
   Select Case Index
   Case 0
      barMain.Clear
   Case 2
      sI = InputBox("Enter text for the new item.", Me.Caption)
      If Len(sI) > 0 Then
         barMain.Add , sI, Rnd * m_cIml.ImageCount
      End If
   Case 3
      sI = InputBox("Enter text for the new item.", Me.Caption)
      If Len(sI) > 0 Then
         For i = 1 To barMain.ItemCount
            If (i > 1) Then
               sPrompt = sPrompt & ", "
            End If
            sPrompt = sPrompt & barMain.ItemKey(i)
         Next i
         sI2 = InputBox("Enter key to insert before: one of " & sPrompt,
          Me.Caption)
         If Len(sI2) > 0 Then
            barMain.Add , sI, Rnd * m_cIml.ImageCount, , , , , sI2
         End If
      End If
   Case 4
      For i = 1 To barMain.ItemCount
         If (i > 1) Then
            sPrompt = sPrompt & ", "
         End If
         sPrompt = sPrompt & barMain.ItemKey(i)
      Next i
      sI = InputBox("Enter key to remove: one of " & sPrompt, Me.Caption)
      If Len(sI) > 0 Then
         barMain.Remove sI
      End If
   Case 6
      mnuTest(6).Checked = Not (mnuTest(6).Checked)
      barMain.ItemEnabled("POSTITS") = mnuTest(6).Checked
   Case 7
      ' icon
      barMain.ItemIcon(1) = Rnd * m_cIml.ImageCount
   Case 8
      ' caption
      If (barMain.ItemCaption(1) = "T&his is a changed caption") Then
         barMain.ItemCaption(1) = "Another change." & vbCrLf & "This is longer
          and includes a line-break."
      Else
         barMain.ItemCaption(1) = "T&his is a changed caption"
      End If
   Case 10
      ' width
      Select Case barMain.ButtonWidth
      Case 64
         barMain.ButtonWidth = 96
      Case 96
         barMain.ButtonWidth = 128
      Case 128
         barMain.ButtonWidth = 256
      Case 256
         barMain.ButtonWidth = 64
      End Select
      
   End Select
End Sub

Private Sub picBanner_Resize()
On Error Resume Next
   lblSelected.Move _
      lblSelected.left, _
      (picBanner.ScaleHeight - lblSelected.Height) \ 2, _
      picBanner.ScaleWidth - lblSelected.left - 2 * Screen.TwipsPerPixelY
End Sub