vbAccelerator - Contents of code file: frmSDITest.frm

VERSION 5.00
Object = "{E142732F-A852-11D4-B06C-00500427A693}#1.13#0"; "vbalTbar6.ocx"
Begin VB.Form frmSDITest 
   Caption         =   "vbAccelerator Toolbar/Rebar Demonstration"
   ClientHeight    =   5490
   ClientLeft      =   1545
   ClientTop       =   1275
   ClientWidth     =   8115
   BeginProperty Font 
      Name            =   "Tahoma"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   Icon            =   "frmSDITest.frx":0000
   LinkTopic       =   "Form1"
   ScaleHeight     =   5490
   ScaleWidth      =   8115
   Begin VB.CommandButton cmdSaveLayout 
      Caption         =   "&Save Layout"
      Height          =   315
      Left            =   6060
      TabIndex        =   5
      Top             =   4200
      Width           =   1335
   End
   Begin VB.CommandButton cmdRestoreLayout 
      Caption         =   "&Restore Layout"
      Height          =   315
      Left            =   6060
      TabIndex        =   4
      Top             =   4560
      Width           =   1335
   End
   Begin vbalTBar6.cToolbar cToolbar1 
      Height          =   1125
      Left            =   60
      Top             =   1200
      Width           =   3000
      _ExtentX        =   5424
      _ExtentY        =   661
   End
   Begin vbalTBar6.cToolbar tbrMenu 
      Height          =   1125
      Left            =   60
      Top             =   720
      Width           =   3000
      _ExtentX        =   5424
      _ExtentY        =   661
   End
   Begin vbalTBar6.cReBar cReBar1 
      Left            =   60
      Top             =   60
      _ExtentX        =   13785
      _ExtentY        =   979
   End
   Begin VB.PictureBox picTest 
      BackColor       =   &H00000000&
      Height          =   315
      Left            =   7380
      ScaleHeight     =   255
      ScaleWidth      =   255
      TabIndex        =   2
      Top             =   1560
      Width           =   315
      Begin VB.Image imgIcon 
         Height          =   240
         Left            =   0
         Picture         =   "frmSDITest.frx":27A2
         Top             =   0
         Width           =   240
      End
   End
   Begin VB.ListBox lstNotes 
      Height          =   1815
      IntegralHeight  =   0   'False
      Left            =   120
      TabIndex        =   1
      Top             =   3120
      Width           =   7335
   End
   Begin VB.ComboBox cboStyle 
      Height          =   315
      Left            =   4860
      TabIndex        =   0
      Text            =   "Combo1"
      Top             =   1560
      Width           =   2475
   End
   Begin vbalTBar6.cToolbar cToolbar2 
      Height          =   1125
      Left            =   60
      Top             =   1680
      Width           =   3000
      _ExtentX        =   5424
      _ExtentY        =   661
   End
   Begin vbalTBar6.cToolbar cToolbar3 
      Height          =   1125
      Left            =   60
      Top             =   2100
      Width           =   3000
      _ExtentX        =   5424
      _ExtentY        =   661
   End
   Begin VB.TextBox txtNotes 
      Height          =   1875
      Left            =   300
      MultiLine       =   -1  'True
      ScrollBars      =   2  'Vertical
      TabIndex        =   3
      Text            =   "frmSDITest.frx":28EC
      Top             =   3360
      Width           =   7335
   End
End
Attribute VB_Name = "frmSDITest"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

' =========================================================================
' vbAccelerator Toolbar/Rebar control tester
' Copyright  1998 - 2003 Steve McMahon (steve@vbaccelerator.com)
'
' Demonstrates the vbAccelerator Toolbar and Rebar control.
' Note that some of the features of this demonstration will
' not work correctly unless you have the correct version of
' COMCTRL32.DLL installed (4.71 or higher required).
'
' Visit vbAccelerator at http://vbaccelerator.com/
' =========================================================================

Private Declare Function LockWindowUpdate Lib "user32" (ByVal hwndLock As Long)
 As Long
Private Declare Function PostMessage Lib "user32" Alias "PostMessageA" (ByVal
 hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Long)
 As Long
Private Const WM_SYSCOMMAND = &H112
Private Const SC_CLOSE = &HF060&

Private WithEvents m_cMenu As cPopupMenu
Attribute m_cMenu.VB_VarHelpID = -1
Private m_cIls As cVBALImageList
Private m_cSysIls As cVBALSysImageList

Private Sub TestSaveLayout()
Dim iFile As Integer
Dim sFile As String
Dim sXml As String
   
   sXml = cReBar1.SaveLayout()
   
   sFile = App.Path & "\restore.xml"
   
   On Error Resume Next
   Kill sFile
   
   On Error GoTo errorHandler
   iFile = FreeFile
   Open sFile For Binary Access Write As #iFile
   Put #iFile, , sXml
   Close #iFile
   Exit Sub
   
errorHandler:
   MsgBox "An error occurred trying to save the layout:" & vbCrLf &
    Err.Description, vbExclamation
   Exit Sub
   
End Sub

Private Sub TestLoadLayout()

   ' Read the XML:
   Dim iFile As Integer
   Dim sXml As String

   iFile = FreeFile
   Open App.Path & "\restore.xml" For Binary Access Read As #iFile
   sXml = Space$(LOF(iFile))
   Get #iFile, , sXml
   Close #iFile
   
   ' Set up an array of window handles against band data:
   ReDim sData(1 To 6) As String
   ReDim lhWnd(1 To 6) As Long
   sData(1) = "MenuBar": lhWnd(1) = tbrMenu.hwnd
   sData(2) = "Logo": lhWnd(2) = picTest.hwnd
   sData(3) = "Toolbar1": lhWnd(3) = cToolbar1.hwnd
   sData(4) = "Toolbar2": lhWnd(4) = cToolbar2.hwnd
   sData(5) = "Stylebar": lhWnd(5) = cboStyle.hwnd
   sData(6) = "Toolbar3": lhWnd(6) = cToolbar3.hwnd

   ' Recreate the rebar:
   cReBar1.DestroyRebarDontDestroyChildren
   cReBar1.CreateRebar Me.hwnd
   
   ' Restore the saved layout:
   cReBar1.RestoreLayout sXml, sData(), lhWnd()

