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

Private Declare Function GetSysColor Lib "user32.dll" ( _
   ByVal nIndex As Long _
) As Long

Private m_ActiveCaptionForeColor(3) As Long

' Loads a color scheme from file.
'
' @FilePath The path of the scheme file.
Public Static Function LoadScheme(ByVal FilePath As String) As IScheme

   Dim Doc As MSXML.DOMDocument
   
   Dim s As Long
   Dim f As Long

   Set Doc = New MSXML.DOMDocument
   Doc.Load FilePath
      
   ' ------------------------------------------------------------------------
   ' Load Themes
   ' ------------------------------------------------------------------------
   Set LoadScheme = New scheme
   
   LoadTheme Doc, LoadScheme, VbClassic
   LoadTheme Doc, LoadScheme, VbHomeStead
   LoadTheme Doc, LoadScheme, VbMetallic
   LoadTheme Doc, LoadScheme, VbNormalColor
   
End Function

' Load a color them from scheme xml definition.
'
' @Doc The scheme as xml document.
' @NewScheme The scheme instance to load theme.
' @Theme The theme to load.
Private Sub LoadTheme(ByRef Doc As MSXML.DOMDocument, ByRef NewScheme As scheme, ByVal Theme As VbWindowsScheme)
   
   Dim l_ThemeStyle As String
   Dim l_Style As String
   Dim l_Val As String
   Dim t As Long
   
   Dim l_ThemeNode As MSXML.IXMLDOMNode
   Dim l_ThemeList As MSXML.IXMLDOMNodeList
   Dim l_CapNode As MSXML.IXMLDOMNode
   Dim l_TabNode As MSXML.IXMLDOMNode
   Dim l_Node As MSXML.IXMLDOMNode
   Dim l_List As MSXML.IXMLDOMNodeList

   Select Case Theme
      Case VbWindowsScheme.VbNormalColor:    l_ThemeStyle = "normal"
      Case VbWindowsScheme.VbMetallic:       l_ThemeStyle = "metallic"
      Case VbWindowsScheme.VbHomeStead:      l_ThemeStyle = "homestead"
      Case Else:                             l_ThemeStyle = "classic"
   End Select

   Set l_ThemeList = Doc.selectNodes("scheme/theme")
   
   For t = 0 To l_ThemeList.Length
   
      Set l_ThemeNode = l_ThemeList.Item(t)
      l_Style = l_ThemeNode.Attributes.getNamedItem("style").Text
   
      If StrComp(l_Style, l_ThemeStyle) = 0 Then
         
         ' Background
         Set l_List = l_ThemeNode.selectNodes("background")
         Set l_Node = l_List.Item(0)
         NewScheme.setBackColor GetColor(l_Node), Theme
         
         ' Frame
         Set l_List = l_ThemeNode.selectNodes("frame")
         Set l_Node = l_List.Item(0)
         
         If Not l_Node Is Nothing Then
            NewScheme.setFrameColor GetColor(l_Node), Theme
         
            ' Frame Style
            l_Val = GetAttribute(l_Node, "style")
            
            Select Case LCase(l_Val)
               Case "sunken":
                    NewScheme.setFrameStyle vbFrameStyle.vbSunkenFrame, Theme
               Case "raised":
                    NewScheme.setFrameStyle vbFrameStyle.vbRaisedFrame, Theme
               Case "flat":
                    NewScheme.setFrameStyle vbFrameStyle.vbFlatFrame, Theme
               Case "else":
                    NewScheme.setFrameStyle vbFrameStyle.vbNoFrame, Theme
            End Select
         
            ' Frame Width
            l_Val = GetAttribute(l_Node, "width")
            NewScheme.setFrameWidth l_Val, Theme
         End If
         
         ' EditorArea
         Set l_List = l_ThemeNode.selectNodes("editorarea")
         Set l_Node = l_List.Item(0)
         NewScheme.setEditorAreaBackColor GetColor(l_Node), Theme
         
         ' Tabstrip
         Set l_List = l_ThemeNode.selectNodes("tabstrip")
         Set l_Node = l_List.Item(0)
         NewScheme.setTabStripBackColor GetColor(l_Node), Theme
         
         ' Splitbar
         Set l_List = l_ThemeNode.selectNodes("splitbar")
         Set l_Node = l_List.Item(0)
         NewScheme.setSplitbarColor GetColor(l_Node), Theme
         
         ' Caption
         Set l_List = l_ThemeNode.selectNodes("caption")
         Set l_CapNode = l_List.Item(0)
         
         ' Caption Style
         l_Val = GetAttribute(l_CapNode, "style")
         If StrComp(l_Val, "0", vbTextCompare) = 0 Then
            NewScheme.setCaptionStyle vbHorizontalGradient, Theme
         Else
            NewScheme.setCaptionStyle vbVerticalGradient, Theme
         End If
         
         ' Caption Visible
         l_Val = GetAttribute(l_CapNode, "visible")
         If StrComp(l_Val, "true", vbTextCompare) = "0" Then
            NewScheme.setCaptions True, Theme
         Else
            NewScheme.setCaptions False, Theme
         End If

         ' Caption Icons
         l_Val = GetAttribute(l_CapNode, "icons")
         If StrComp(l_Val, "true", vbTextCompare) = "0" Then
            NewScheme.setCaptionIcons True, Theme
         Else
            NewScheme.setCaptionIcons False, Theme
         End If

         ' Active Caption Foreground
         Set l_List = l_CapNode.selectNodes("active/foreground")
         Set l_Node = l_List.Item(0)
         NewScheme.setActiveCaptionForeColor GetColor(l_Node), Theme

         ' Active Caption Gradient1
         Set l_List = l_CapNode.selectNodes("active/background/gradient1")
         Set l_Node = l_List.Item(0)
         NewScheme.setActiveCaptionGradient1 GetColor(l_Node), Theme

         ' Active Caption Gradient2
         Set l_List = l_CapNode.selectNodes("active/background/gradient2")
         Set l_Node = l_List.Item(0)
         NewScheme.setActiveCaptionGradient2 GetColor(l_Node), Theme


         ' Inactive Caption Foreground
         Set l_List = l_CapNode.selectNodes("inactive/foreground")
         Set l_Node = l_List.Item(0)
         NewScheme.setInactiveCaptionForeColor GetColor(l_Node), Theme

         ' Inactive Caption Gradient1
         Set l_List = l_CapNode.selectNodes("inactive/background/gradient1")
         Set l_Node = l_List.Item(0)
         NewScheme.setInactiveCaptionGradient1 GetColor(l_Node), Theme

         ' Inactive Caption Gradient2
         Set l_List = l_CapNode.selectNodes("inactive/background/gradient2")
         Set l_Node = l_List.Item(0)
         NewScheme.setInactiveCaptionGradient2 GetColor(l_Node), Theme


         ' Tab
         Set l_List = l_ThemeNode.selectNodes("tab")
         
         If l_List.Length > 0 Then
            
            Set l_TabNode = l_List.Item(0)
         
            ' Active Tab Foreground
            Set l_List = l_TabNode.selectNodes("active")
            Set l_Node = l_List.Item(0)
            NewScheme.setActiveTabForeColor GetColor(l_Node), Theme
         
            ' Active Tab Foreground
            Set l_List = l_TabNode.selectNodes("active/foreground")
            Set l_Node = l_List.Item(0)
            NewScheme.setActiveTabForeColor GetColor(l_Node), Theme

            ' Active Tab Angel
            Set l_List = l_TabNode.selectNodes("active/background")
            Set l_Node = l_List.Item(0)
            NewScheme.setActiveTabGradientAngle GetAttribute(l_Node, "angel"), Theme

            ' Active Tab Gradient1
            Set l_List = l_TabNode.selectNodes("active/background/gradient1")
            Set l_Node = l_List.Item(0)
            NewScheme.setActiveTabGradient1 GetColor(l_Node), Theme

            ' Active Tab Gradient2
            Set l_List = l_TabNode.selectNodes("active/background/gradient2")
            Set l_Node = l_List.Item(0)
            NewScheme.setActiveTabGradient2 GetColor(l_Node), Theme
            
            
            ' Inactive Tab Foreground
            Set l_List = l_TabNode.selectNodes("inactive/foreground")
            Set l_Node = l_List.Item(0)
            NewScheme.setInactiveTabForeColor GetColor(l_Node), Theme

            ' Inactive Tab Angel
            Set l_List = l_TabNode.selectNodes("inactive/background")
            Set l_Node = l_List.Item(0)
            NewScheme.setInactiveTabGradientAngle GetAttribute(l_Node, "angel"), Theme

            ' Inactive Tab Gradient1
            Set l_List = l_TabNode.selectNodes("inactive/background/gradient1")
            Set l_Node = l_List.Item(0)
            NewScheme.setInactiveTabGradient1 GetColor(l_Node), Theme

            ' Inactive Tab Gradient2
            Set l_List = l_TabNode.selectNodes("inactive/background/gradient2")
            Set l_Node = l_List.Item(0)
            NewScheme.setInactiveTabGradient2 GetColor(l_Node), Theme
            
            
            ' Focus Tab Foreground
            Set l_List = l_TabNode.selectNodes("focus/foreground")
            Set l_Node = l_List.Item(0)
            NewScheme.setFocusTabForeColor GetColor(l_Node), Theme

            ' Focus Tab Angel
            Set l_List = l_TabNode.selectNodes("focus/background")
            Set l_Node = l_List.Item(0)
            NewScheme.setFocusTabGradientAngle GetAttribute(l_Node, "angel"), Theme

            ' Focus Tab Gradient1
            Set l_List = l_TabNode.selectNodes("focus/background/gradient1")
            Set l_Node = l_List.Item(0)
            NewScheme.setFocusTabGradient1 GetColor(l_Node), Theme

            ' Focus Tab Gradient2
            Set l_List = l_TabNode.selectNodes("focus/background/gradient2")
            Set l_Node = l_List.Item(0)
            NewScheme.setFocusTabGradient2 GetColor(l_Node), Theme
         End If

         Exit For
      End If
   
   Next t
   
