VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "SAToolbar"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Attribute VB_Ext_KEY = "SavedWithClassBuilder6" ,"Yes"
Attribute VB_Ext_KEY = "Top_Level" ,"Yes"
Option Explicit

Public WithEvents m_objToolBar As XtremeCommandBars.CommandBars
Attribute m_objToolBar.VB_VarHelpID = -1
Private WithEvents m_objWorkspace As XtremeCommandBars.TabWorkspace
Attribute m_objWorkspace.VB_VarHelpID = -1

Private m_cbLastActiveCommandBar As XtremeCommandBars.CommandBar
Private m_LastLoadedDockState As String
Private m_blnIsUserTBFile As Boolean

Public Event BandHide(ByVal Band As SAToolbarBand)
Public Event BandShow(ByVal Band As SAToolbarBand)
Public Event PopupBandOpen(ByVal Band As SAToolbarBand)
Public Event ComboSelChange(ByVal Tool As SAToolbarTool)
Public Event Error(ByVal Number As Integer, _
                      ByRef Description As String, _
                      ByVal Scode As Long, _
                      ByVal source As String, _
                      ByVal HelpFile As String, _
                      ByVal HelpContext As Long, _
                      ByRef CancelDisplay As Boolean)
Public Event ToolLostFocus(ByVal Tool As SAToolbarTool)
Public Event Click(ByVal Tool As SAToolbarTool)
Public Event Reset(ByVal BandName As String)
                      
Private m_colBands As New SAToolbarBands
Private m_colTools As New SAToolbarTools
Private m_colExtendedTools As New SAToolBarExtensions
                  
Private m_blnRecalcOff As Boolean
                  
Private Const FNONE = 0
Private Const FSHIFT = 4
Private Const FCONTROL = 8
Private Const FALT = 16
Private Const MENU_MAXPOPUPWIDTH = 5
          
Public Enum SATOOLBAR_ROSTATE   ' Note the ROState property should ONLY be used with sadesign based menu items, as sadesign is used as the master when the RO/RW state is flipped
    SATOOLBAR_ROSTATE_NORMAL = 0
    SATOOLBAR_ROSTATE_DISABLED = 1
    SATOOLBAR_ROSTATE_HIDDEN = 2
End Enum
Public Enum SATOOLBAR_DOCKINGAREA
    SATB_DA_Top = 1
    SATB_DA_Bottom = 2
    SATB_DA_Left = 4
    SATB_DA_Right = 8
    SATB_DA_Float = 16
    SATB_DA_Popup = 32
End Enum
Public Enum SATOOLBAR_STYLES
    SATB_ST_Standard = 0
    SATB_ST_Text = 1
    SATB_ST_Icon = 2
    SATB_ST_IconText = 3
End Enum
Public Enum SATOOLBAR_ALIGNMENT
    SATB_AL_LeftTop = 0
    SATB_AL_CenterTop = 1
    SATB_AL_RightTop = 2
    SATB_AL_LeftCenter = 3
    SATB_AL_CenterCenter = 4
    SATB_AL_RightCenter = 5
    SATB_AL_LeftBottom = 6
    SATB_AL_CenterBottom = 7
    SATB_AL_RightBottom = 8
End Enum
Public Enum SATOOLBAR_BANDTYPE
    SATB_BT_NORMAL = 0
    SATB_BT_MENU = 1
    SATB_BT_POPUP = 2
End Enum
Public Enum SATOOLBAR_TOOLTYPE
    SATB_TT_BUTTON = 0
    SATB_TT_BUTTONDROPDOWN = 1  ' Implemented same as TEAROFFPOPUP but has behavior in Do_Check_Menu_Proc to update root menuitem bitmap
    SATB_TT_COMBOBOX = 2
    SATB_TT_EDIT = 3
    SATB_TT_STATIC = 4
    SATB_TT_BUTTONPOPUP = 5
    SATB_TT_TEAROFFPOPUP = 6
    SATB_TT_COLORPICKER = 7
    SATB_TT_CUSTOM = 8
End Enum
                  
Const SAIDM_CODEJOCKCUSTOMIZE = 35001   ' Special CodeJock tool - should not be called directly - use the user one below
                  
Const MINDELAYPERIOD = 100      ' This is used if an instant update is required
Const MAXDELAYPERIOD = 600000   ' Delay 10 minutes before updating

Private NextInternalToolID As Long 'Next toolID to use

Private m_blnMenuDoUpdate As Boolean
Private m_blnMenuUpdating As Boolean


Public Function GetCurrentSelectedToolType() As SATOOLBAR_TOOLTYPE
Dim objSelectedControl As CommandBarControl

    On Error GoTo ErrOut
    
    GetCurrentSelectedToolType = -1
    
    If Not m_objToolBar.FocusedCommandBar Is Nothing Then
        Set objSelectedControl = m_objToolBar.FocusedCommandBar.SelectedControl
        If Not objSelectedControl Is Nothing Then
            Select Case objSelectedControl.Type
                Case xtpControlButton
                    GetCurrentSelectedToolType = SATB_TT_BUTTON
                Case xtpControlButtonPopup
                    GetCurrentSelectedToolType = SATB_TT_BUTTONPOPUP
                Case xtpControlComboBox
                    GetCurrentSelectedToolType = SATB_TT_COMBOBOX
                Case xtpControlCustom
                    GetCurrentSelectedToolType = SATB_TT_CUSTOM
                Case xtpControlEdit
                    GetCurrentSelectedToolType = SATB_TT_EDIT
                Case Else
                    GetCurrentSelectedToolType = -1
            End Select
        End If
    End If
    
StdExit:
    On Error GoTo 0
    Exit Function
ErrOut:
    Err.Clear
    Resume StdExit
End Function

' RE above, for getting selected tool when handling search combo keypresses; ActiveTool won't work because
'ATB is not swallowing keypresses.
Public Function GetCurrentSelectedTool() As SAToolbarTool
    Dim objCommandBar As XtremeCommandBars.CommandBar
    Dim objActiveControl As XtremeCommandBars.CommandBarControl
    
    On Error Resume Next
    Set objCommandBar = m_objToolBar.FocusedCommandBar
    If Not objCommandBar Is Nothing Then
        Set objActiveControl = objCommandBar.SelectedControl
        If Not objActiveControl Is Nothing Then
            Set GetCurrentSelectedTool = GetToolFromControl(objActiveControl)
        End If
    End If
    On Error GoTo 0
End Function

' IsTool - Finds a tool by it's toolID, returns True if it exists or False otherwise
Public Function IsTool(ByVal v_lngToolID As Long) As Boolean
    Dim objControl As XtremeCommandBars.CommandBarControl
    
    On Error Resume Next
    Set objControl = m_objToolBar.DesignerControls.Find(, v_lngToolID)
    On Error GoTo 0
    If Not objControl Is Nothing Then
        IsTool = True
    End If
End Function

' Returns True if a menu is dropped down and the toolbar is swallowing all keypresses
Public Property Get IsEatingKeypresses() As Boolean
    Dim objSelectedControl As CommandBarControl
    If Not m_objToolBar.FocusedCommandBar Is Nothing Then
        Set objSelectedControl = m_objToolBar.FocusedCommandBar.SelectedControl
        If objSelectedControl Is Nothing Then
            ' No selected control - say we are eating keypressed
            IsEatingKeypresses = True
        ElseIf Not ((objSelectedControl.Type = xtpControlComboBox) Or (objSelectedControl.Type = xtpControlEdit) Or (objSelectedControl.Type = xtpControlCustom)) Then
            ' The selected control is not one which can accept keypresses - say we are eating keypresses
            IsEatingKeypresses = True
        End If
    End If
End Property
                 
Public Function GetIDFromName(ByVal Name As String) As Long
    Dim cbc As CommandBarControl
    
    For Each cbc In m_objToolBar.DesignerControls
        If cbc.Parameter = Name Then
            GetIDFromName = cbc.Id
            Exit Function
        End If
    Next
End Function

Public Function GetToolFromName(ByVal Name As String) As CommandBarControl
    Dim cbc As CommandBarControl
    
    For Each cbc In m_objToolBar.DesignerControls
        If cbc.Parameter = Name Then
            Set GetToolFromName = cbc
            Exit Function
        End If
    Next
End Function
                  
Public Property Get Bands() As SAToolbarBands
    Set Bands = m_colBands
End Property
Public Property Get Tools() As SAToolbarTools
    Set Tools = m_colTools
End Property
Public Property Get ExtensionTools() As SAToolBarExtensions
    Set ExtensionTools = m_colExtendedTools
End Property

Public Property Get ActiveTool() As SAToolbarTool
    Dim objCommandBar As XtremeCommandBars.CommandBar
    Dim objActiveControl As XtremeCommandBars.CommandBarControl
    
    If IsEatingKeypresses Then
        On Error Resume Next
        Set objCommandBar = m_objToolBar.FocusedCommandBar
        If Not objCommandBar Is Nothing Then
            Set objActiveControl = objCommandBar.SelectedControl
            If Not objActiveControl Is Nothing Then
                Set ActiveTool = GetToolFromControl(objActiveControl)
            End If
        End If
        On Error GoTo 0
    Else
        On Error Resume Next
        For Each objCommandBar In m_objToolBar
            Set objActiveControl = objCommandBar.SelectedControl
            If Not objActiveControl Is Nothing Then
                Set ActiveTool = GetToolFromControl(objActiveControl)
                Exit For
            End If
        Next
        On Error GoTo 0
    End If
End Property

Private Sub AddDefaultTool(ByRef r_objXMLElem As IXMLDOMElement, Optional ByVal v_blnExtension As Boolean = False)
    Dim objTool As SAToolbarTool
    Dim objBand As SAToolbarBand
    Dim strSubBand As String
    Dim lngCtrlType As Long
    Dim blnHidden As Boolean
    Dim strToolName As String
    Dim objExtension As IXMLDOMElement
    Dim objTBExtension As SAToolBarExtension
    Dim objImageNode As IXMLDOMElement
    Dim pic As IPictureDisp
    Dim lngWidth As Long
    Dim str As String

    On Error Resume Next
    strSubBand = r_objXMLElem.getAttribute("SubBand") 'DEV_STRING
    On Error GoTo 0
    
    On Error Resume Next
    lngCtrlType = CLng(r_objXMLElem.getAttribute("ControlType")) 'DEV_STRING
    If Err.Number <> 0 Then
        If strSubBand <> SA_VB_EmptyString Then
            ' There is a subband so create a popup tool
            lngCtrlType = SATB_TT_BUTTONPOPUP
        Else
            lngCtrlType = SATB_TT_BUTTON
        End If
    End If
    On Error GoTo 0
        
    If lngCtrlType = SATB_TT_COLORPICKER Then
        If v_blnExtension Then
            Exit Sub ' not yet supported
        End If
        strToolName = r_objXMLElem.getAttribute("Name") 'DEV_STRING
        Set objTool = AddColorPicker(r_objXMLElem.getAttribute("ToolID"), strToolName, GetToolCaptionString(strToolName)) 'DEV_STRING
    Else
        If v_blnExtension Then
            Set objExtension = r_objXMLElem.parentNode.parentNode
            Set objTBExtension = m_colExtendedTools.Add(m_colTools, r_objXMLElem.getAttribute("ToolID"), objExtension.getAttribute("ExtensionGUID")) 'DEV_STRING
            strToolName = GetToolBarExtensionToolNameInternal(objTBExtension.ExtensionGuid, objTBExtension.ExtensionToolID)
            Set objTool = m_colTools.AddMainTool(objTBExtension.InternalToolID, strToolName, r_objXMLElem.getAttribute("Caption"), lngCtrlType) 'DEV_STRING
            objTool.IsExtension = True
            Set objTBExtension.SATBTool = objTool
        Else
            Set objTool = m_colTools.AddMainTool(r_objXMLElem.getAttribute("ToolID"), r_objXMLElem.getAttribute("Name"), r_objXMLElem.getAttribute("Caption"), lngCtrlType) 'DEV_STRING
        End If
    End If
    
    On Error Resume Next
    str = ""
    str = r_objXMLElem.getAttribute("IconID")
    On Error GoTo 0
    If str <> "" Then
        On Error Resume Next
        objTool.iconID = val(str)
        objTool.SetPicture
        On Error GoTo 0
    End If
    
    If lngCtrlType = SATB_TT_COMBOBOX Then
        Dim strComboStyle As String
        On Error Resume Next
        lngWidth = r_objXMLElem.getAttribute("Width") ' default if it fails
        If lngWidth > 0 Then
            objTool.CBWidth = lngWidth
        End If
        strComboStyle = r_objXMLElem.getAttribute("ComboStyle") 'DEV_STRING
        On Error GoTo 0
        If 0 = StrComp(strComboStyle, "List", vbTextCompare) Then 'DEV_STRING
            objTool.Tool.DropDownListStyle = False ' false = list
        Else
            objTool.Tool.DropDownListStyle = True ' true = combo
        End If
    End If
    
    If lngCtrlType = SATB_TT_EDIT Then
        On Error Resume Next
        lngWidth = r_objXMLElem.getAttribute("Width") ' default if it fails
        If lngWidth > 0 Then
            objTool.EditWidth = lngWidth
        End If
    End If
    
    objTool.Caption = r_objXMLElem.getAttribute("Caption") 'DEV_STRING
    On Error Resume Next
    objTool.Alignment = r_objXMLElem.getAttribute("Alignment") 'DEV_STRING
    objTool.Category = r_objXMLElem.getAttribute("Category") 'DEV_STRING
    objTool.Checked = r_objXMLElem.getAttribute("Checked") 'DEV_STRING
    objTool.Description = r_objXMLElem.getAttribute("Description") 'DEV_STRING
    objTool.Enabled = r_objXMLElem.getAttribute("Enabled") 'DEV_STRING
    objTool.HelpContextID = r_objXMLElem.getAttribute("HelpContextID") 'DEV_STRING
    objTool.MacroArgument = r_objXMLElem.getAttribute("MacroArgs") 'DEV_STRING
    objTool.ROState = r_objXMLElem.getAttribute("ROState") 'DEV_STRING
    objTool.Style = r_objXMLElem.getAttribute("Style") 'DEV_STRING
    objTool.Text = r_objXMLElem.getAttribute("Text") 'DEV_STRING
    objTool.ToolTipText = r_objXMLElem.getAttribute("ToolTipText") 'DEV_STRING
    objTool.Visible = r_objXMLElem.getAttribute("Visible") 'DEV_STRING
    
    If r_objXMLElem.childNodes.Length > 0 Then
        ' may be an image node, expects the on error resume next above to be in force
        'NOTE: XPath does not seem to like the image data in the text part of the following node
        '       We'll check the names of the nodes manually, it's unlikely there will be more than one
        Set objImageNode = r_objXMLElem.selectSingleNode("ExtensionImage") 'DEV_STRING
        If Not objImageNode Is Nothing Then
            Set pic = SA_Util_PictureFromByteArray(SA_Util_DecodeBase64(objImageNode.nodeTypedValue))
            objTool.SetPicture pic
        End If
    End If
    
    If objTool.Visible Then
        objTool.UpdateFlags = MENUTOOL_VISIBLEATSTARTUP
    End If
    
    objTool.UpdateFlags = objTool.UpdateFlags Or MENUTOOL_INSERTEDINMENU    ' Every item load is in the toolbar already
    
    blnHidden = CBool_English(r_objXMLElem.getAttribute("Hidden")) 'DEV_STRING
    If blnHidden Then
        m_objToolBar.Options.AddHiddenCommand objTool.toolID
    End If
    On Error GoTo 0