End Sub

Private Sub pCreateMenu()
Dim iPTop As Long
Dim iP As Long
Dim iP2 As Long
Dim iP3 As Long
   
   Set m_cMenu = New cPopupMenu

   ' Creating a Menu:
   With m_cMenu
      ' Initial set up:
      .hWndOwner = Me.hwnd
      .OfficeXpStyle = True
      
      ' 1) Add the File menu:
      iP = .AddItem("&File", , , iPTop, , , , "mnuFileTOP")
      .AddItem "&New Instance" & vbTab & "Ctrl+N", , , iP, , , , "mnuFile(0)"
      .AddItem "Show &MDI!", , , iP, , , , "mnuFile(1)"
      .AddItem "-", , , iP, , , , "mnuFile(2)"
      .AddItem "&Close", , , iP, , , , "mnuFile(3)"
      
      ' 2) Add the Button menu, demonstrating infrequently used items:
      iP = .AddItem("&Button", , , iPTop, , , , "mnuButtonTOP")
      .AddItem "Button 2 &Visible", , , iP, , True, , "mnuButton(0)"
      .AddItem "Button 2 &Enabled", , , iP, , False, , "mnuButton(1)"
      .AddItem "-", , , iP, , , , "mnuButton(2)"
      iP2 = .AddItem("Change Button 2 &Caption", , , iP, , , , "mnuButton(3)")
      .ItemInfrequentlyUsed(iP2) = True
      iP2 = .AddItem("Change Button 1 Captio&n", , , iP, , , , "mnuButton(4)")
      .ItemInfrequentlyUsed(iP2) = True
      .AddItem "-", , , iP, , , , "mnuButton(5)"
      iP2 = .AddItem("Change Button 2 &Image", , , iP, , , , "mnuButton(6)")
      .ItemInfrequentlyUsed(iP2) = True
      iP2 = .AddItem("Chec&k Last Button", , , iP, , , , "mnuButton(7)")
      .ItemInfrequentlyUsed(iP2) = True
      .AddItem "-", , , iP, , , , "mnuButton(8)"
      .AddItem "In&sert Button...", , , iP, , , , "mnuButton(9)"
      .AddItem "-", , , iP, , , , "mnuButton(10)"
      .AddItem "&Show Captions", , , iP, , True, , "mnuButton(11)"
      
      ' 3) Add the View menu:
      iP = .AddItem("&View", , , iPTop, , , , "mnuViewTOP")
      .AddItem "&Large Toolbar", , , iP, , True, , "mnuView(0)"
      .AddItem "&Small Toolbar", , , iP, , True, , "mnuView(1)"
      .AddItem "Lin&ks Toolbar", , , iP, , True, , "mnuView(2)"
      .AddItem "St&yle Bar", , , iP, , True, , "mnuView(3)"
      .AddItem "-", , , iP, , , , "mnuView(4)"
      .AddItem "Background &Bitmap", , , iP, , , , "mnuView(5)"
      .AddItem "Office &XP Style", , , iP, , True, , "mnuView(6)"
      
      ' 4) Add the Position menu:
      iP = .AddItem("&Position", , , iPTop, , , , "mnuPositionTOP")
      iP2 = .AddItem("&Top", , , iP, , , , "mnuPosition(0)")
      .RadioCheck(iP2) = True
      .AddItem "&Left", , , iP, , , , "mnuPosition(1)"
      .AddItem "&Right", , , iP, , , , "mnuPosition(2)"
      .AddItem "&Bottom", , , iP, , , , "mnuPosition(3)"
      
      ' 5) Add the Help menu:
      iP = .AddItem("&Help", , , iPTop, , , , "mnuHelpTOP")
      .AddItem "&Contents" & vbTab & "F1", , , iP, , , , "mnuHelp(0)"
      iP2 = .AddItem("&Index", , , iP, , , , "mnuHelp(1)")
      .ItemInfrequentlyUsed(iP2) = True
      iP2 = .AddItem("&Search", , , iP, , , , "mnuHelp(2)")
      .ItemInfrequentlyUsed(iP2) = True
      .AddItem "-", , , iP
      iP2 = .AddItem("&vbAccelerator on the Web", , , iP, , , , "mnuHelp(1)")
      ' Add some sub menus:
      iP3 = .AddItem("&Free Stuff", , , iP2)
      iP3 = .AddItem("&Product News", , , iP2)
      iP3 = .AddItem("Frequently Asked &Questions", , , iP2)
      iP3 = .AddItem("-", , , iP2)
      iP3 = .AddItem("For &Developers Only", , , iP2)
      .ItemInfrequentlyUsed(iP3) = True
      iP3 = .AddItem("Send Feed&back", , , iP2)
      .ItemInfrequentlyUsed(iP3) = True
      iP3 = .AddItem("&Best of the Web", , , iP2)
      .ItemInfrequentlyUsed(iP3) = True
      iP3 = .AddItem("Search the &Web", , , iP2)
      .ItemInfrequentlyUsed(iP3) = True
      iP3 = .AddItem("Web &Tutorial", , , iP2)
      .ItemInfrequentlyUsed(iP3) = True
      .AddItem "-", , , iP
      .AddItem "&About...", , , iP, , , , "mnuHelp(3)"
      
      ' Make infrequently used items invisible in the toolbar
      .HideInfrequentlyUsed = True
   End With
   
End Sub