End Sub

' Returns an attribute value of a node.
'
' @Node The xml node.
' @AttributeName The attributes name.
' @GetAttribute Returns the attribute value of a node.
Private Function GetAttribute(ByRef node As MSXML.IXMLDOMNode, ByVal AttributeName As String) As String
   
   On Error Resume Next
   
   If node Is Nothing Then Exit Function
   
   GetAttribute = node.Attributes.getNamedItem(AttributeName).Text
      
End Function

' Returns a color attribute value of a node.
'
' @Node The xml node.
' @GetColor Returns a color of the node by attribute "color" or "red", "green" and "blue".
Private Function GetColor(ByRef node As MSXML.IXMLDOMNode) As Long
   
   On Error Resume Next
  
   Dim l_Red As String
   Dim l_Green As String
   Dim l_Blue As String
   Dim l_Color As String
   
   GetColor = -1
   
   l_Color = GetAttribute(node, "color")
      
   If Len(l_Color) > 0 Then
      GetColor = GetColorConstant(l_Color)
   End If
   
   If GetColor = -1 Then
      
      l_Red = GetAttribute(node, "red")
      l_Green = GetAttribute(node, "green")
      l_Blue = GetAttribute(node, "blue")
      
      GetColor = RGB(CInt(l_Red), CInt(l_Green), CInt(l_Blue))
   End If
   
   If GetColor = -1 Then
      GetColor = vbBlack
   End If
   