End Sub

Private Function GetToolFromCollection(ByVal v_strName As String, ByVal v_lngToolID As Long, ByRef r_objExtension As IXMLDOMElement)
    Dim objTool As SAToolbarTool
    
    On Error Resume Next
    Set objTool = m_colTools(v_strName) 'DEV_STRING
    
    If Not r_objExtension Is Nothing Then
        If Not objTool Is Nothing Then
            If objTool.toolID <> v_lngToolID Then
                ' tool name and tool ID are NOT the same as a standard tool, assume the entry referes to an external tool
                Set objTool = Nothing
            End If
        End If
        If objTool Is Nothing Then
            Set objTool = m_colTools(GetToolBarExtensionToolNameInternal(r_objExtension.getAttribute("ExtensionGUID"), v_lngToolID)) 'DEV_STRING
        End If
    End If
    
    Set GetToolFromCollection = objTool
End Function

Private Sub AddDefaultBand(ByRef r_objXMLElem As IXMLDOMElement, ByVal v_blnIsExtensionFile As Boolean)
    Dim objToolElem As IXMLDOMElement
    Dim objBandElem As IXMLDOMElement
    Dim objPrevToolElem As IXMLDOMElement
    Dim objTools As IXMLDOMNodeList
    Dim objBands As IXMLDOMNodeList
    Dim objSubBand As SAToolbarBand
    Dim blnBeginGroup As Boolean
    Dim strCaption As String
    
    Dim objBand As SAToolbarBand
    Dim objTool As SAToolbarTool
    Dim objNewTool As SAToolbarTool
    Dim enuType As SATOOLBAR_BANDTYPE
    Dim strSubBand As String
    Dim blnVisible As Boolean
    Dim strPreviousID As String
    Dim lngPreviousID As Long
    Dim lngPrevIndex As Long
    Dim objExtension As IXMLDOMElement
    Dim lngToolID As Long
    Dim strName As String
    
    enuType = r_objXMLElem.getAttribute("Type") 'DEV_STRING
    If v_blnIsExtensionFile Then
        Set objExtension = r_objXMLElem.parentNode.parentNode ' back to SAToolbarExtension node
    End If
    
    strName = r_objXMLElem.getAttribute("Name") 'DEV_STRING
    If enuType = SATB_BT_POPUP Then
        On Error Resume Next
        If v_blnIsExtensionFile Then
            lngToolID = r_objXMLElem.getAttribute("ToolID") 'DEV_STRING
        End If
        On Error GoTo 0
        Set objTool = GetToolFromCollection(strName, lngToolID, objExtension)
        If objTool Is Nothing Then
            Exit Sub ' exit if tool does not exist
        End If
        lngToolID = objTool.toolID ' ensures we have a tool id for the pop up, only set above for extensions
    Else
        lngToolID = 0
    End If
    
    If v_blnIsExtensionFile Then
        On Error Resume Next
        Set objBand = m_colBands.Item(strName)
        On Error GoTo 0
        If objBand Is Nothing Then
            'a new band for the extension
            If SATB_BT_POPUP = enuType Then
                ' needs to match the toolid and is never displayed
                strName = GetToolBarExtensionToolNameInternal(objExtension.getAttribute("ExtensionGUID"), r_objXMLElem.getAttribute("ToolID")) 'DEV_STRING
            End If
            Set objBand = m_colBands.Add(strName, enuType, lngToolID)
        End If
    Else
    ' SAToolbarBand.Add copes with duplicate bands
        Set objBand = m_colBands.Add(strName, enuType, lngToolID) 'DEV_STRING
    End If
    
    If enuType <> SATB_BT_POPUP Then
        objBand.Customizable = True
        objBand.Visible = r_objXMLElem.getAttribute("Visible") 'DEV_STRING
        objBand.Wrappable = r_objXMLElem.getAttribute("Wrappable") 'DEV_STRING
        objBand.Caption = r_objXMLElem.getAttribute("Caption") 'DEV_STRING
    End If

    Set objTools = r_objXMLElem.selectNodes("SATool") 'DEV_STRING
    If Not objTools Is Nothing Then
        If objTools.Length > 0 Then
            lngPrevIndex = -1 ' set to -1 tools added at end of band
            For Each objToolElem In objTools
                On Error Resume Next
                strSubBand = ""
                strSubBand = objToolElem.getAttribute("SubBand") 'DEV_STRING
                
                If v_blnIsExtensionFile Then
                    Set objTool = Tools(GetToolBarExtensionToolNameInternal(objExtension.getAttribute("ExtensionGUID"), objToolElem.getAttribute("ToolID"))) 'DEV_STRING
                Else
                    Set objTool = Tools(objToolElem.getAttribute("Name")) 'DEV_STRING
                End If
                If objTool Is Nothing Then
                    If v_blnIsExtensionFile Then
                        ' keep the original name to inform the user of the issue
                        Err.Raise SAERR_TOOLNOTFOUND, "AddDefaultBand", SAXRes.FormatLocalString(SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____failedaddingtool0toband1toolnotfound), objToolElem.getAttribute("Name"), r_objXMLElem.getAttribute("Name")) 'DEV_STRING
                    Else
                        Exit Sub
                    End If
                End If
                On Error GoTo 0
                
                blnVisible = objTool.Visible    ' Remember the state it gets nuked
                                
                ' read PreviousTooID
                If v_blnIsExtensionFile Then
                    On Error Resume Next
                    strPreviousID = objToolElem.getAttribute("ExtensionPreviousToolID") 'DEV_STRING
                    lngPreviousID = val(strPreviousID)
                    On Error GoTo 0
                    
                    ' get index from ID
                    If lngPreviousID > 0 Then
                        lngPrevIndex = objBand.Tools.IndexOf(lngPreviousID)
                    Else
                        If lngPrevIndex > -1 Then ' has been used
                            lngPrevIndex = lngPrevIndex + 1
                        End If
                    End If
                    Set objNewTool = objBand.Tools.Add(objTool.toolID, objTool.Name, , , , lngPrevIndex) ' lngPrevIndex -1 = end of band
                Else
                    Set objNewTool = objBand.Tools.Add(objTool.toolID, objTool.Name)
                End If
                
                objTool.Visible = blnVisible    ' Reset the state
                
                On Error Resume Next
                blnBeginGroup = False
                blnBeginGroup = objToolElem.getAttribute("BeginGroup") 'DEV_STRING
                On Error GoTo 0
                objNewTool.BeginGroup = blnBeginGroup
                
                On Error Resume Next
                strCaption = "" 'DEV_STRING
                strCaption = objToolElem.getAttribute("Caption") 'DEV_STRING
                On Error GoTo 0
                objNewTool.Caption = strCaption
                
                If strSubBand <> SA_VB_EmptyString Then
                    On Error Resume Next
                    If objTool.IsExtension Then
                        Set objSubBand = m_colBands(GetToolBarExtensionToolNameInternal(objExtension.getAttribute("ExtensionGUID"), ExtensionTools.ItemBySAToolbarID(objTool.toolID).ExtensionToolID)) 'DEV_STRING
                    Else
                        Set objSubBand = m_colBands(objTool.Name)
                    End If
                    If Err.Number <> 0 Then
                        If CmdLineQAReporting Then
                            SAMessageBox SAXRes.FormatLocalString(SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____couldntfindsubbandthexmltoolbarfilemaybeorderedincorrectly0), strSubBand) 'DEV_STRING
                        End If
                    End If
                    On Error GoTo 0
                    If Not objSubBand Is Nothing Then
                        Set objNewTool.SubBand = objSubBand
                    End If
                End If
            Next
        End If
    End If

End Sub

Private Sub MaybeAddSavedTool(ByRef r_objDoc As DOMDocument, ByRef r_objControl As XtremeCommandBars.CommandBarControl)
    Dim objTool As SAToolbarTool
    Dim objBand As SAToolbarBand
    Dim objNode As IXMLDOMElement
    Dim objPNode As IXMLDOMElement
    Dim lngUpdateFlags As Long
    Dim strSubBandName As String
    Dim strArg As String
    Dim strExecCommandID As String
    Dim lngHelpID As Long
    Dim strExtensionGUID As String
    Dim lngExtensionToolID As Long
    Dim strIconID As String
    Dim enuROState As SATOOLBAR_ROSTATE
    Dim strToolID As String
    Dim lToolID As Long
    Dim lIconID As Long
    
    On Error GoTo ErrorHandler
    
    Set objNode = r_objDoc.selectSingleNode("//CommandBar[@Title='Controls']/Controls/Control[@Parameter='" & r_objControl.Parameter & "']/SATags") 'DEV_STRING
    If Not objNode Is Nothing Then
        ' We found the tool and it is an SA Tool
        On Error Resume Next
        lngUpdateFlags = CLng(objNode.getAttribute("UpdateFlags")) 'DEV_STRING
        strSubBandName = objNode.getAttribute("SubBandName") 'DEV_STRING
        strArg = objNode.getAttribute("MacroArgs") 'DEV_STRING
        lngHelpID = objNode.getAttribute("HelpContextID") 'DEV_STRING
        strExecCommandID = objNode.getAttribute("ExecCommandID") 'DEV_STRING
        enuROState = CLng(objNode.getAttribute("ROState")) 'DEV_STRING
        Set objPNode = objNode.parentNode
        strIconID = objPNode.getAttribute("IconId")
        strToolID = objPNode.getAttribute("Id")
        lToolID = val(strToolID)
        lIconID = val(strIconID)
        
        ' check for and update extension tool information
        strExtensionGUID = objNode.getAttribute("ExtensionGUID") 'DEV_STRING
        lngExtensionToolID = CLng(objNode.getAttribute("ExtensionToolId")) 'DEV_STRING

        Set objTool = m_colTools.AddMasterToolFromActualToolbar(r_objControl)
        If lngExtensionToolID > 0 And Len(strExtensionGUID) > 0 Then
            Dim objTBExtension As SAToolBarExtension
            Set objTBExtension = m_colExtendedTools.AddWithInternalToolID(objTool.toolID, lngExtensionToolID, strExtensionGUID)
            objTool.IsExtension = True
            Set objTBExtension.SATBTool = objTool
        End If
        objTool.UpdateFlags = lngUpdateFlags
        objTool.ExecCommandID = strExecCommandID
        objTool.MacroArgument = strArg
        objTool.HelpContextID = lngHelpID
        objTool.ROState = enuROState
        If strIconID <> "" And strToolID <> strIconID Then
            objTool.iconID = lIconID
        End If
        
        If strSubBandName <> SA_VB_EmptyString Then
            Set objBand = Bands(strSubBandName)
            If Not objBand Is Nothing Then
                Set objTool.SubBand = objBand
            End If
        End If
    Else
        If CmdLineQAReporting Then
            SAMessageBox "A tool in the toolbar file is not one of ours = " & r_objControl.Caption 'DEV_STRING
        End If
    End If
    
    Exit Sub
    