Private Sub pCreateImageList()
   
   ' Create the image list for the toolbars w/image list
   ' demonstrations:
   Set m_cIls = New cVBALImageList
   m_cIls.ColourDepth = ILC_COLOR4
   m_cIls.IconSizeX = 16
   m_cIls.IconSizeY = 16
   m_cIls.Create
   m_cIls.AddFromFile App.Path & "\explorer 16 colour hot 753x16.bmp",
    IMAGE_BITMAP
   
   ' Create the sys image list for the list style links
   ' toolbar:
   Set m_cSysIls = New cVBALSysImageList
   m_cSysIls.IconSizeX = 16
   m_cSysIls.IconSizeY = 16
   m_cSysIls.Create
   
End Sub

Private Sub pFileMenu(ByVal lIndex As Long, ByVal sKey As String)
   ' Respond to File Menu item clicks
   
Dim lItemIndex As Long

   lItemIndex = CLng(Mid$(sKey, 9, 1))
   Select Case lItemIndex
   Case 0
      Dim f As New frmSDITest
      f.Show
   Case 1
      mfrmTest.Show
      mfrmTest.ZOrder
   Case 3
      PostMessage Me.hwnd, WM_SYSCOMMAND, SC_CLOSE, 0
   End Select

End Sub
Private Sub pViewMenu(ByVal lIndex As Long, ByVal sKey As String)
   
   ' Respond to View Menu item clicks
   
Dim bS As Boolean
Dim l As Long
Dim lMajor As Long, lMinor As Long
Dim lItemIndex As Long
   
   ' None of these options are possible for COMMCTRL versions below 4.71:
   cToolbar1.GetComCtrlVersionInfo lMajor, lMinor
   If (lMajor = 4) And (lMinor < 71) Then
      MsgBox "Rebar Band Modification is not possible for COMMCTRL.DLL version
       4.70.", vbInformation
      Exit Sub
   End If
   
   ' Demonstrates hiding/showing rebar bands, and also
   ' changing the background bitmap of the rebar:
   
   bS = Not (m_cMenu.Checked(lIndex))
   m_cMenu.Checked(lIndex) = bS
   If IsNumeric(Mid$(sKey, 9, 1)) Then
   lItemIndex = CLng(Mid$(sKey, 9, 1))
   Select Case lItemIndex
   Case 0
      l = cReBar1.BandIndexForData("Toolbar1")
      cReBar1.BandVisible(l) = bS
   Case 1
      l = cReBar1.BandIndexForData("Toolbar2")
      cReBar1.BandVisible(l) = bS
   Case 2
      l = cReBar1.BandIndexForData("Toolbar3")
      cReBar1.BandVisible(l) = bS
   Case 3
      l = cReBar1.BandIndexForData("Stylebar")
      cReBar1.BandVisible(l) = bS
      
   Case 5
   
      ' To change the background bitmap, we remove all bands
      ' and add them in again.
      ' In order to prevent flickering whilst the rebar builds,
      ' use LockWindowUpdate.  See Tips on vbAccelerator for
      ' more info.
      LockWindowUpdate Me.hwnd
      With cReBar1
         .ImageSource = CRBLoadFromFile
         If (bS) Then
            .DestroyRebarDontDestroyChildren
            .ImageFile = App.Path & "\iebar2.bmp"
            .CreateRebar Me.hwnd
            .AddBandByHwnd tbrMenu.hwnd, , , , "MenuBar"
            .BandChildMinWidth(.BandCount - 1) = 24
            .AddBandByHwnd cToolbar1.hwnd, , , , "Toolbar1"
            .BandChildMinWidth(.BandCount - 1) = 24
            If (lMajor > 4) Or (lMinor > 70) Then
               .AddBandByHwnd picTest.hwnd, , , True, "Logo"
            End If
            .AddBandByHwnd cToolbar2.hwnd, , , , "Toolbar2"
            .AddBandByHwnd cboStyle.hwnd, "Style", False, , "Stylebar"
            ' Fixed toolbars are not allowed with COMMCTRL before 4.71:
            .AddBandByHwnd cToolbar3.hwnd, "Links", , , "Toolbar3"
            .BandChildMinWidth(.BandCount - 1) = 24
            Set m_cMenu.BackgroundPicture = LoadPicture(App.Path &
             "\iebar2.bmp")
         Else
            .DestroyRebarDontDestroyChildren
            .ImageFile = ""
            .CreateRebar Me.hwnd
            .AddBandByHwnd tbrMenu.hwnd, , , , "MenuBar"
            .BandChildMinWidth(.BandCount - 1) = 24
            .AddBandByHwnd cToolbar1.hwnd, , , , "Toolbar1"
            .BandChildMinWidth(.BandCount - 1) = 24
            If (lMajor > 4) Or (lMinor > 70) Then
               .AddBandByHwnd picTest.hwnd, , , True, "Logo"
            End If
            .AddBandByHwnd cToolbar2.hwnd, , , , "Toolbar2"
            .BandChildMinWidth(.BandCount - 1) = 24
            .AddBandByHwnd cboStyle.hwnd, "Style", False, , "Stylebar"
            ' Fixed toolbars are not allowed with COMMCTRL before 4.71:
            .AddBandByHwnd cToolbar3.hwnd, "Links", , , "Toolbar3"
            .BandChildMinWidth(.BandCount - 1) = 24
            m_cMenu.ClearBackgroundPicture
         End If
      End With
      LockWindowUpdate 0
      
   Case 6
      Dim ctl As Control
      For Each ctl In Me.Controls
         If (TypeName(ctl) = "cToolbar") Then
            Dim cTbar As cToolbar
            Set cTbar = ctl
            If (bS) Then
               cTbar.DrawStyle = CTBDrawOfficeXPStyle
            Else
               cTbar.DrawStyle = CTBDrawStandard
            End If
         End If
      Next
   End Select
   End If
   
End Sub

Private Sub Indicate(sItem As String)
   ' Show a message
   lstNotes.AddItem sItem
   lstNotes.ListIndex = lstNotes.NewIndex
End Sub

Private Sub cboStyle_Click()
   Indicate "cboStyle Click: " & cboStyle.ListIndex
End Sub


Private Sub cmdRestoreLayout_Click()
   TestLoadLayout
End Sub