End Function
' Returns a color from a color constant.
'
' @Color The color constant.
' @GetColorConstant Returns a color from a color constant.
Private Function GetColorConstant(ByVal Color As String) As Long
     
   Select Case LCase$(Color)
      Case "black":                     GetColorConstant = vbBlack
      Case "red":                       GetColorConstant = vbRed
      Case "yellow":                    GetColorConstant = vbYellow
      Case "green":                     GetColorConstant = vbGreen
      Case "blue":                      GetColorConstant = vbBlue
      Case "magenta":                   GetColorConstant = vbMagenta
      Case "cyan":                      GetColorConstant = vbCyan
      Case "white":                     GetColorConstant = vbWhite

      Case "scrollbars":                GetColorConstant = vbScrollBars
      Case "desktop":                   GetColorConstant = vbDesktop
      Case "menubar":                   GetColorConstant = vbMenuBar
      Case "menutext":                  GetColorConstant = vbMenuText
      Case "windowbackground":          GetColorConstant = vbWindowBackground
      Case "windowframe":               GetColorConstant = vbWindowFrame
      Case "windowtext":                GetColorConstant = vbWindowText
      Case "windowtext":                GetColorConstant = vbWindowText
      Case "activeborder":              GetColorConstant = vbActiveBorder
      Case "inactiveborder":            GetColorConstant = vbInactiveBorder
      Case "highlight":                 GetColorConstant = vbHighlight
      Case "highlighttext":             GetColorConstant = vbHighlightText
      Case "buttonface":                GetColorConstant = vbButtonFace
      Case "buttonshadow":              GetColorConstant = vbButtonShadow
      Case "graytext":                  GetColorConstant = vbGrayText
      Case "buttontext":                GetColorConstant = vbButtonText
      Case "3dhighlight":               GetColorConstant = vb3DHighlight
      Case "3ddkshadow":                GetColorConstant = vb3DDKShadow
      Case "3dlight":                   GetColorConstant = vb3DLight
      Case "3dface":                    GetColorConstant = vb3DFace
      Case "3dshadow":                  GetColorConstant = vb3DShadow
      Case "infotext":                  GetColorConstant = vbInfoText
      Case "infobackground":            GetColorConstant = vbInfoBackground
      Case "applicationworkspace":      GetColorConstant = vbApplicationWorkspace
      Case "inactivecaptioncolor1":     GetColorConstant = GetSysColor(3)
      Case "inactivecaptioncolor2":     GetColorConstant = GetSysColor(28)
      Case "inactivecaptiontext":       GetColorConstant = GetSysColor(19)
      Case "activecaptiontext":         GetColorConstant = GetSysColor(9)
      Case "activecaptioncolor1":       GetColorConstant = GetSysColor(2)
      Case "activecaptioncolor2":       GetColorConstant = GetSysColor(27)
      Case Else:                        GetColorConstant = vbBlack
   End Select
   
End Function