ErrorHandler:
    If CmdLineQAReporting Then
        SAMessageBox "An error occurred processing the following tool:" & vbCrLf & "Tool: " & r_objControl.Caption & vbCrLf & "Parameter: " & r_objControl.Parameter + vbCrLf + vbCrLf + Err.Description
    End If

End Sub

Private Sub MaybeAddSavedBand(ByRef r_objXMLElem As IXMLDOMElement)
    Dim objTagNode As IXMLDOMElement
    Dim objSABand As SAToolbarBand
    Dim objCommandBar As XtremeCommandBars.CommandBar
    Dim strTitle As String
    Dim strClass As String
    Dim strName As String
    Dim blnIsPopup As Boolean
    
    On Error Resume Next
    strTitle = ""
    strTitle = r_objXMLElem.getAttribute("Title") 'DEV_STRING
    On Error GoTo 0
    strClass = r_objXMLElem.getAttribute("Class") 'DEV_STRING
    
    Set objTagNode = r_objXMLElem.selectSingleNode("./SATags")  'DEV_STRING
    strName = objTagNode.getAttribute("Name")  'DEV_STRING
    
    If strClass <> "CXTPToolBar" And strClass <> "CXTPMenuBar" Then 'DEV_STRING
        blnIsPopup = True
    End If
    
    Set objSABand = m_colBands.AddMasterBandFromActualToolBar(strName, strTitle, blnIsPopup)
End Sub

Public Property Get IsUserTBFile() As Boolean
    IsUserTBFile = m_blnIsUserTBFile
End Property

Public Sub Load(ByVal v_strFilename As String, ByVal v_strCustomFilename As String)
    Dim objDoc As New DOMDocument
    Dim objElem As IXMLDOMElement
    Dim objNodes As IXMLDOMNodeList
    Dim objNode As IXMLDOMElement
    Dim objControl As XtremeCommandBars.CommandBarControl
    Dim myStateOptions As XtremeCommandBars.StateOptions
    Dim VersionTool As SAToolbarTool
    Dim strTBVersion As String
    Dim lngVirt As Long
    Dim lngKey As Long
    Dim lngToolID As Long
    Dim strLocale As String
    Dim fso As New FileSystemObject
    Dim fldr As Scripting.Folder
    Dim f As File
    Dim strFolder As String
    Dim fileList As New Collection
    Dim strFileName As String
    Dim loopCount As Long
    Dim bDomLoaded As Boolean
    Dim bValidated As Boolean
    Dim strHKkey As String
    Dim strHKvirt As String
    Dim strHKid As String
    Dim strFileToMerge As String
    Dim str As String
    Dim l As Long
    Dim SAMenuFont As StdFont

    On Error GoTo ErrExit
    
    InitColorTools

    m_blnIsUserTBFile = True
    SAXRes.GetLocale strLocale

    m_LastLoadedDockState = SA_VB_EmptyString
    g_strVersion = "V" & App.Major & "_" & App.Minor & "_" & App.Revision 'DEV_STRING

    objDoc.async = False
    objDoc.setProperty "SelectionLanguage", "XPath" 'DEV_STRING
    Set m_objToolBar.Icons = fMainForm.ctlImageMan.Icons

    If Dir(v_strCustomFilename) = SA_VB_EmptyString Then
        v_strCustomFilename = SA_VB_EmptyString
    End If
    
    bInhibitMenuTimer = True    ' No timers while we are loading please
    
    If v_strCustomFilename <> SA_VB_EmptyString Then
        ' Load the user toolbar from the custom file
        If objDoc.Load(v_strCustomFilename) Then
            ' Loaded - check the version
            On Error Resume Next
            
            ' Check the product version
            strTBVersion = ""
            Set objNode = objDoc.selectSingleNode("//CommandBar[@Title='Controls']/Controls/Control[(@Parameter='SAVersion')]") 'DEV_STRING
            strTBVersion = objNode.getAttribute("Caption") 'DEV_STRING
            If IsNewerVersion(strTBVersion, g_strVersion) Then
                                'WI 34332, backing up the sausrtbf in case user wants to copy their customized hotkeys
                Dim strUserFile As String
                strUserFile = GetUserTBFPath()
                FileCopy strUserFile, strUserFile & "." & strTBVersion
                strFileToMerge = v_strCustomFilename
                v_strCustomFilename = SA_VB_EmptyString    ' Must use the default
            End If
            
            ' Check the developer version
            strTBVersion = ""
            Set objNode = objDoc.selectSingleNode("//CommandBar[@Title='Controls']/Controls/Control[(@Parameter='SATBVersion')]") 'DEV_STRING
            strTBVersion = objNode.getAttribute("Caption") 'DEV_STRING
            If CLng(strTBVersion) < CStr(TOOLBARVERSION) Then
                strFileToMerge = v_strCustomFilename
                v_strCustomFilename = SA_VB_EmptyString    ' Must use the default
            End If
            
            ' Check the locale
            strTBVersion = ""
            Set objNode = objDoc.selectSingleNode("//CommandBar[@Title='Controls']/Controls/Control[(@Parameter='SATBLocale')]") 'DEV_STRING
            strTBVersion = objNode.getAttribute("Caption") 'DEV_STRING
            If strTBVersion <> strLocale Then
                strFileToMerge = v_strCustomFilename
                v_strCustomFilename = SA_VB_EmptyString    ' Must use the default
            End If
        Else
            ' Failed to load - we will load the default toolbar
            On Error GoTo ErrExit
            v_strCustomFilename = SA_VB_EmptyString
        End If
        
        If v_strCustomFilename <> SA_VB_EmptyString Then
            ' The user toolbar is good, lets use it
            On Error Resume Next
            
            ' Get the docking system state from the XML - we tuck it in with the toolbar details
            Set objNode = objDoc.selectSingleNode("//DockSystemState") 'DEV_STRING
            m_LastLoadedDockState = objNode.Text
            objNode.parentNode.removeChild objNode
            
            ' Setup the toolID generator
            NextInternalToolID = GetNextInternalToolIDStart(NEXTINTERNALTOOLIDSTART, NEXTINTERNALTOOLIDEND, objDoc)
            ProcessMacroToolsBeforeTBLoad objDoc    ' Ensure the macro tools are upto date before loading into codejock (this ensures icons are renumbered)
            RemoveDrawingTools objDoc   ' Remove any drawing tools from the menus
            
            ' Lets load the user toolbar into the CodeJock toolbar
            Set myStateOptions = CreateStateOptions()
            m_objToolBar.LoadStateFromXMLString "DesignerFile", objDoc.xml, myStateOptions 'DEV_STRING
            If Err.Number = 0 Then
                ' Loaded ok - now update our object model
                On Error GoTo ErrExit
                
                'Reset the collection pointers
                m_colTools.Init SA_VB_EmptyString, m_objToolBar.DesignerControls
                m_colBands.Init m_objToolBar.ActiveMenuBar, m_objToolBar, m_objToolBar.DesignerControls
                
                ' Load up all the bands
                Set objNodes = objDoc.selectNodes("//CommandBars/CommandBar[./SATags[@IsSABand='True']]") 'DEV_STRING
                For Each objNode In objNodes
                    ' Go through all the sa bands in the toolbar XML and fill our toolbar object model
                    On Error Resume Next
                    MaybeAddSavedBand objNode
                    On Error GoTo ErrExit
                Next
                
                ' Load up all the tools
                For Each objControl In m_objToolBar.DesignerControls
                    ' Go through all the main tools from the toolbar - and update our toolbar object model
                    MaybeAddSavedTool objDoc, objControl
                Next
            Else
                ' Failed to load - we will quit
                On Error GoTo ErrExit
                If CmdLineQAReporting Then
                    SAMessageBox SAXRes.FormatLocalString(SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____theusertoolbarfiledidnotloadpleaseforwardittodevelopmentbeforeclosingsa01), vbCrLf, GetUserTBFPath()) 'DEV_STRING
                Else
                    SAMessageBox (SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____unabletoloadtheusertoolbarfilepleaserestartsa))
                    fMainForm.KillUserTBF  ' The codejock system is in a indeterminate state - delete the usertbf
                End If
                End ' Not nice - but this seems the only way out
            End If
        End If
    End If
    
    If v_strCustomFilename = SA_VB_EmptyString Then
        ' Load the default toolbar
        m_blnIsUserTBFile = False

        ' create extension file list
        strFolder = Left$(v_strFilename, InStrRev(v_strFilename, "\")) 'DEV_STRING
        Set fldr = fso.GetFolder(strFolder)

        For Each f In fldr.Files
            strFileName = f.Name
            If 0 = StrComp(Right$(f.Name, 4), ".tbx", vbTextCompare) Then 'DEV_STRING
                fileList.Add f.Path
            End If
        Next
        Set fldr = Nothing
        Set fso = Nothing
        
        loopCount = 0 ' zero identifies default file
        Do
            If 0 = loopCount Then
                ' Loading the main toolbar, so load all tools
                strFileName = v_strFilename
                bDomLoaded = objDoc.Load(strFileName)
                ' Setup the toolID generator
                NextInternalToolID = GetNextInternalToolIDStart(NEXTINTERNALTOOLIDSTART, NEXTINTERNALTOOLIDEND, objDoc)
            Else
                On Error GoTo ExtensionFileError
                strFileName = fileList.Item(loopCount)
                ' check the user xml against the schema
                bValidated = SA_XML_ValidateSchema(strFileName, "MenuExtension.xsd") 'DEV_STRING
                If bValidated Then
                    bDomLoaded = objDoc.Load(strFileName)
                Else
                    bDomLoaded = False
                End If
                ' validate against xsd
            End If
        
            If bDomLoaded Then
                Set objNodes = objDoc.selectNodes("//SATools/SATool") 'DEV_STRING
                If Not objNodes Is Nothing Then
                    If objNodes.Length > 0 Then
                        For Each objElem In objNodes
                            AddDefaultTool objElem, (loopCount > 0)
                        Next
                    End If
                End If
                
                Set objNodes = objDoc.selectNodes("//SABands/SABand") 'DEV_STRING
                If Not objNodes Is Nothing Then
                    If objNodes.Length > 0 Then
                        For Each objElem In objNodes
                            AddDefaultBand objElem, (loopCount > 0)
                        Next
                    End If
                End If
                
                m_colBands.ConfigureDefaultBandLayout
                
                Set objNodes = objDoc.selectNodes("//SATools/SATool[@ShortcutKey != '']") 'DEV_STRING
                If Not objNodes Is Nothing Then
                    If objNodes.Length > 0 Then
                        For Each objElem In objNodes
                            DecodeAccelKey objElem, lngVirt, lngKey, lngToolID
                            If lngKey = VK_F1 Then
                                ' F1 help also has SHIFT and CONTROL options
                                m_objToolBar.KeyBindings.Add lngVirt + FCONTROL + FSHIFT, lngKey, lngToolID
                                m_objToolBar.KeyBindings.Add lngVirt + FCONTROL, lngKey, lngToolID
                            End If
                            m_objToolBar.KeyBindings.Add lngVirt, lngKey, lngToolID
                        Next
                    End If
                End If
            End If
        
ExtensionFileResume:
            loopCount = loopCount + 1
        Loop Until loopCount > fileList.Count ' one more than count of extension files
        
        'Setup intelligent menus
        m_objToolBar.Options.AlwaysShowFullMenus = True
        m_objToolBar.Options.ShowFullAfterDelay = True
    End If
    
    If strFileToMerge <> SA_VB_EmptyString Then
        'Default was loaded, but we can load some previously saved hotkey and docking panel settings
        If objDoc.Load(strFileToMerge) Then
            ' Loaded
            On Error Resume Next
            
            ' Get the docking system state from the XML - we tuck it in with the toolbar details
            Set objNode = objDoc.selectSingleNode("//DockSystemState") 'DEV_STRING
            m_LastLoadedDockState = objNode.Text
            objNode.parentNode.removeChild objNode
            
            ' Add the saved HotKeys
            Set objNodes = objDoc.selectNodes("//Shortcuts/Accel") 'DEV_STRING
            If Not objNodes Is Nothing Then
                If objNodes.Length > 0 Then
                    For Each objElem In objNodes
                        strHKvirt = objElem.getAttribute("virt")
                        strHKkey = objElem.getAttribute("key")
                        strHKid = objElem.getAttribute("Id")
                        m_objToolBar.KeyBindings.Add strHKvirt, strHKkey, strHKid
                    Next
                End If
            End If
        End If
    End If
    ' Set the version information
    Set VersionTool = Tools.Add(GetNextInternalToolID, "SAVersion") 'DEV_STRING
    VersionTool.Caption = g_strVersion ' Add the Main SA version number
    VersionTool.Visible = False
    VersionTool.Enabled = False
    Set VersionTool = Tools.Add(GetNextInternalToolID, "SATBVersion") 'DEV_STRING
    VersionTool.Caption = CStr(TOOLBARVERSION) ' Add the toolbar version number
    VersionTool.Visible = False
    VersionTool.Enabled = False
    Set VersionTool = Tools.Add(GetNextInternalToolID, "SATBLocale") 'DEV_STRING
    VersionTool.Caption = strLocale ' Add the toolbar locale
    VersionTool.Visible = False
    VersionTool.Enabled = False
    
    bInhibitMenuTimer = False    ' Let it go
    Call m_objToolBar.RecalcLayout
        
    On Error GoTo ErrExit
    Dim SAFont As StdFont
    Set SAFont = SAUtilsFont
    SetUIThemes
    Set m_objWorkspace = m_objToolBar.ShowTabWorkspace(True)
    With m_objWorkspace
        .AutoTheme = True
        .ToolTipContext.Style = xtpToolTipBalloon
        .AllowReorder = False ' because drag gets initiated on switching dgm tabs
        .EnableGroups
        .Flags = xtpWorkspaceShowActiveFiles Or xtpWorkspaceHideArrows
        .PaintManager.ShowIcons = False
        .PaintManager.ToolTipBehaviour = xtpTabToolTipAlways
        .PaintManager.OneNoteColors = False
        .PaintManager.StaticFrame = False
        .PaintManager.SetIconSize 16, 16 ' The SetIconSize method is used to set the size of the icons displayed in the tab buttons.
        If Not (SAFont Is Nothing) Then
            Set .PaintManager.Font = SAFont
        End If
    End With
    
    ' Note with the following the size gets saved in the toolbar so that will apply if no override is set
    ' Thus applying the default is more user friendly
    SAGetSetting SAXRes.GetLocalString(IDSWININIIconSize_Toolbar), str, 10, SAXRes.GetLocalString(IDSProductIniSectionName)
    l = 16 ' default is 16
    If IsNumeric(str) Then
        l = CLng(str)
    End If
    m_objToolBar.Options.SetIconSize False, l, l
    
    SAGetSetting SAXRes.GetLocalString(IDSWININIIconSize_Toolbar_Large), str, 10, SAXRes.GetLocalString(IDSProductIniSectionName)
    l = 32 ' default is 32
    If IsNumeric(str) Then
        l = CLng(str)
    End If
    m_objToolBar.Options.SetIconSize True, l, l
    
    SAGetSetting SAXRes.GetLocalString(IDSWININIIconSize_Popup), str, 10, SAXRes.GetLocalString(IDSProductIniSectionName)
    l = 16 ' default is 16
    If IsNumeric(str) Then
        l = CLng(str)
    End If
    m_objToolBar.Options.SetPopupIconSize l, l
    
    Set SAMenuFont = SAUtilsMenuFont()
    If Not SAMenuFont Is Nothing Then
        Set m_objToolBar.Options.Font = SAMenuFont
        Set m_objToolBar.Options.ComboBoxFont = SAMenuFont
    End If
    
    'Setup balloon style tool tips
    m_objToolBar.ToolTipContext.Style = xtpToolTipBalloon
    m_objToolBar.ToolTipContext.MaxTipWidth = 400
    
    Exit Sub
ErrExit:
    If CmdLineQAReporting Then
        SAMessageBox "There is a problem loading the toolbar file. SA may not function correctly." + vbCrLf + vbCrLf + Err.Description 'DEV_STRING
    End If
    Exit Sub
ExtensionFileError:
    LogMessage SAXRes.FormatLocalString(SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____failedtoloadtoolbarextensionfile01error23), strFileName, vbCrLf, Err.Number, Err.Description) 'LEELOCAL
    If Not blnCmdLineQuiet Then
        SAMessageBox SAXRes.FormatLocalString(SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____failedtoloadtoolbarextensionfile01error23), strFileName, vbCrLf, Err.Number, Err.Description), vbInformation Or vbOKOnly 'LEELOCAL
    End If
    
    Resume ExtensionFileResume