Private Sub cmdSaveLayout_Click()
   TestSaveLayout
End Sub

Private Sub cReBar1_BandChildResize(ByVal wID As Long, ByVal lBandLeft As Long,
 ByVal lBandTop As Long, ByVal lBandRight As Long, ByVal lBandBottom As Long,
 lChildLeft As Long, lChildTop As Long, lChildRight As Long, lChildBottom As
 Long)
   'Debug.Print cReBar1.BandIndexForId(wID)
End Sub

Private Sub cReBar1_BeginBandDrag(ByVal wID As Long, bCancel As Boolean)
Dim s As String
Dim v As Variant
   v = cReBar1.BandData(wID)
   If IsMissing(v) Then
      s = wID
   Else
      s = v
   End If
   'Indicate "Rebar BandBeginDrag:" & s
End Sub

Private Sub cReBar1_ChevronPushed(ByVal wID As Long, ByVal lLeft As Long, ByVal
 lTop As Long, ByVal lRight As Long, ByVal lBottom As Long)
Dim lIndex As Long
Dim v As Variant
   Indicate "ChevronPushed:" & wID
   v = cReBar1.BandData(wID)
   If Not IsMissing(v) Then
      Select Case v
      Case "MenuBar"
         tbrMenu.ChevronPress lRight \ Screen.TwipsPerPixelX + 1, lTop \
          Screen.TwipsPerPixelY
      Case "Toolbar1"
         cToolbar1.ChevronPress lRight \ Screen.TwipsPerPixelX + 1, lTop \
          Screen.TwipsPerPixelY
      Case "Toolbar1"
         cToolbar1.ChevronPress lRight \ Screen.TwipsPerPixelX + 1, lTop \
          Screen.TwipsPerPixelY
      Case "Toolbar2"
         cToolbar2.ChevronPress lRight \ Screen.TwipsPerPixelX + 1, lTop \
          Screen.TwipsPerPixelY
      Case "Toolbar3"
         cToolbar3.ChevronPress lRight \ Screen.TwipsPerPixelX + 1, lTop \
          Screen.TwipsPerPixelY
      End Select
   End If
End Sub

Private Sub cReBar1_EndBandDrag(ByVal wID As Long)
Dim s As String
Dim v As Variant
   v = cReBar1.BandData(wID)
   If IsMissing(v) Then
      s = wID
   Else
      s = v
   End If
   'Indicate "Rebar BandEndDrag:" & s
End Sub

Private Sub cReBar1_HeightChanged(lHeight As Long)
   Indicate "Rebar HeightChanged" & lHeight
   pResize
End Sub

Private Sub cReBar1_LayoutChanged()
   Indicate "Rebar LayoutChanged"
End Sub

Private Sub cToolbar1_ButtonClick(ByVal lButton As Long)
   Indicate "Toolbar1 ButtonClick:" & vbTab & CStr(lButton) & ",Key=" &
    cToolbar1.ButtonKey(lButton) & ",Checked=" &
    cToolbar1.ButtonChecked(lButton)
   If (cToolbar1.ButtonKey(lButton) = "Properties") Then
      If (cToolbar1.ButtonChecked(lButton)) Then
         txtNotes.Visible = True
         lstNotes.Visible = False
      Else
         lstNotes.Visible = True
         txtNotes.Visible = False
      End If
   End If
End Sub

Private Sub cToolbar1_CustomiseBegin()
   Indicate "CustomiseBegin"
End Sub

Private Sub cToolbar1_CustomiseCanDelete(ByVal lButton As Long, bCanDelete As
 Boolean)
   Indicate "CustomiseCanDelete:" & vbTab & CStr(lButton) & ",Key=" &
    cToolbar1.ButtonKey(lButton) & ",Value=" & bCanDelete
End Sub

Private Sub cToolbar1_CustomiseCanInsertBefore(ByVal lButton As Long,
 bCanInsert As Boolean)
   Indicate "CustomiseCanInsertBefore:" & vbTab & CStr(lButton) & ",Key=" &
    cToolbar1.ButtonKey(lButton) & ",Value=" & bCanInsert
End Sub

Private Sub cToolbar1_DropDownPress(ByVal lButton As Long)
' If the toolbar hasn't created from a menu, you can show your own
' drop down item in response to a drop down press.
Dim x As Long, y As Long
Dim lIndex As Long
   Indicate "Toolbar1 DropDownPress:" & vbTab & CStr(lButton)
   cToolbar1.GetDropDownPosition lButton, x, y
   lIndex = m_cMenu.IndexForKey("mnuHelp(0)")
   m_cMenu.ShowPopupMenuAtIndex x, y, lIndex:=lIndex
End Sub

Private Sub cToolbar2_ButtonClick(ByVal lButton As Long)
   Indicate "Toolbar2 ButtonClick:" & vbTab & CStr(lButton) & ",Key=" &
    cToolbar2.ButtonKey(lButton) & ",Checked=" &
    cToolbar2.ButtonChecked(lButton)
End Sub

Private Sub cToolbar2_DropDownPress(ByVal lButton As Long)
' If the toolbar hasn't created from a menu, you can show your own
' drop down item in response to a drop down press.
Dim x As Long, y As Long
Dim lIndex As Long
   Indicate "Toolbar2 DropDownPress:" & vbTab & CStr(lButton)
   cToolbar2.GetDropDownPosition lButton, x, y
   lIndex = m_cMenu.IndexForKey("mnuFile(0)")
   m_cMenu.ShowPopupMenuAtIndex x, y, lIndex:=lIndex
End Sub

Private Sub cToolbar3_ButtonClick(ByVal lButton As Long)
   Indicate "Toolbar3 ButtonClick:" & vbTab & CStr(lButton) & ",Key=" &
    cToolbar3.ButtonKey(lButton) & ",Checked=" &
    cToolbar3.ButtonChecked(lButton)
End Sub

Private Sub Form_Load()
Dim lMajor As Long, lMinor As Long, lBuild As Long
Dim i As Long

    cToolbar1.GetComCtrlVersionInfo lMajor, lMinor, lBuild
   
   '
    ----------------------------------------------------------------------------
   --------
   ' Create the Image List and Menu object used in this demonstration
   pCreateImageList
   pCreateMenu
   '
    ----------------------------------------------------------------------------
   --------

   
   '
    ----------------------------------------------------------------------------
   --------
   ' Show some information about this project:
    Indicate "Welcome to the vbAccelerator Rebar/Toolbar CoolMenu control
     Demonstration"
    Indicate ""
    Indicate "This sample demonstrates:"
    Indicate "1) A CoolMenu"
    Indicate "2) A 256 colour 24x24 icon IE style bar"
    Indicate "3) A 16x16 bar with no text"
    Indicate "4) A 16x16 list-style bar with text and autosizing"
    Indicate "5) A Fixed item showing a logo"
    Indicate ""
    Indicate "All toolbars and an address ComboBox have been added to the Rebar"
    Indicate ""
    Indicate "You are running Common Controls version: " & lMajor & "." &
     lMinor & ", Build: " & lBuild
    If (lMajor < 4) Or ((lMajor = 4) And (lMinor < 71)) Then
      Indicate "This version does not support:"
      Indicate "a) Fixed rebar bands."
      Indicate "b) Standard button image resources."
      Indicate "c) Hiding/modification of rebar bands."
      Indicate "d) Auto-sized toolbar buttons."
      Indicate "e) Drop-down arrows for drop-down buttons"
      Indicate "You are highly recommended to upgrade to a newer version of IE"
    End If
   '
    ----------------------------------------------------------------------------
   --------

   '
    ----------------------------------------------------------------------------
   --------
   ' Prepare the toolbars:
   ' 1) This toolbar uses 256 colour 24x24 buttons with text copied from IE5.
   ' The buttons demonstrate automatic sizing and drop-downs.
   ' Note: a) Auto sizing is not supported for COMMCTRL v4.70
   '       b) Drop down buttons do not appear for COMMCTRL v4.70, and pressing
   '          a drop down button always raises a drop-down notification.
   With cToolbar1
      
      .ImageSource = CTBLoadFromFile
      .ImageFile = App.Path & "\256-1.bmp"
      .CreateToolbar 24, , True, True
      .DrawStyle = CTBDrawOfficeXPStyle
      
      .AddButton "Back", 0, , , "Back", CTBDropDown Or CTBAutoSize, "Back"
      .AddButton "Next", 1, , , "Next", CTBDropDown Or CTBAutoSize, "Next"
         .ButtonEnabled("Next") = False
      .AddButton "", -1, , , , CTBSeparator
      .AddButton "Cut", 2, , , "Cut", CTBNormal Or CTBAutoSize, "Cut"
      .AddButton "Copy", 3, , , "Copy", CTBNormal Or CTBAutoSize, "Copy"
      .AddButton "Paste", 4, , , "Paste", CTBNormal Or CTBAutoSize, "Paste"
      .AddButton "", -1, , , , CTBSeparator
      .AddButton "Undo the Last Operation", 5, , , "Undo", CTBNormal Or
       CTBAutoSize, "Undo"
      .AddButton "Redo the Last Operation", 6, , , "Redo", CTBNormal Or
       CTBAutoSize, "Redo"
      .AddButton "", -1, , , , CTBSeparator
      .AddButton "Properties", 8, , , "Properties", CTBCheck Or CTBAutoSize,
       "Properties"
      .AddButton "", -1, , , , CTBSeparator
      .AddButton "Print", 13, , , "Print", CTBDropDownArrow Or CTBAutoSize,
       "Print"
      .AddButton "", -1, , , , CTBSeparator
      .AddButton "Toggle New", 14, , , "New", CTBCheckGroup Or CTBAutoSize,
       "New"
      .AddButton "Toggle Stop", 15, , , "Stop", CTBCheckGroup Or CTBAutoSize,
       "Stop"
   
   End With
   '
    ----------------------------------------------------------------------------
   --------
   
   '
    ----------------------------------------------------------------------------
   --------
   ' 2) This toolbar uses an image list with 16x16 buttons and no text
   With cToolbar2
      
      .ImageSource = CTBExternalImageList
      .DrawStyle = CTBDrawOfficeXPStyle
      
      .CreateToolbar 16, , , True
      
      .SetImageList m_cIls.hIml
      
      .AddButton "New", 11, , , "", CTBDropDown
      .AddButton "Open", 12, , , "", CTBNormal
      .AddButton "Save", 13, , , ""
      .AddButton "", -1, , , , CTBSeparator
      .AddButton "Cut", 5, , , ""
      .AddButton "Copy", 6, , , ""
      .AddButton "Paste", 7, , , ""
      .AddButton "", -1, , , , CTBSeparator
      .AddButton "CheckBox", 15, , , "", CTBCheck
      .AddButton "", -1, , , , CTBSeparator
      .AddButton "Print", 20, , , "", CTBDropDown
      .AddButton "", -1, , , , CTBSeparator
      .AddButton "Help", 16, , , "", CTBCheckGroup
      .AddButton "Find", 17, , , "", CTBCheckGroup
   
   End With
   '
    ----------------------------------------------------------------------------
   --------
   
   '
    ----------------------------------------------------------------------------
   --------
   ' 3) This toolbar is a 16x16 icon list style toolbar with
   ' automatically sized buttons.  The image used is the standard Favourites
   ' folder image, but can be easily switched to a better icon.
   ' Note: Standard bitmap resources do not appear in v4.70
   With cToolbar3
      
      .ImageSource = CTBExternalImageList
      .SetImageList m_cSysIls.hIml
      .ImageStandardBitmapType = CTBHistorySmallColor
      .DrawStyle = CTBDrawOfficeXPStyle
      
      .CreateToolbar 16, True, True, True
      
      .AddButton "Go to the vbAccelerator site", m_cSysIls.ItemIndex("*.htm"),
       , , "vbAccelerator", CTBNormal Or CTBAutoSize, "vbAccelerator"
      .AddButton "Visit MSDN", m_cSysIls.ItemIndex("*.htm"), , , "MSDN Online",
       CTBNormal Or CTBAutoSize, "MSDN"
      .AddButton "Go to MS Site Builder Network", m_cSysIls.ItemIndex("*.htm"),
       , , "Site Builder Network", CTBNormal Or CTBAutoSize, "SBN"
      .AddButton "Check out VBNet", m_cSysIls.ItemIndex("*.htm"), , , "VBNet",
       CTBNormal Or CTBAutoSize, "VBNet"
      .AddButton "Visit the Common Controls Replacement Project",
       m_cSysIls.ItemIndex("*.htm"), , , "CCRP", CTBNormal Or CTBAutoSize,
       "CCRP"
   
   End With
   '
    ----------------------------------------------------------------------------
   --------


   ' Add some test items to the style combo box:
   For i = 1 To cToolbar1.ButtonCount
      cboStyle.AddItem cToolbar1.ButtonCaption(i - 1)
   Next i
   cboStyle.Text = ""
         
   '
    ----------------------------------------------------------------------------
   --------
   ' Create the Menu for the form:
   tbrMenu.DrawStyle = CTBDrawOfficeXPStyle
   ' Note that there is also a CreateFromMenu2 option
   ' which allows you to create menus from a specified sub-menu
   ' within a cPopupMenu object.
   tbrMenu.CreateFromMenu m_cMenu
   
   '
    ----------------------------------------------------------------------------
   --------
    
   
   '
    ----------------------------------------------------------------------------
   --------
   ' Now add the combo box, the toolbars and the menu bar to the rebar,
   ' setting a background bitmap for the rebar:
    With cReBar1
      
      ' a) Create the rebar:
      .ImageSource = CRBLoadFromFile
      .CreateRebar Me.hwnd
      
      ' b) Add the toolbar & combo boxes.
      ' When you add a band, the rebar automatically sets the IdealWidth
      ' to the size of the object you've added, and makes the Minimum
      ' size the same.  By allowing a smaller minimum size, the rebar
      ' will show a chevron when the band is reduced.
      
      ' i) Add the menu:
      .AddBandByHwnd tbrMenu.hwnd, , , , "MenuBar"
      .BandChildMinWidth(.BandCount - 1) = 24
      
      ' i) Add the 24x24 toolbar with text:
      .AddBandByHwnd cToolbar1.hwnd, , , , "Toolbar1"
      .BandChildMinWidth(.BandCount - 1) = 24
      
      ' iii) Add the logo:
      If (lMajor > 4) Or (lMinor > 70) Then          ' Fixed toolbars are not
       allowed with COMMCTRL before 4.71
         .AddBandByHwnd picTest.hwnd, , False, True, "Logo"
      End If
      
      ' iv) Add the 16x16 toolbar with no text:
      .AddBandByHwnd cToolbar2.hwnd, , , , "Toolbar2"
      .BandChildMinWidth(.BandCount - 1) = 24
      
      ' v) Add the combo box.  In this case we tell the rebar not
      '    to show a chevron at all. The rebar will stretch the
      '    combo between the minimum size and the current size of
      '    the bar
      .AddBandByHwnd cboStyle.hwnd, "Style", False, , "Stylebar"
      .BandChildMinWidth(.BandCount - 1) = 64
      .BandChevron(.BandCount - 1) = False
      
      ' vi) Add the list style toolbar:
      .AddBandByHwnd cToolbar3.hwnd, "Links", , , "Toolbar3"
      .BandChildMinWidth(.BandCount - 1) = 24
      
    End With
   '
    ----------------------------------------------------------------------------
   --------
    
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
   ' For safety, ensure that the Rebar doesn't have any
   ' child windows before terminating.  This shouldn't be
   ' necessary:
   'cReBar1.RemoveAllRebarBands