End Sub

Private Function DecodeAccelKey(ByRef r_objElem As IXMLDOMElement, ByRef r_lngRetVirt As Long, ByRef r_lngRetKey As Long, ByRef r_lngRetToolID As Long) As Boolean
    Dim strAccelKey As String
    Dim arrKeys As Variant
    Dim lngIndex As Long
    Dim lngVirt As Long
    Dim lngKey As Long
    Dim lngToolID As Long
    
    On Error Resume Next
    strAccelKey = r_objElem.getAttribute("ShortcutKey") 'DEV_STRING
    lngToolID = r_objElem.getAttribute("ToolID") 'DEV_STRING
    If Err.Number <> 0 Then
        Exit Function
    End If
    On Error GoTo 0
    
    arrKeys = Split(strAccelKey, "+") 'DEV_STRING
    
    For lngIndex = 0 To UBound(arrKeys)
        Select Case UCase(arrKeys(lngIndex))
            Case "ALT" 'DEV_STRING
                lngVirt = lngVirt Or FALT
            Case "CONTROL" 'DEV_STRING
                lngVirt = lngVirt Or FCONTROL
            Case "SHIFT" 'DEV_STRING
                lngVirt = lngVirt Or FSHIFT
            Case "DELETE" 'DEV_STRING
                lngKey = VK_DELETE
            Case "F1" 'DEV_STRING
                lngKey = VK_F1
            Case "F2" 'DEV_STRING
                lngKey = VK_F2
            Case "F3" 'DEV_STRING
                lngKey = VK_F3
            Case "F4" 'DEV_STRING
                lngKey = VK_F4
            Case "F5" 'DEV_STRING
                lngKey = VK_F5
            Case "F6" 'DEV_STRING
                lngKey = VK_F6
            Case "F7" 'DEV_STRING
                lngKey = VK_F7
            Case "F8" 'DEV_STRING
                lngKey = VK_F8
            Case "F9" 'DEV_STRING
                lngKey = VK_F9
            Case "F10" 'DEV_STRING
                lngKey = VK_F10
            Case "F11" 'DEV_STRING
                lngKey = VK_F11
            Case "F12" 'DEV_STRING
                lngKey = VK_F12
            Case Else
                lngKey = Asc(UCase(arrKeys(lngIndex)))
        End Select
    Next
    If lngKey <> 0 And lngToolID <> 0 Then
        r_lngRetKey = lngKey
        r_lngRetVirt = lngVirt
        r_lngRetToolID = lngToolID
        DecodeAccelKey = True
    End If
End Function

Public Function GetDockState() As String
    GetDockState = m_LastLoadedDockState
End Function

Private Function CreateStateOptions() As StateOptions
    Dim myStateOptions As XtremeCommandBars.StateOptions
    
    Set myStateOptions = m_objToolBar.CreateStateOptions

     'If True, no message boxes will be displayed when the CommandBar layout is loaded.
    'i.e. The message box that asks for conformation before the CommandBar layout is reset.
    'The default is False
    myStateOptions.LoadSilent = True

    'If True, only CommandBars that have been customized will be saved.
    'The default is True
    myStateOptions.SaveOnlyCustomized = False

    'If True, the original state of the CommandBars is saved along with the customized state
    'For example, if a button on a toolbar is moved, then both the original and modified states will be saved.
    'The Default is True
    myStateOptions.SaveOriginalControls = False

    'In the CommandBar Designer you can export a XCB file to a XML file and Load it using LoadFromXMLString.
    'If SerializeDesignerControls is True, then the CommandBars.DesignerControls property will be filled with
    'Control items from the CommandBar Designer's controls pane. This allows you to use LoadFromXMLString instead
    'of the LoadDesignerBars method. NOTE: DesignerControls are the controls displayed in the customization dialog.
    'The default is False
    myStateOptions.SerializeDesignerControls = True

    'If True, the controls in the CommandBars will be saved. If False, no controls will be saved,
    'regardless of the other settings.
    'The default is True
    myStateOptions.SerializeControls = True

    'If True, the images stored in the ImageManager will be saved.
    'The default is False
    myStateOptions.SerializeImages = True

    'If True, the layout of the CommandBars will be saved. The Layout includes information such as
    'bar position, location, and size.
    'The Default is True
    myStateOptions.SerializeLayout = True

    'If True, the setting on the Keyboard and Options pages of the Customize dialog will
    'be saved. This includes shortcut keys and CommandBar options like large icons and full menus.
    'The default is False
    myStateOptions.SerializeOptions = True
    
    Set CreateStateOptions = myStateOptions
End Function

Public Sub Save(ByVal v_strFilename As String, ByVal v_strDockState As String, Optional ByVal v_blnDEBUGNoCommandBarIds As Boolean = False)
    Dim varFile As Variant
    Dim myStateOptions As XtremeCommandBars.StateOptions
    Dim objXMLDoc As New MSXML2.DOMDocument
    Dim objNodes As IXMLDOMNodeList
    Dim objNode As IXMLDOMElement
    Dim objSANode As IXMLDOMElement
    Dim strName As String
    Dim objTool As SAToolbarTool
    Dim objBand As SAToolbarBand
    Dim objParentNode As IXMLDOMElement
    Dim lngID As Long
    Dim blnProcessThisTool As Boolean
    Dim lngBarID As Long
    Dim objExtTool As SAToolBarExtension
    
    Set myStateOptions = CreateStateOptions()
    
    objXMLDoc.async = False
    objXMLDoc.setProperty "SelectionLanguage", "XPath" 'DEV_STRING
    
    bInhibitMenuTimer = True
    
    If objXMLDoc.loadXML(m_objToolBar.SaveStateToXMLString("DesignerFile", myStateOptions)) Then 'DEV_STRING
        ' Set the docking system state intothe XML - we tuck it in with the toolbar details
        Set objNode = objXMLDoc.createElement("DockSystemState") 'DEV_STRING
        objNode.Text = v_strDockState
        objXMLDoc.childNodes(0).appendChild objNode
        
        ' Remove all the HideFlags attributes - these prevent the file displaying correctly in the designer
        Set objNodes = objXMLDoc.selectNodes("//Control[@HideFlags!='']") 'DEV_STRING
        For Each objNode In objNodes
            Call objNode.removeAttribute("HideFlags") 'DEV_STRING
        Next
        
        ' Remove any odd icons - some seem to cause the toolbar to crash on loading (esp in the designer)
        Set objNodes = objXMLDoc.selectNodes("//IconSet/Icon[@Width>'32']") 'DEV_STRING
        For Each objNode In objNodes
            If CmdLineQAReporting Then
                On Error Resume Next
                Set objParentNode = objNode.parentNode
                lngID = objParentNode.getAttribute("Id") 'DEV_STRING
                On Error GoTo 0
                SAMessageBox "Icons in the toolbar file exceed 32 pixels in width and have been removed." & vbCrLf & "Icon ID = " & lngID 'DEV_STRING
                Set objParentNode = Nothing
            End If
            objNode.parentNode.parentNode.removeChild objNode.parentNode
        Next
        
        ' Update all the master tools with the SA tags
        Set objNodes = objXMLDoc.selectNodes("//CommandBar[@Title='Controls']/Controls/Control") 'DEV_STRING
        For Each objNode In objNodes
#If TOOLDEBUGGING Then
                If v_blnDEBUGNoCommandBarIds Then
                    objNode.removeAttribute "CommandBarId" 'DEV_STRING
                End If
#End If
            On Error Resume Next
            strName = SA_VB_EmptyString
            strName = objNode.getAttribute("Parameter") 'DEV_STRING
            On Error GoTo 0
            If strName = SA_VB_EmptyString Then
#If TOOLDEBUGGING Then
                SAMessageBox "Tool with no name!! - removed" 'DEV_STRING
#End If
                objNode.parentNode.removeChild objNode
            Else
                On Error Resume Next
                Set objTool = Nothing
                Set objTool = Tools(strName)
                On Error GoTo 0
            End If
            If Not objTool Is Nothing Then
                Set objSANode = objXMLDoc.createElement("SATags") 'DEV_STRING
                If Not IsDrawingTool(objTool.toolID) Then
                    blnProcessThisTool = True
                End If
                If Not objTool.SubBand Is Nothing Then
                    ' This tool has a subband
                    ' BAND_DRAWMENU also covers DrawLine, Node
                    If objTool.SubBand.Tools.Count = 0 And _
                    Not Left$(objTool.SubBandName, Len(BAND_DRAWMENU)) = BAND_DRAWMENU Then
                        ' This subband has no tools - so remove it - as CodeJock ignores it on reloading
                        If CmdLineQAReporting Then