End Sub
Private Sub pResize()
Dim lH As Long
On Error Resume Next
   ' Resize the form based on the Rebar height:
   lH = (cReBar1.RebarHeight * Screen.TwipsPerPixelY)
   
   Select Case cReBar1.Position
   Case erbPositionTop
      lstNotes.Move _
         Screen.TwipsPerPixelX * 2, _
         lH + 3 * Screen.TwipsPerPixelY, _
         Me.ScaleWidth - 4 * Screen.TwipsPerPixelX, _
         Me.ScaleHeight - lH - 5 * Screen.TwipsPerPixelY
   Case erbPositionRight
      lstNotes.Move _
         Screen.TwipsPerPixelX * 2, _
         Screen.TwipsPerPixelY * 2, _
         Me.ScaleWidth - lH - 4 * Screen.TwipsPerPixelX, _
         Me.ScaleHeight - 4 * Screen.TwipsPerPixelY
   Case erbPositionLeft
      lstNotes.Move _
         lH + 2 * Screen.TwipsPerPixelX, _
         2 * Screen.TwipsPerPixelY, _
         Me.ScaleWidth - lH - 4 * Screen.TwipsPerPixelX, _
         Me.ScaleHeight - 4 * Screen.TwipsPerPixelY
   Case erbPositionBottom
      lstNotes.Move _
         Screen.TwipsPerPixelX * 2, _
         Screen.TwipsPerPixelY * 2, _
         Me.ScaleWidth - 2 * Screen.TwipsPerPixelX, _
         Me.ScaleHeight - lH - 5 * Screen.TwipsPerPixelY
   End Select
   txtNotes.Move lstNotes.left, lstNotes.tOp, lstNotes.Width, lstNotes.Height
End Sub
Private Sub Form_Resize()
   ' Make sure the rebar is the correct width:
   cReBar1.RebarSize
   ' Resize the other items on the form:
   pResize
End Sub

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