#If TOOLDEBUGGING Then
                            SAMessageBox "A Band exists with no tools and has been removed :-" & vbCrLf & objTool.Name   'DEV_STRING
#End If
                        End If
                        blnProcessThisTool = False
                        lngBarID = objNode.getAttribute("CommandBarId") ' Get the bar id
                        objNode.parentNode.removeChild objNode  ' Remove the tool
                        
                        ' Find the band item
                        On Error Resume Next
                        Set objNode = objXMLDoc.selectSingleNode("//CommandBars/CommandBar[@BarID='" & lngBarID & "']") 'DEV_STRING
                        On Error GoTo 0
                        If Not objNode Is Nothing Then
                            objNode.parentNode.removeChild objNode  ' Remove the band item
                        End If
                    End If
                End If
                
                If blnProcessThisTool Then
                    On Error Resume Next
                    Set objExtTool = m_colExtendedTools.ItemBySAToolbarID(objTool.toolID)
                    On Error GoTo 0
                    If Not objExtTool Is Nothing Then
                        objSANode.setAttribute "ExtensionGUID", objExtTool.ExtensionGuid 'DEV_STRING
                        objSANode.setAttribute "ExtensionToolId", objExtTool.ExtensionToolID 'DEV_STRING
                    End If
                    objSANode.setAttribute "IsSATool", "True" 'DEV_STRING
                    objSANode.setAttribute "UpdateFlags", CStr(objTool.UpdateFlags) 'DEV_STRING
                    objSANode.setAttribute "SubBandName", CStr(objTool.SubBandName) 'DEV_STRING
                    
                    objSANode.setAttribute "MacroArgs", objTool.MacroArgument 'DEV_STRING
                    objSANode.setAttribute "HelpContextID", CStr(objTool.HelpContextID) 'DEV_STRING
                    
                    objSANode.setAttribute "ROState", CStr(objTool.ROState) 'DEV_STRING
                        
                    If objTool.ControlType = SATB_TT_EDIT Or objTool.ControlType = SATB_TT_COMBOBOX Then
                        objSANode.setAttribute "Text", objTool.Text 'DEV_STRING
                    End If
                    
                    If objTool.ExecCommandID <> SA_VB_EmptyString Then
                        objSANode.setAttribute "ExecCommandID", CStr(objTool.ExecCommandID) 'DEV_STRING
                    End If
                    objNode.appendChild objSANode
                End If
            End If
        Next
        
        ' Update all the bands with SA tags
        For Each objBand In Bands
            Set objNode = Nothing
            On Error Resume Next
            Set objNode = objXMLDoc.selectSingleNode("//CommandBars/CommandBar[@BarID='" & objBand.BarID & "']") 'DEV_STRING
            On Error GoTo 0
            If Not objNode Is Nothing Then
                Set objSANode = objXMLDoc.createElement("SATags") 'DEV_STRING
                objSANode.setAttribute "IsSABand", "True" 'DEV_STRING  'DEV_STRING
                objSANode.setAttribute "Name", objBand.BandName     'DEV_STRING
                objNode.appendChild objSANode
            End If
        Next

#If TOOLDEBUGGING Then
        ' Some cheap bubble sorts to ensure the nodes are output in the same order
        ' If the files are then sent through ppxml with -a - diffing is very easy
        Dim objSortNode As IXMLDOMElement
        Dim blnDone As Boolean
        Dim lngSortIndex As Long
        
        While Not blnDone
            Set objNodes = objXMLDoc.selectNodes("//CommandBars/CommandBar") 'DEV_STRING
            blnDone = True
            For lngSortIndex = 0 To objNodes.Length - 2
                Set objNode = objNodes(lngSortIndex)
                Set objSortNode = objNodes(lngSortIndex + 1)
                
                If CLng(objNode.getAttribute("BarID")) > CLng(objSortNode.getAttribute("BarID")) Then 'DEV_STRING
                    ' Remove the node from the collection
                    objSortNode.parentNode.removeChild objSortNode
                    objNode.parentNode.insertBefore objSortNode, objNode
                    blnDone = False
                End If
            Next
        Wend
        
        blnDone = False
        While Not blnDone
            Set objNodes = objXMLDoc.selectNodes("//Images/IconSet") 'DEV_STRING
            blnDone = True
            For lngSortIndex = 0 To objNodes.Length - 2
                Set objNode = objNodes(lngSortIndex)
                Set objSortNode = objNodes(lngSortIndex + 1)
                
                If CLng(objNode.getAttribute("Id")) > CLng(objSortNode.getAttribute("Id")) Then 'DEV_STRING
                    ' Remove the node from the collection
                    objSortNode.parentNode.removeChild objSortNode
                    objNode.parentNode.insertBefore objSortNode, objNode
                    blnDone = False
                End If
            Next
        Wend
#End If
                
        objXMLDoc.Save v_strFilename
    End If
    bInhibitMenuTimer = False
End Sub

Public Sub UpdateLastLoadedState(ByVal v_strState As String)
    ' not set in Save because Save is called by debug code
    m_LastLoadedDockState = v_strState
End Sub

Public Sub RecalcLayout()
    If m_blnRecalcOff Then Exit Sub
    
    On Error Resume Next
    m_objToolBar.RecalcLayout
    If Not m_objToolBar.TabWorkspace Is Nothing Then
        m_objToolBar.TabWorkspace.Refresh
    End If
End Sub

Public Property Let AllowRecalc(ByVal value As Boolean)
    m_blnRecalcOff = Not value
End Property

Public Property Get AllowRecalc() As Boolean
    AllowRecalc = Not m_blnRecalcOff
End Property

Public Sub Localise()
'''' TODO TOOLBAR
''''    m_objToolBar.LocaleString = SAXRes.GetLocalString(IDS_RunT_ATBarLocaleString)
End Sub

'---------------------------- SAToolBar events ---------------------------



'''' TODO TOOLBAR - No equivalent - Need to implement a reset
'''' Private Sub m_objToolBar_Reset(ByVal BandName As String)
''''    RaiseEvent Reset(BandName)
'''' End Sub

Private Sub Class_Initialize()
    NextInternalToolID = -1 ' Reset
    
    Set m_objToolBar = fMainForm.ctlCommandBar

    m_objToolBar.Options.Animation = TOOLBARANIMATION
    
    m_objToolBar.Options.MaxPopupWidth = MENU_MAXPOPUPWIDTH

    m_objToolBar.ShowTabWorkspace True

    m_objToolBar.LoadDesignerBars GetExePath() & "\initial.xcb" 'DEV_STRING Required to initialize the designer controls collection

    m_colTools.Init SA_VB_EmptyString, m_objToolBar.DesignerControls
    m_colBands.Init m_objToolBar.ActiveMenuBar, m_objToolBar, m_objToolBar.DesignerControls
    
    SetupControlLocale
End Sub

Private Sub SetupControlLocale()
    Dim strValue As String
    Dim strResource As String
    Dim strAppPath As String

    On Error GoTo ErrorHandler
    
    Call SAGetSetting("Locale", strValue, 3, "SystemArchitect") 'DEV_STRING
    
    If strValue = "" Then 'DEV_STRING
        strValue = "409" 'DEV_STRING
    End If
    
    strResource = "SuitePro.Resource" & strValue & ".dll" 'DEV_STRING

    strAppPath = SA_File_GetFolderLocation(fMainForm.hWnd, SASF_SA2001InstallPath)
    strAppPath = SA_File_AddSlashIfNeeded(strAppPath)
    
    m_objToolBar.GlobalSettings.ResourceFile = strAppPath & strResource
    
    Exit Sub
    
ErrorHandler:
    If CmdLineQAReporting Then
        SAMessageBox "Unable to set the requested language for the menu system" 'DEV_STRING
    End If
End Sub

Private Function GetToolFromControl(ByVal Control As XtremeCommandBars.CommandBarControl) As SAToolbarTool
    Dim objTool As SAToolbarTool
    Dim objRealTool As XtremeCommandBars.CommandBarControl

    On Error Resume Next
    If Control.Parameter = SA_VB_EmptyString Then
        ' Accellerator key press do NOT give us the actual tool, we have to find it ourselves
        Set objRealTool = m_objToolBar.DesignerControls.Find(Control.Type, Control.Id)
        If objRealTool Is Nothing Then
           Exit Function
        End If
    Else
        Set objRealTool = Control
    End If
    
    Set objTool = m_colTools(objRealTool.Parameter)
    On Error GoTo 0
    
    Set GetToolFromControl = objTool
End Function

Private Sub m_objToolBar_ControlSelected(ByVal Control As XtremeCommandBars.ICommandBarControl)
    Dim objTool As XtremeCommandBars.ICommandBarControl
    Dim objRootTool As XtremeCommandBars.ICommandBarControl

    If Control Is Nothing Then
        Exit Sub
    End If

    ' Find root Draw menu tool; can't do this on Execute
    g_strLastDrawRootPopupToolNameHoveredOver = ""
    Set objTool = Control
    While Not objTool Is Nothing
        Set objRootTool = objTool ' remember last valid tool
        Set objTool = Nothing ' ensure loop terminates
        If IsDrawingTool(objRootTool.Id) Then
            If Not objRootTool.Parent Is Nothing Then ' band
                If Not objRootTool.Parent.Parent Is Nothing Then ' tool
                    Set objTool = objRootTool.Parent.Parent
                    If Not objTool Is Nothing Then
                        If objTool.Parameter = TOOL_DRAWMENU Or objTool.Parameter = BAND_DRAWTOOLBOX Then
                            Set objTool = Nothing
                        End If
                    End If
                End If
            End If
        End If
    Wend
    If Not objRootTool Is Nothing Then
        If objRootTool.Type = xtpControlButtonPopup Then
            If IsDrawingTool(objRootTool.Id) Then
                g_strLastDrawRootPopupToolNameHoveredOver = objRootTool.Parameter
            End If
        End If
    End If
End Sub

Private Sub m_objToolBar_Customization(ByVal Options As XtremeCommandBars.ICustomizeOptions)
    Update = True
    'Add our own button to the customization popup menu
    Options.ContextMenu.Controls.Add xtpControlButton, 505, SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____hide)
    Options.ResizableSheet = True
End Sub

Private Sub m_objToolBar_Execute(ByVal Control As XtremeCommandBars.ICommandBarControl)
    Dim objTool As SAToolbarTool
    Dim str As String
    
    
    g_strLastDrawRootPopupToolName = g_strLastDrawRootPopupToolNameHoveredOver
    str = g_strLastDrawRootPopupToolName ' VC debugging
    g_strLastDrawToolName = Control.Parameter
    str = g_strLastDrawToolName
    
    'Check if user selected the "Hide" button on the customization popup menu
    If Control.Id = 505 Then
        'Make the selected control hidden (i.e. - an intelligent menu)
        m_objToolBar.Options.AddHiddenCommand m_objToolBar.CustomizedControl.Id
    Else
        Set objTool = GetToolFromControl(Control)
        If Not objTool Is Nothing Then
            If Control.Type = xtpControlEdit Then
                objTool.Text = Control.Text
                bMenusChanged = True
                RaiseEvent Click(objTool)
            ElseIf Control.Type = xtpControlComboBox Then
                objTool.Text = Control.Text
                bMenusChanged = True
                RaiseEvent Click(objTool)
            Else
                RaiseEvent Click(objTool)
            End If
        End If
    End If
End Sub

Public Property Get Update() As Boolean
    Update = m_blnMenuDoUpdate
End Property
Public Property Let Update(ByVal v_blnValue As Boolean)
    m_blnMenuDoUpdate = v_blnValue
    If v_blnValue Then
        m_objToolBar.Options.UpdatePeriod = MINDELAYPERIOD
    Else
        m_objToolBar.Options.UpdatePeriod = MAXDELAYPERIOD
    End If
End Property

Private Sub m_objToolBar_InitCommandsPopup(ByVal CommandBar As XtremeCommandBars.ICommandBar)
    Dim objBand As SAToolbarBand
    
    On Error Resume Next
    Set objBand = Bands.GetBandFromCommandBarTitle(CommandBar.Title)
    On Error GoTo 0
    If Not objBand Is Nothing Then
        RaiseEvent PopupBandOpen(objBand)
    End If
End Sub

Private Sub m_objToolBar_Resize()
    '' TODO TOOLBAR - may not need to update every time
    Update = True
End Sub