Private Sub m_cMenu_Click(ItemNumber As Long)
Dim sKey As String
   
   sKey = m_cMenu.ItemKey(ItemNumber)
   'Debug.Print "Click:", sKey
   
   Select Case True
   Case left$(sKey, 7) = "mnuFile"
      pFileMenu ItemNumber, sKey
   Case left$(sKey, 7) = "mnuView"
      pViewMenu ItemNumber, sKey
   Case left$(sKey, 7) = "mnuTest"
      Indicate "Click:" & sKey
   Case left$(sKey, 9) = "mnuButton"
      pButtonMenu ItemNumber, sKey
   Case left$(sKey, 11) = "mnuPosition"
      pPositionMenu ItemNumber, sKey
   Case sKey = "mnuHelp(3)"
      Dim fA As frmAbout
      Set fA = New frmAbout
      fA.Show vbModal, Me
   End Select
   
End Sub
Private Function plGetIndexFromKey(ByVal sKey As String) As Long
Dim iPos As Long
Dim iNextPos As Long
   iPos = InStr(sKey, "(")
   If iPos > 0 Then
      iNextPos = InStr(iPos, sKey, ")")
      If iNextPos > 0 Then
         plGetIndexFromKey = Mid$(sKey, iPos + 1, iNextPos - iPos - 1)
      End If
   End If
End Function

Private Sub pButtonMenu(ByVal lIndex As Long, ByVal sKey As String)
Dim bState As Boolean
Dim sCap As String
Dim l As Long, lW As Long
Dim lItemIndex As Long
   
   lItemIndex = plGetIndexFromKey(sKey)
   
   Select Case lItemIndex
   Case 0
      ' Hiding buttons.  This is much smoother than the VB
      ' toolbar version where you can't do this without
      ' removing the button!
      bState = Not (m_cMenu.Checked(lIndex))
      m_cMenu.Checked(lIndex) = bState
      cToolbar1.ButtonVisible(1) = bState
      
      ' Tell the rebar the new size of the band:
      lW = cToolbar1.ToolbarWidth
      l = cReBar1.BandIndexForData("Toolbar1")
      cReBar1.BandChildIdealWidth(l) = lW
      cReBar1.RebarSize
   Case 1
      ' Enable a button.  Better than the VB toolbar because
      ' it doesn't cause all the buttons to be removed and
      ' then added again:
      bState = Not (m_cMenu.Checked(lIndex))
      m_cMenu.Checked(lIndex) = bState
      cToolbar1.ButtonEnabled(1) = bState
   Case 3
      ' Reset the caption of a button.  Demonstrates the button
      ' Autosizing feature which you can't get in the VB version.
      ' Also, only one button is removed to achieve this effect,
      ' rather than the whole toolbar being recreated as in the
      ' VB toolbar:
      If (cToolbar1.ButtonCaption(1) = "&This is a long caption") Then
         cToolbar1.ButtonCaption(1) = "Open"
      Else
         cToolbar1.ButtonCaption(1) = "&This is a long caption"
      End If
   Case 4
      If (cToolbar1.ButtonCaption(0) = "&Test Change Button 1") Then
         cToolbar1.ButtonCaption(0) = "New"
      Else
         cToolbar1.ButtonCaption(0) = "&Test Change Button 1"
      End If
      
   Case 6
      ' Change the button image.  Better than the VB toolbar because
      ' it doesn't cause all the buttons to be removed and
      ' then added again:
      cToolbar1.ButtonImage(1) = Rnd * 8
   Case 7
      ' Check a button.  Better than the VB toolbar because
      ' it doesn't cause all the buttons to be removed and
      ' then added again:
      bState = Not (m_cMenu.Checked(lIndex))
      m_cMenu.Checked(lIndex) = bState
      cToolbar1.ButtonChecked(15) = bState
      
   Case 9
      ' Insert a new button
      sCap = "Test" & cToolbar1.ButtonCount
      cToolbar1.AddButton sCap, 1, 3, , sCap, CTBNormal Or CTBAutoSize,
       "NewButton" & cToolbar1.ButtonCount
      
      ' Tell the rebar the new size of the band:
      lW = cToolbar1.ToolbarWidth
      l = cReBar1.BandIndexForData("Toolbar1")
      cReBar1.BandChildIdealWidth(l) = lW
      cReBar1.RebarSize
      
   Case 11
      ' Show button captions.  In a list style toolbar you can individually
      ' set caption visibility, but in a standard style bar setting visibility
      ' for *any* button automatically affects all the others (it would look
      ' stupid otherwise!)
      bState = Not (m_cMenu.Checked(lIndex))
      m_cMenu.Checked(lIndex) = bState
      cToolbar1.ButtonTextVisible(0) = bState
      
      ' Now we want to tell the rebar that the item has changed in size:
      ' Find the index of the bar within the rebar:
      lIndex = cReBar1.BandIndexForData("Toolbar1")
      cReBar1.BandChildResized lIndex, cToolbar1.ToolbarWidth,
       cToolbar1.ToolbarHeight
      cReBar1.BandChildMinWidth(lIndex) = 24
      cReBar1.RebarSize
   End Select

End Sub

Private Function calcToolbarHeight(ByRef cT As cToolbar) As Long
Dim i As Long
   i = cT.ButtonCount - 1
   calcToolbarHeight = cT.ButtonTop(i) + cT.ButtonHeight(i)
End Function