Private Sub m_objToolBar_ToolBarVisibleChanged(ByVal ToolBar As XtremeCommandBars.ICommandBar)
    Dim objBand As SAToolbarBand
    
    On Error Resume Next
    Set objBand = Bands.GetBandFromCommandBarTitle(ToolBar.Title)
    On Error GoTo 0
    If Not objBand Is Nothing Then
        If ToolBar.Visible Then
            RaiseEvent BandShow(objBand)
        Else
            RaiseEvent BandHide(objBand)
        End If
    End If
End Sub

Private Sub m_objToolBar_TrackingModeChanged(ByVal CommandBar As XtremeCommandBars.ICommandBar, ByVal Mode As Boolean)
    Dim ctlLastTool As XtremeCommandBars.CommandBarControl
    Dim objTool As SAToolbarTool
    Static strLastToolName As String

    ' When a toolbar gets and loses focus. Get = True, Lose = False
    ' Useful for text and combo boxes on toolbars
    ' Warning for editable combos: Drop down combo, collapse it, then enter value, then click elsewhere - presented value gets reset and you can't retrieve what the user typed in; Control.Text still retrieves old value
    
    If Mode = True Then
        ' Got Focus
        
        ' Update knowledge of last tool - can only do this on getting focus
        Set ctlLastTool = CommandBar.SelectedControl
        Set objTool = GetToolFromControl(ctlLastTool)
        Set ctlLastTool = Nothing
        If Not objTool Is Nothing Then
            strLastToolName = objTool.Name
            Set objTool = Nothing
        Else
'            strLastToolName = ""   ' Don't do this, this is where we end up in the editable combo scenario, and this clears knowledge of the last control
        End If
        
        RefreshEditAndCombos    ' Refreshes the last selected commandbar's edits and combos - picks up previous edits
        Set m_cbLastActiveCommandBar = CommandBar   ' Note the current selected commandbar
    Else
        ' Lost focus
        RefreshEditAndCombos
        ' Do the above first - updates text of SAToolbarTool if out of synch with control
    End If
End Sub

Private Sub RefreshEditAndCombos()
    Dim objTool As SAToolbarTool
    Dim Control As Object
    
    If Not m_cbLastActiveCommandBar Is Nothing Then
        ' We know we had a commandbar previously active
        For Each Control In m_cbLastActiveCommandBar.Controls
            ' Search this commandbar for combos or edit boxes
            If Control.Type = xtpControlEdit Or Control.Type = xtpControlComboBox Then
                Set objTool = GetToolFromControl(Control)   ' Get SAs tools for this box
                If Not objTool Is Nothing Then
                    If Control.Type = xtpControlEdit Then
                        If objTool.Text <> Control.Text And Not objTool.CancelIfFocusLost Then
                            objTool.Text = Control.Text     ' Grab the text
                            bMenusChanged = True
                        End If
                    ElseIf Control.Type = xtpControlComboBox Then
                        If objTool.Text <> Control.Text And Not objTool.CancelIfFocusLost Then
                            objTool.Text = Control.Text     ' Grab the text
                            objTool.CBListIndex = Control.ListIndex     ' Grab the index
                            bMenusChanged = True
                        End If
                    End If
                End If
            End If
        Next
        Set m_cbLastActiveCommandBar = Nothing
    End If
End Sub

Private Sub m_objToolBar_Update(ByVal Control As XtremeCommandBars.ICommandBarControl)
    Dim Tool As SAToolbarTool
    Static lngLastIndex As Long
    Static lngLastBar As Long
    Dim Control2 As CommandBarControl
    Dim lngTemp As Long
    Dim blnIsSpecial As Boolean
    Dim lToolID As Long
    Dim sToolID As String
    Dim bEnabled As Boolean
    Dim bChecked As Boolean
    Dim bVisible As Boolean
    Dim lIconID As Long
        

    If bInhibitMenuTimer Then Exit Sub
    
    lToolID = Control.Id ' for VC
    sToolID = Control.Parameter ' for VC
        
    ' The following If - controls CodeJock's desire to continually update the toolbar
    ' It puts the UpdatePeriod to MAX when all of the tool events have fired once
    ' NB: We get 1 update event for each tool in the toolbar system - this happens every UpdatePeriod
    If m_blnMenuDoUpdate Or m_blnMenuUpdating Then
        If m_blnMenuDoUpdate Then
            ' Initialize (or reinitialize if we were already updating - we will start again from the beginning of the next toolbar)
            lngLastIndex = 0
            lngLastBar = 0
#If TOOLDEBUGGING Then
        Call LogMessageTools("m_objToolbar.Update Restart") 'DEV_STRING
#End If
        End If
        If lngLastIndex = 0 Then
            ' Looking for the start of a toolbar
            If Control.Index = 1 Then
            'If Control.Id = 30000 Then ' id_File in Main_Menu
            '^Although this looked sensible, the result was that sometimes you would open the Tools menu and not all options were there, or the same for a submenu e.g. Tools\Customize User Properties
                ' This is the first item in the first toolbar we are processing for this update
                ' NB: We may start part way through a toolbar, we want to ensure we start at the beginning
                m_blnMenuUpdating = True
                m_blnMenuDoUpdate = False
            Else
                ' Let these tools slip through until we are at the first tool in a toolbar
                Exit Sub
            End If
        ElseIf Control.Index < lngLastIndex Then
#If TOOLDEBUGGING Then
        Call LogMessageTools("m_objToolbar.Update We are starting another toolbar") 'DEV_STRING
#End If
            ' We are starting another toolbar
            lngLastBar = lngLastBar + 1
            If lngLastBar >= m_objToolBar.Count Then
            'If Control.Id = 30000 Then ' id_File in Main_Menu
            '^Although this looked sensible, the result was that sometimes you would open the Tools menu and not all options were there, or the same for a submenu e.g. Tools\Customize User Properties
#If TOOLDEBUGGING Then
                Call LogMessageTools("m_objToolbar.Update Terminating At...") 'DEV_STRING
#End If
#If TOOLDEBUGGING Then
                If Control.Parent Is Nothing Then
                    Call LogMessageTools("m_objToolbar.Update Control.Index=" & Control.Index & ", Control.Id='" & Control.Id & "', Control.Paremeter='" & Control.Parameter & "'") 'DEV_STRING
                Else
                    Call LogMessageTools("m_objToolbar.Update Control.Index=" & Control.Index & ",Control.Id='" & Control.Id & "', Control.Paremeter='" & Control.Parameter & "', Control.Parent.BarId=" & Control.Parent.BarID & ", Control.Parent.Title='" & Control.Parent.Title & "'") 'DEV_STRING
                End If
#End If
#If TOOLDEBUGGING Then
                Call LogMessageTools("m_objToolbar.Update Terminating End") 'DEV_STRING
#End If
                ' There are no more toolbars to process
                m_blnMenuUpdating = False
                lngLastIndex = 0
                lngLastBar = 0
                m_objToolBar.Options.UpdatePeriod = MAXDELAYPERIOD
                Exit Sub
            End If
        End If
        
#If TOOLDEBUGGING Then
        If Control.Parent Is Nothing Then
            Call LogMessageTools("m_objToolbar.Update Control.Index=" & Control.Index & ", Control.Id='" & Control.Id & "', Control.Parameter='" & Control.Parameter & "', Control.Caption='" & Control.Caption & "'") 'DEV_STRING
        Else
            Call LogMessageTools("m_objToolbar.Update Control.Index=" & Control.Index & ", Control.Id='" & Control.Id & "', Control.Parameter='" & Control.Parameter & "', Control.Caption='" & Control.Caption & "', Control.Parent.BarId=" & Control.Parent.BarID & ", Control.Parent.Title='" & Control.Parent.Title & "'") 'DEV_STRING
        End If
#End If
        
        lngLastIndex = Control.Index
    End If
    
    ' Check to see if this tool needs updating outside of the main menu update code
    ' Some tools - combo boxes, or tools which are in popups get an update when they are changed/are shown
    blnIsSpecial = False
    If Not Control.Parent Is Nothing Then
        If Not Control.Parent.Parent Is Nothing Then
            blnIsSpecial = True
        End If
    End If
    
    If m_blnMenuUpdating Or blnIsSpecial Then
        On Error Resume Next
        Set Tool = m_colTools(Control.Parameter)
        lToolID = Control.Id ' for VC
        sToolID = Control.Parameter ' for VC
        Select Case Control.Type
            Case xtpControlComboBox
                If Control.DropDownListStyle Then
                    ' This is a normal combo with an edit field (I KNOW THE LOGIC IS BACKWARDS - ASK CODEJOCK?!)
                    If Tool.Text <> SA_VB_EmptyString Then
                        Control.Text = Tool.Text
                    Else
                        Control.ListIndex = Tool.CBListIndex
                    End If
                Else
                    ' This is a drop down list only (I KNOW THE LOGIC IS BACKWARDS - ASK CODEJOCK?!)
                    If Tool.Text <> SA_VB_EmptyString Then
                        Control.ListIndex = Control.FindItem(Tool.Text)
                    Else
                        Control.ListIndex = Tool.CBListIndex
                    End If
                End If
            Case xtpControlEdit
                Control.Text = Tool.Text
            Case xtpControlButton
                Control.Checked = Tool.Checked
        End Select
        Control.ToolTipText = Tool.ToolTipText
        Control.Caption = Tool.Caption
        
        On Error Resume Next
        On Error GoTo 0
        If Not Tool Is Nothing Then
            Control.Enabled = Tool.Enabled
            bEnabled = Control.Enabled
            Control.Checked = Tool.Checked
            bChecked = Control.Checked
            Control.Visible = Tool.Visible
            bVisible = Control.Visible
            
            ' Force an icon update - required if the color pickers change and the pickers are torn off
            lngTemp = Control.iconID
            lIconID = lngTemp
            Control.iconID = 0
            Control.iconID = lngTemp
        End If
    End If
End Sub

Private Function InitColorTools() As Boolean
    Static bInitialized As Boolean
    
    If bInitialized Then
        InitColorTools = False
        Exit Function
    End If
    
    InitColorTools = True
    
    bInitialized = True
    
    ' init array of colors
    aColors(0) = RGB(0, 0, 0)
    aColors(1) = RGB(153, 51, 0)
    aColors(2) = RGB(0, 128, 0)
    aColors(3) = RGB(0, 0, 255)
    aColors(4) = RGB(255, 0, 0)
    
    aColors(5) = RGB(128, 0, 128)
    aColors(6) = RGB(255, 0, 255)
    aColors(7) = RGB(255, 204, 0)
    aColors(8) = RGB(255, 255, 0)
    aColors(9) = RGB(192, 192, 192)
    
    aColors(10) = RGB(255, 153, 204)
    aColors(11) = RGB(255, 204, 153)
    aColors(12) = RGB(204, 255, 204)
    aColors(13) = RGB(204, 255, 255)
    aColors(14) = RGB(255, 255, 255)
    
''    aColors(0) = RGB(0, 0, 0)
''    aColors(1) = RGB(153, 51, 0)
''    aColors(2) = RGB(51, 51, 0)
''    aColors(3) = RGB(0, 51, 0)
''    aColors(4) = RGB(0, 51, 102)
''    aColors(5) = RGB(0, 0, 128)
''    aColors(6) = RGB(51, 51, 53)
''    aColors(7) = RGB(51, 51, 51)
''
''    aColors(8) = RGB(128, 0, 0)
''    aColors(9) = RGB(255, 255, 255)
''    aColors(10) = RGB(128, 128, 0)
''    aColors(11) = RGB(0, 128, 0)
''    aColors(12) = RGB(0, 128, 128)
''    aColors(13) = RGB(0, 0, 255)
''    aColors(14) = RGB(255, 255, 255)
''    aColors(15) = RGB(128, 128, 128)
''
''    aColors(16) = RGB(255, 0, 0)
''    aColors(17) = RGB(255, 153, 0)
''    aColors(18) = RGB(153, 204, 0)
''    aColors(19) = RGB(51, 153, 102)
''    aColors(20) = RGB(51, 204, 204)
''    aColors(21) = RGB(51, 102, 255)
''    aColors(22) = RGB(128, 0, 128)
''    aColors(23) = RGB(153, 153, 153)
''
''    aColors(24) = RGB(255, 0, 255)
''    aColors(25) = RGB(255, 204, 0)
''    aColors(26) = RGB(255, 255, 0)
''    aColors(27) = RGB(0, 255, 0)
''    aColors(28) = RGB(0, 255, 255)
''    aColors(29) = RGB(0, 204, 255)
''    aColors(30) = RGB(153, 51, 102)
''    aColors(31) = RGB(192, 192, 192)
''
''    aColors(32) = RGB(255, 153, 204)
''    aColors(33) = RGB(255, 204, 153)
''    aColors(34) = RGB(255, 255, 153)
''    aColors(35) = RGB(204, 255, 204)
''    aColors(36) = RGB(204, 255, 255)
''    aColors(37) = RGB(153, 204, 255)
''    aColors(38) = RGB(204, 153, 255)
''    aColors(39) = RGB(255, 255, 255)
End Function

Private Sub PaintBackGround(pic As PictureBox, iColor As Long)
    Dim rc As RECT          ' Rectangle structure to hold screen area
    Dim lngOldBrush As Long
    Dim lngBrush As Long
    Dim lngOldPen As Long
    Dim lngPen As Long
    On Error Resume Next
    
    pic.Height = 16
    pic.Width = 16
    
    pic.ScaleMode = vbPixels
    pic.AutoRedraw = True
    pic.Picture = LoadPicture()
    
    Call SetBkColor(pic.hDC, iColor)
    Call SetBkMode(pic.hDC, OPAQUE)
    
    lngPen = CreatePen(0, 1, RGB(92, 92, 92))
    lngBrush = CreateSolidBrush(iColor)
    lngOldPen = SelectObject(pic.hDC, lngPen)
    lngOldBrush = SelectObject(pic.hDC, lngBrush)
    
    Call Rectangle(pic.hDC, 0, 0, 16, 16)
    
    Call SelectObject(pic.hDC, lngOldPen)
    Call SelectObject(pic.hDC, lngOldBrush)
    DeleteObject lngPen
    DeleteObject lngBrush
    
    ' draw border
    pic.Line (1, 1)-(15, 15), vb3DDKShadow, B

    pic.Refresh
    pic.Picture = pic.Image
    pic.Refresh
End Sub

Public Function AddColorPicker(ByVal v_lngToolID As Long, ByVal v_strToolName As String, ByVal v_strCaption As String) As SAToolbarTool
End Function

Private Sub m_objWorkspace_RClick(ByVal Item As XtremeCommandBars.ITabControlItem)
    'User right clicked on a workspace tab
    Dim objTool As SAToolbarTool

    If Not Item Is Nothing Then
        Item.Selected = True
        m_objWorkspace.Refresh
        
        Dim oPopup As CommandBar
        Dim oControl As CommandBarControl
        Dim bShow As Boolean
        
        Set oPopup = m_objToolBar.Add("Popup", xtpBarPopup)
        
        With oPopup.Controls
            'If the current tab is hosting a diagram add some menu items
            If IsDiagramWindow(Item.Handle) = True Then
                Set objTool = Tools("SAIDM_157")
                If objTool.Enabled = True And objTool.Visible = True Then
                    .Add xtpControlButton, 157, SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____save)
                End If
                .Add xtpControlButton, 259, SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____close)
                bShow = True
            End If
            Set oControl = .Add(xtpControlButton, 35002, SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____workspaceactions))
            oControl.BeginGroup = True
        End With
        'Only show popup if this is a diagram or there is more than one tab
        If bShow Or m_objWorkspace.ItemCount > 1 Then
            oPopup.ShowPopup
            m_objWorkspace.Refresh
        End If
    End If

End Sub

Private Function IsDiagramWindow(ByVal lHandle As Long) As Boolean
End Function

Public Sub ExecuteToolID(ByVal v_lngToolID As Long)
    Dim objTool As SAToolbarTool
    Dim objControl As XtremeCommandBars.CommandBarControl
    
    On Error Resume Next
    Set objControl = m_objToolBar.DesignerControls.Find(, v_lngToolID)
    On Error GoTo 0
    If Not objControl Is Nothing Then
        Set objTool = m_colTools(objControl.Parameter)
    End If
    RaiseEvent Click(objTool)
End Sub

Private Sub SetUIThemes()

    Dim lValue As Long
    Dim sValue As String

    On Error GoTo ErrorHandler

    If GetColorDepth > 8 Then
        lValue = val(GetIniSetting("User Interface", "ToolbarTheme", "-1")) 'DEV_STRING
        If lValue = -1 Then
            m_objToolBar.VisualTheme = TOOLBARTHEME
        Else
            m_objToolBar.VisualTheme = lValue
        End If
        
        sValue = GetIniSetting("User Interface", "UseLuna", "T") 'DEV_STRING
        If sValue = "F" Then 'DEV_STRING
            m_objToolBar.Options.LunaColors = False
        Else
            m_objToolBar.Options.LunaColors = True
        End If
    Else
        'Only 256 colors supported so force theme to Office 2000
        m_objToolBar.VisualTheme = xtpThemeOffice2000
    End If
        
    Exit Sub
    
ErrorHandler:
    
End Sub

Public Function GetNextInternalToolID() As Long
  ' Uses NextInternalToolID as the next available tool
  
  If NextInternalToolID < 0 Then
    If CmdLineQAReporting Then
        Call SAMessageBox("Error in the main tool ID generator. Not Initialised") 'DEV_STRING
    End If
  End If
  
  If NextInternalToolID >= NEXTINTERNALTOOLIDEND Then
    
    SAMessageBox SAXRes.GetLocalString(IDS_RunT_Sa2001Menuprc____outoftoolids) & vbCrLf & _
            SAXRes.FormatLocalString(SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____recommendedactiondelete0andrestart1), _
            GetUserTBFPath(), _
            SAXRes.GetLocalString(IDSProductName)), vbCritical
    
    ' Get rid of the last macro tool added, and reuse the id
    On Error GoTo ErrExit
    GetNextInternalToolID = GetNextInternalToolID - 1 ' This will probably cause another error
    
    LogMessage "TBSUBS - Out of Tool IDs" 'DEV_STRING
    LogMessage "TBSUBS - Re-using Tool ID : " + Format(GetNextInternalToolID) 'DEV_STRING
    
  Else
    GetNextInternalToolID = NextInternalToolID
    NextInternalToolID = NextInternalToolID + 1
'    LogMessage "TBSUBS - Using New Tool ID : " + Format(GetNextInternalToolID) 'DEV_STRING
  End If
  Exit Function
ErrExit:
  ' Not much else we can do
End Function

Private Function GetNextInternalToolIDStart(ByVal v_lngStartId As Long, ByVal v_lngEndId As Long, ByRef r_objDoc As DOMDocument) As Long
  ' Find the largest internal tool id
    Dim largestId As Long
    Dim objElem As IXMLDOMElement
    Dim objNodes As IXMLDOMNodeList
    Dim lngID As Long
    
    largestId = v_lngStartId
    
    Set objNodes = r_objDoc.selectNodes("//*[@Id != 0 or @ToolID != 0]") 'DEV_STRING
    
    For Each objElem In objNodes
        On Error Resume Next
        lngID = 0
        lngID = objElem.getAttribute("Id") 'DEV_STRING
        If lngID > largestId Then largestId = lngID
        
        lngID = 0
        lngID = objElem.getAttribute("ToolID") 'DEV_STRING
        If lngID > largestId Then largestId = lngID
        On Error GoTo 0
    Next
    
    If largestId < v_lngEndId Then
        GetNextInternalToolIDStart = largestId + 1
    Else
        SAMessageBox SAXRes.GetLocalString(IDS_RunT_Sa2001Menuprc____outoftoolids) & vbCrLf & _
            SAXRes.FormatLocalString(SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____recommendedactiondelete0andrestart1), _
            GetUserTBFPath(), _
            SAXRes.GetLocalString(IDSProductName)), vbCritical
    End If
End Function

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' RemoveDrawingTools
''
'' Some users have managed to get SA toolbar files into a state where drawing
'' tools are in the user tbf file. This should not be possible, as all drawing tools
'' are removed prior to saving the tbf.
'' Since we are unable to reproduce this scenario we do not know how to fix it.
'' Rather than second guess the fix, we simply strip all drawing tools on load.
'' CR TLOG#31748
''
'' NOTE: This function does not really belong in this class, as it is SA related and not
'' specific ONLY to the toolbar - but it has become very tied to the format of the XML
'' produced by CodeJock. Hence the reason it now resides here.
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
Private Sub RemoveDrawingTools(ByRef r_objTBDoc As DOMDocument)
    RemoveDrawingToolsFrom r_objTBDoc, BAND_DRAWMENU    ' DEV_STRING
    RemoveDrawingToolsFrom r_objTBDoc, BAND_DRAWLINEMENU    ' DEV_STRING
    RemoveDrawingToolsFrom r_objTBDoc, BAND_DRAWNODEMENU    ' DEV_STRING
    RemoveDrawingToolsFrom r_objTBDoc, BAND_DRAWTOOLBOX    ' DEV_STRING
    RemoveDrawingToolsFrom r_objTBDoc, "Controls"    ' DEV_STRING
End Sub

Private Sub RemoveDrawingToolsFrom(ByRef r_objTBDoc As DOMDocument, ByVal v_strControlBarTitle As String)
    Dim objTool As IXMLDOMElement
    Dim objCmdBar As IXMLDOMElement
    Dim objTools As IXMLDOMNodeList
    Dim lngID As Long
    Dim lngCommandBarId As Long
    
    Set objTools = r_objTBDoc.selectNodes("//CommandBar[@Title='" & v_strControlBarTitle & "']/Controls/Control")    ' DEV_STRING
    For Each objTool In objTools
        On Error Resume Next
        lngID = CLng(objTool.getAttribute("Id"))    ' DEV_STRING
        On Error GoTo 0
        If IsDrawingTool(lngID) Then
            lngCommandBarId = 0
            
            ' Get any command bar id - if there is one
            On Error Resume Next
            lngCommandBarId = objTool.getAttribute("CommandBarId")    ' DEV_STRING
            On Error GoTo 0
            
            ' Remove the tool
            objTool.parentNode.removeChild objTool
            
            If lngCommandBarId > 0 Then
                ' Remove any command bar attached to this tool
                Set objCmdBar = r_objTBDoc.selectSingleNode("//CommandBar[@BarID='" & CStr(lngCommandBarId) & "']")    ' DEV_STRING
                If Not objCmdBar Is Nothing Then
                    objCmdBar.parentNode.removeChild objCmdBar
                End If
            End If
        End If
    Next
End Sub

''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
'' ProcessMacroToolsBeforeTBLoad
''
'' NOTE: This function does not really belong in this class, as it is SA related and not
'' specific ONLY to the toolbar - but it has become very tied to the format of the XML
'' produced by CodeJock. Hence the reason it now resides here.
''
'' The function goes through the macro tools, renumbering them to have one contiguous block of
'' IDs - this involves renumbering all references.
'' In addition it clears the inserted in menu flag for all macro tools which do not exist in the menu
'' system (except as a master tool)
''
Private Sub ProcessMacroToolsBeforeTBLoad(ByRef r_objTBDoc As DOMDocument)
' Processes any tools from the root tools collection which are prefixed with MACROPREFIX
' This is to ensure they have good IDs
    Dim objToolItem As IXMLDOMElement
    Dim objTools As IXMLDOMNodeList
    Dim objOtherToolItem As IXMLDOMElement
    Dim objOtherTools As IXMLDOMNodeList
    Dim objTags As IXMLDOMElement
    Dim MacroPrefixLen As Long
    Dim MacroPopupPrefixLen As Long
    Dim ToolPrefix As String
    Dim ToolPopupPrefix As String
    Dim lngNewId As Long
    Dim lngOldId As Long
    Dim strToolName As String
    Dim lngUpdateFlags As Long
    Dim lngIndex As Long
    Dim lngOtherIndex As Long
    Dim strOldId As String
    
    MacroPrefixLen = Len(MACROPREFIX)
    MacroPopupPrefixLen = Len(MACROPOPUPPREFIX)
    
#If TOOLDEBUGGING Then
    LogMessageTools "ProcessMacroToolsBeforeTBLoad..." 'DEV_STRING
#End If
    
    ' Prefix all tool ToolIDs with a # to identify them as original
    Set objTools = r_objTBDoc.selectNodes("//Control[starts-with(@Parameter,'" & MACROPREFIX & "')]") 'DEV_STRING
    For lngIndex = 0 To objTools.Length - 1
        Set objToolItem = objTools(lngIndex)
        lngOldId = objToolItem.getAttribute("Id") 'DEV_STRING
        Call objToolItem.setAttribute("Id", "#" & CStr(lngOldId)) 'DEV_STRING
    
        ' Prefix image ToolIDs with a # to identify them as original
        Set objToolItem = r_objTBDoc.selectSingleNode("//Images/IconSet[@Id=" & lngOldId & "]") 'DEV_STRING
        If Not objToolItem Is Nothing Then
            Call objToolItem.setAttribute("Id", "#" & CStr(lngOldId)) 'DEV_STRING
        End If
    Next
        
    ' Actually do the update
    Set objTools = r_objTBDoc.selectNodes("//CommandBars/CommandBar[@Title='Controls']/Controls/Control[starts-with(@Parameter,'" & MACROPREFIX & "')]") 'DEV_STRING
    For lngIndex = 0 To objTools.Length - 1
        Set objToolItem = objTools(lngIndex)
        strToolName = objToolItem.getAttribute("Parameter") 'DEV_STRING

        strOldId = objToolItem.getAttribute("Id") 'DEV_STRING
        lngOldId = CLng(Mid(strOldId, 2))
        
        ' See if the tool exists in the menu system
        Set objOtherTools = r_objTBDoc.selectNodes("//Control[@Id='" & strOldId & "']") 'DEV_STRING

        If objOtherTools.Length > 1 Then   ' 1 will exist as it is the master tool
            ' The tool DOES exist in the menus/toolbars so update it
            lngNewId = GetFreeMacroId()     ' Get the next macro id
            