Private Sub pPositionMenu(ByVal lIndex As Long, ByVal sKey As String)
Dim i As Long
Dim lItemIndex As Long

   ' Stop flickering during the update:
   LockWindowUpdate Me.hwnd
   
   '
    ----------------------------------------------------------------------------
   ---------------
   ' Get the particular position menu item which has been clicked:
   lItemIndex = CLng(Mid$(sKey, 13, 1))
   '
    ----------------------------------------------------------------------------
   ---------------
   
   '
    ----------------------------------------------------------------------------
   ---------------
   ' Move the rebar, at the same time hide bands which are not relevant to the
    position:
   Select Case lItemIndex
   Case 0 ' top
      cReBar1.BandVisible(cReBar1.BandIndexForData("Stylebar")) = True
      cReBar1.BandVisible(cReBar1.BandIndexForData("picBar")) = True
      cReBar1.BandChildMinHeight(cReBar1.BandIndexForData("MenuBar")) =
       tbrMenu.ToolbarHeight
      cReBar1.Position = erbPositionTop
   Case 1 ' left
      cReBar1.BandVisible(cReBar1.BandIndexForData("Stylebar")) = False
      cReBar1.BandVisible(cReBar1.BandIndexForData("picBar")) = False
      cReBar1.BandChildMinHeight(cReBar1.BandIndexForData("MenuBar")) =
       tbrMenu.MaxButtonWidth
      cReBar1.Position = erbPositionLeft
   Case 2 ' right
      cReBar1.BandVisible(cReBar1.BandIndexForData("Stylebar")) = False
      cReBar1.BandVisible(cReBar1.BandIndexForData("picBar")) = False
      cReBar1.BandChildMinHeight(cReBar1.BandIndexForData("MenuBar")) =
       tbrMenu.MaxButtonWidth
      cReBar1.Position = erbPositionRight
   Case 3 ' bottom
      cReBar1.BandVisible(cReBar1.BandIndexForData("Stylebar")) = True
      cReBar1.BandVisible(cReBar1.BandIndexForData("picBar")) = True
      cReBar1.BandChildMinHeight(cReBar1.BandIndexForData("MenuBar")) =
       tbrMenu.ToolbarHeight
      cReBar1.Position = erbPositionBottom
   End Select
   '
    ----------------------------------------------------------------------------
   ---------------
   
   '
    ----------------------------------------------------------------------------
   ---------------
   ' Now set all the display properties so we can see the
   If lItemIndex = 1 Or lItemIndex = 2 Then
      
      ' left/right.  Note that the meanings of "Width" & "Height" are swapped
      ' when a rebar is aligned to the left or right.
      
      ' a) Turn off text in list style bar:
      For i = 0 To cToolbar3.ButtonCount - 1
         cToolbar3.ButtonTextVisible(i) = False
      Next i
      ' b) Set minimum width of bands:
      cReBar1.BandChildMinHeight(cReBar1.BandIndexForData("Toolbar1")) =
       cToolbar1.ButtonWidth(4)
      cReBar1.BandChildMinHeight(cReBar1.BandIndexForData("Toolbar2")) =
       cToolbar2.ButtonWidth(4)
      cReBar1.BandChildMinHeight(cReBar1.BandIndexForData("Toolbar3")) =
       cToolbar3.ButtonWidth(4)
      ' c) Set new ideal size of bands:
      cReBar1.BandChildIdealWidth(cReBar1.BandIndexForData("MenuBar")) =
       calcToolbarHeight(tbrMenu)
      cReBar1.BandChildIdealWidth(cReBar1.BandIndexForData("Toolbar1")) =
       calcToolbarHeight(cToolbar1)
      cReBar1.BandChildIdealWidth(cReBar1.BandIndexForData("Toolbar2")) =
       calcToolbarHeight(cToolbar2)
      cReBar1.BandChildIdealWidth(cReBar1.BandIndexForData("Toolbar3")) =
       calcToolbarHeight(cToolbar3)
      ' d) Make menus show to side
      tbrMenu.DropDownAlign = CTBDropDownAlignLeft
      cToolbar1.DropDownAlign = CTBDropDownAlignLeft
   
   Else
      ' top/bottom
      
      ' a) Turn on text in list style bar:
      For i = 0 To cToolbar3.ButtonCount - 1
         cToolbar3.ButtonTextVisible(i) = True
      Next i
      ' b) Set minimum Height of bands:
      cReBar1.BandChildMinHeight(cReBar1.BandIndexForData("Toolbar1")) =
       cToolbar1.MaxButtonHeight
      cReBar1.BandChildMinHeight(cReBar1.BandIndexForData("Toolbar2")) =
       cToolbar2.MaxButtonHeight
      cReBar1.BandChildMinHeight(cReBar1.BandIndexForData("Toolbar3")) =
       cToolbar3.MaxButtonHeight
      ' c) Set ideal size of bands:
      cReBar1.BandChildIdealWidth(cReBar1.BandIndexForData("MenuBar")) =
       tbrMenu.ToolbarWidth
      cReBar1.BandChildIdealWidth(cReBar1.BandIndexForData("Toolbar1")) =
       cToolbar1.ToolbarWidth
      cReBar1.BandChildIdealWidth(cReBar1.BandIndexForData("Toolbar2")) =
       cToolbar2.ToolbarWidth
      cReBar1.BandChildIdealWidth(cReBar1.BandIndexForData("Toolbar3")) =
       cToolbar3.ToolbarWidth
      ' d) Make menus show to bottom
      tbrMenu.DropDownAlign = CTBDropDownAlignBottom
      cToolbar1.DropDownAlign = CTBDropDownAlignBottom
      
   End If
   '
    ----------------------------------------------------------------------------
   ---------------
   
   '
    ----------------------------------------------------------------------------
   ---------------
   ' set the appropriate position option
   m_cMenu.GroupToggle m_cMenu.IndexForKey("mnuPosition(" & lItemIndex & ")")
   '
    ----------------------------------------------------------------------------
   ---------------
   
   ' reset update lock
   LockWindowUpdate 0
   
End Sub

Private Sub m_cMenu_InitPopupMenu(ParentItemNumber As Long)
   Indicate "InitPopupMenu with parent " & m_cMenu.ItemKey(ParentItemNumber)
End Sub

Private Sub m_cMenu_UnInitPopupMenu(ParentItemNumber As Long)
   Indicate "UninitPopupMenu with parent " & m_cMenu.ItemKey(ParentItemNumber)
End Sub

Private Sub tbrMenu_ButtonClick(ByVal lButton As Long)
   m_cMenu.Checked(m_cMenu.IndexForKey("mnuButton(4)")) =
    cToolbar1.ButtonChecked(15)
End Sub