#If TOOLDEBUGGING Then
            LogMessageTools "SAToolBar ProcessMacroToolsBeforeTBLoad - Found macro tool " & lngOldId & " in the menus - updating." 'DEV_STRING
#End If
        
            ' Correct the tool IDs throughout
            For Each objOtherToolItem In objOtherTools
                Call objOtherToolItem.setAttribute("Id", CStr(lngNewId)) 'DEV_STRING
                Call objOtherToolItem.setAttribute("IconId", CStr(lngNewId)) 'DEV_STRING
            Next
            
'' PLEASE KEEP THIS COMMENT AND CODE:
'' Do NOT set the UpdateFlags to say the item is inserted in the menu as :-
'' 1. This should only be the case when CODE put the item in the menu system
'' 2. Doing this will make user customizations of macros which have NO INSERT CODE - never be made visible by the MAC_CreateToolItemByProc
''                ' Fetch it's flags and update them
''                Set objTags = objToolItem.selectSingleNode("./SATags") 'DEV_STRING
''                If Not objTags Is Nothing Then
''                    lngUpdateFlags = objTags.getAttribute("UpdateFlags") 'DEV_STRING
''                    lngUpdateFlags = lngUpdateFlags Or MENUTOOL_INSERTEDINMENU  ' Set inserted in menu flag
''                    Call objTags.setAttribute("UpdateFlags", lngUpdateFlags) 'DEV_STRING
''                End If
            
#If TOOLDEBUGGING Then
            LogMessageTools "SAToolBar ProcessMacroToolsBeforeTBLoad - renumbering macro tool " & lngOldId & " to " & lngNewId 'DEV_STRING
#End If
            ' Correct the icon image IDs
            Set objOtherToolItem = r_objTBDoc.selectSingleNode("//Images/IconSet[@Id='" & strOldId & "']") 'DEV_STRING
            If Not objOtherToolItem Is Nothing Then
#If TOOLDEBUGGING Then
                LogMessageTools "SAToolBar ProcessMacroToolsBeforeTBLoad - renumbering icon id " & lngOldId & " to " & lngNewId 'DEV_STRING
#End If
                Call objOtherToolItem.setAttribute("Id", CStr(lngNewId)) 'DEV_STRING
            End If
        End If
    Next
    
    ' Check for tools which are in the menus but not in the master tools (or vice versa)
    Set objTools = r_objTBDoc.selectNodes("//Control[starts-with(@Id,'#')]") 'DEV_STRING
    For lngIndex = objTools.Length - 1 To 0 Step -1
        Set objToolItem = objTools(lngIndex)
        strOldId = objToolItem.getAttribute("Id") 'DEV_STRING
        lngOldId = CLng(Mid(strOldId, 2))
        strToolName = objToolItem.getAttribute("Parameter") 'DEV_STRING

        ' The tool does not exist in the menu system so remove the master tool - it will be re-added when the macro is loaded by VBA - if it is still required
#If TOOLDEBUGGING Then
        LogMessageTools "SAToolBar ProcessMacroToolsBeforeTBLoad - cleared tool as NOT inserted in menu id=" & lngOldId 'DEV_STRING
#End If
        ' Remove the tool
        objToolItem.parentNode.removeChild objToolItem
    
        ' Remove any associated band - if present
        Set objOtherToolItem = r_objTBDoc.selectSingleNode("//CommandBar[@Title='" & strToolName & "']") 'DEV_STRING
        If Not objOtherToolItem Is Nothing Then
            objOtherToolItem.parentNode.removeChild objOtherToolItem
        End If
    Next
    
    ' Check for unused images and remove them
    Set objTools = r_objTBDoc.selectNodes("//Images/IconSet[starts-with(@Id,'#')]") 'DEV_STRING
    For lngIndex = objTools.Length - 1 To 0 Step -1
        Set objToolItem = objTools(lngIndex)
        
        objToolItem.parentNode.removeChild objToolItem
    Next
End Sub

Private Sub UpdateAllSubMenuTools(ByRef r_objTBControl As CommandBarControl)
    Dim objControl As CommandBarControl
    Dim objMainControl As CommandBarControl
    Dim objCmdBar As CommandBar
    
    On Error Resume Next
    Set objCmdBar = r_objTBControl.CommandBar
    On Error GoTo 0
    
    If Not objCmdBar Is Nothing Then
        For Each objControl In objCmdBar.Controls
            Set objMainControl = m_objToolBar.DesignerControls.Find(, objControl.Id)
            If Not objMainControl Is Nothing Then
                ' Show the tool if necessary
                objControl.Visible = objMainControl.Visible
            End If
            If objControl.Type = xtpControlButtonPopup Or objControl.Type = xtpControlPopup Then
                ' Show the sub menu's tools
                UpdateAllSubMenuTools objControl
            End If
        Next
    End If
End Sub

Private Sub UpdateAllMenuTools()
    Dim objControl As CommandBarControl
        
    For Each objControl In m_objToolBar(1).Controls
        UpdateAllSubMenuTools objControl
    Next
End Sub

Private Sub AddCustomizeTools()
    Dim objControl As CommandBarControl
    
    ' Add the REAL Customize tool to the main toolbar collection
    Set objControl = m_objToolBar.DesignerControls.Add(xtpControlButton, SAIDM_CODEJOCKCUSTOMIZE, SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____customize))
    objControl.Visible = False
    objControl.CloseSubMenuOnClick = True
    
    ' Add the User version of the Customize tool to the main toolbar collection
    Set objControl = m_objToolBar.DesignerControls.Add(xtpControlButton, SAIDM_TOOLBARCUSTOMIZE, SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____customize))
    objControl.Category = SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____toolbars)

    ' Add a control to let the user destroy their toolbar file
    Set objControl = m_objToolBar.DesignerControls.Add(xtpControlButton, SAIDM_TOOLBARRESET, SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____resettoolbar))
    objControl.Category = SAXRes.GetLocalString(IDS_sa2001satoolbarcls_____toolbars)
End Sub

Private Sub m_objToolBar_ToolBarContextMenu(ByVal ToolBar As XtremeCommandBars.ICommandBar, ByVal ContextMenu As XtremeCommandBars.ICommandBar)
    Dim objControl As CommandBarControl
            
    Set objControl = m_objToolBar.DesignerControls.Find(, SAIDM_TOOLBARRESET)
    objControl.BeginGroup = True
    objControl.Copy ContextMenu
    
    Set objControl = ContextMenu.FindControl(, SAIDM_CODEJOCKCUSTOMIZE)
    If Not objControl Is Nothing Then
        objControl.Visible = False  ' Hide the codejock menu item
        
        ' Add our menu item
        Set objControl = m_objToolBar.DesignerControls.Find(, SAIDM_TOOLBARCUSTOMIZE)
        objControl.BeginGroup = True
        objControl.Copy ContextMenu
        objControl.Visible = True
    Else
        If CmdLineQAReporting Then
            SAMessageBox "The CodeJock Customize tool was not found"    'DEV_STRING
        End If
    End If
End Sub

Public Sub ShowCustomizeToolbarsDialog()
    Dim objControl As CommandBarControl
        
    UpdateAllMenuTools      ' Force menu items to have the correct visibility state (the event doesn't fire to do this for us)
    
    ' Convoluted set of steps allows us to show the customize dialog when we want
    Set objControl = m_objToolBar.DesignerControls.Find(, SAIDM_CODEJOCKCUSTOMIZE)
    objControl.Visible = False      ' Ensure it is invisible
    objControl.Copy m_objToolBar(1)  ' Pop it after the help menu on the main menu bar (invisible)
    Set objControl = m_objToolBar(1).Controls.Find(, SAIDM_CODEJOCKCUSTOMIZE)    ' Find the tool we just placed
    objControl.Execute      ' Execute the tool
    objControl.Delete       ' Now remove it
End Sub

Public Function ShowBandAsPopup(ByVal v_strPopupName As String) As Boolean
    Dim objPopup As CommandBar
    Dim objControl As CommandBarControl
    Dim objChildControl As CommandBarControl
    Dim objCopyTool As SAToolbarTool
    Static blnReEntered As Boolean
    
    On Error GoTo ErrExit
    If blnReEntered Then
        ' Only one context menu at a time please
        Exit Function
    Else
        blnReEntered = True
    End If
    
    If v_strPopupName <> "" Then
        Set objPopup = m_objToolBar.Add("Popup", xtpBarPopup)
        If AddContextBand(objPopup, v_strPopupName) Then
            objPopup.ShowPopup
            ShowBandAsPopup = True
        End If
        objPopup.Delete
    End If
    
ErrExit:
    blnReEntered = False
End Function

Private Function AddContextBand(ByRef r_objPopUp As CommandBar, ByVal v_strBandName As String) As Boolean
    Dim lngIndex As Long
    Dim objBand As SAToolbarBand
    Dim objCopyTool As SAToolbarTool
    Dim objControl As CommandBarControl
    Dim objControlPopup As CommandBarPopup
    Dim objCopyToolMaster As SAToolbarTool
    Dim blnSeparator As Boolean
    
    On Error Resume Next
    Set objBand = Bands(v_strBandName)
    On Error GoTo ErrExit
    
    If Not objBand Is Nothing Then
        For lngIndex = 0 To objBand.Tools.Count - 1
            Set objCopyTool = objBand.Tools(lngIndex)
            blnSeparator = blnSeparator Or objCopyTool.BeginGroup
            
            If Not objCopyTool.SubBand Is Nothing Then
                ' There is a subband, check the enabled state
                Set objControlPopup = r_objPopUp.Controls.Add(xtpControlButtonPopup, objCopyTool.toolID, objCopyTool.Caption)
                objControlPopup.DescriptionText = objCopyTool.Tool.DescriptionText
                objControlPopup.iconID = objCopyTool.Tool.iconID
                objControlPopup.Parameter = objCopyTool.Tool.Parameter
                objControlPopup.ShortcutText = objCopyTool.Tool.ShortcutText
                objControlPopup.ToolTipText = objCopyTool.Tool.ToolTipText
                If Not AddContextBand(objControlPopup.CommandBar, objCopyTool.SubBandName) Then  ' Get the subband added (if any)
                    ' No tools in the subband so ditch the control
                    objControlPopup.Delete
                Else
                    On Error Resume Next
                    Set objCopyToolMaster = Nothing
                    Set objCopyToolMaster = Tools(objCopyTool.Name) ' Get the master tool to check state
                    On Error GoTo ErrExit
                    If Not objCopyToolMaster Is Nothing Then
                        objCopyToolMaster.Enabled = True  ' This is required to ensure the master popup tool is up to date - otherwise a CodeJock_Update event may disable it
                        objCopyToolMaster.Visible = True  ' This is required to ensure the master popup tool is up to date - otherwise a CodeJock_Update event may hide it
                    End If
                    
                    ' Now sort out our little popup
                    objControlPopup.Caption = objCopyTool.Caption
                    objControlPopup.Visible = True
                    objControlPopup.Enabled = True
                    objControlPopup.BeginGroup = blnSeparator
                    blnSeparator = False
                    AddContextBand = True   ' There were tools in this band
                End If
            Else
                On Error Resume Next
                Set objCopyToolMaster = Nothing
                Set objCopyToolMaster = Tools(objCopyTool.Name) ' Get the master tool to check state
                On Error GoTo ErrExit
                If Not objCopyToolMaster Is Nothing Then
                    If objCopyToolMaster.Enabled And objCopyToolMaster.Visible Then
                        ' The tool is available so add it
                        Set objControl = objCopyTool.Tool.Copy(r_objPopUp)
                        objControl.Caption = objCopyTool.Caption
                        objControl.Visible = True
                        objControl.Enabled = True
                        objControl.BeginGroup = blnSeparator
                        blnSeparator = False
                        AddContextBand = True   ' There were tools in this band
                    End If
                End If
            End If
        Next
    End If
    Exit Function
ErrExit:
End Function

Public Sub GetComboBoxFont(ByRef r_strName As String, ByRef r_lSize As Long, ByRef r_lCharset As Long)
    r_strName = m_objToolBar.Options.ComboBoxFont.Name
    r_lSize = m_objToolBar.Options.ComboBoxFont.Size
    r_lCharset = m_objToolBar.Options.ComboBoxFont.Charset
End Sub

