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

' A entry in a database
Private Type Entry
    Name As String
    Type As String
    Value As Variant
End Type

' The different databases currently in use
Private Type Database
    Name As String
    Entries() As Entry
    EntryCount As Long
    Process As Boolean
End Type

' Information regarding the database
Public DatabaseName As String
Public DatabaseVersion As String

' The array containing all the databases
Private aDatabase() As Database
Private aCount As Long

Public Sub SaveXML(sFile As String)

    ' Reference msxml4.dll for this
    Dim Document As New DOMDocument, Root As IXMLDOMElement, Database As IXMLDOMElement
    Dim Tell As Long, Entry As Long, Temp As Long, oEntry As IXMLDOMElement, Item As IXMLDOMElement
    
    ' Firstly, create the root-container
    Set Root = Document.createElement("language")

    ' Add it to the document and set its properties
    Document.appendChild Root
    Root.setAttribute "version", DatabaseVersion
    Root.setAttribute "name", DatabaseName

    ' Add all databases to the document
    For Tell = 0 To aCount - 1
    
        ' Create a new tag for the database
        Set Database = Document.createElement("database")
        
        ' Add it to the root node
        Root.appendChild Document.createTextNode(vbCrLf & Space(3))
        Root.appendChild Database
        
        ' Open the database
        With aDatabase(Tell)
        
            ' Set its properties
            Database.setAttribute "name", .Name
            Database.setAttribute "process", IIf(.Process, "true", "false")
            
            ' Add all entries
            For Entry = 0 To .EntryCount - 1
            
                ' Create a new entry
                Set oEntry = Document.createElement("entry")
                
                ' Add it to the database
                Database.appendChild Document.createTextNode(vbCrLf & Space(6))
                Database.appendChild oEntry
                
                ' Set its properties
                oEntry.setAttribute "name", .Entries(Entry).Name
                oEntry.setAttribute "type", .Entries(Entry).Type
                oEntry.setAttribute "array", "false"
                
                ' See if we have an array or not
                If IsArray(.Entries(Entry).Value) Then
                    
                    ' Create the bondary-element
                    Set Item = Document.createElement("bound")
                    
                    ' Add the beginning space
                    oEntry.appendChild Document.createTextNode(vbCrLf & Space(9))
                    
                    ' Add it to the entry and set its properties
                    oEntry.appendChild Item
                    Item.setAttribute "min", LBound(.Entries(Entry).Value)
                    Item.setAttribute "max", UBound(.Entries(Entry).Value)
                    
                    ' Add the array as several item-elements
                    For Temp = LBound(.Entries(Entry).Value) To UBound(.Entries(Entry).Value)
                    
                        ' Create a new entry,
                        Set Item = Document.createElement("item")
                        
                        '  ... and add it to the right parent
                        oEntry.appendChild Document.createTextNode(vbCrLf & Space(9))
                        oEntry.appendChild Item

                        ' Set its content
                        Item.setAttribute "id", Temp
                        Item.Text = .Entries(Entry).Value(Temp)
                    
                        ' In this case we have an array
                        oEntry.setAttribute "array", "true"
                    
                    Next
                    
                    ' Add the finall ending
                    oEntry.appendChild Document.createTextNode(vbCrLf & Space(6))
                    
                Else
                    oEntry.Text = CStr(.Entries(Entry).Value)
                End If
            
            Next
        
        End With

        ' Add a ending tag
        Database.appendChild Document.createTextNode(vbCrLf & Space(3))

    Next
    
    ' Add ending lines
    Root.appendChild Document.createTextNode(vbCrLf)
    
    ' Save the document
    Document.save sFile

End Sub

Public Sub LoadXML(sFile As String)

    Dim Document As New DOMDocument, Root As IXMLDOMElement, Bound As IXMLDOMElement
    Dim Database As IXMLDOMElement, Entry As IXMLDOMElement, Item As IXMLDOMElement
    Dim Index As Long, Temp As Long

    ' See if the given file is valid
    If Dir(sFile) = "" Then
        Exit Sub
    End If

    ' Firstly, clear all databases
    ClearDatabases
    
    ' Load the file
    Document.Load sFile
    
    ' Retrieve the root-element
    Set Root = Document.getElementsByTagName("language")(0)
    
    ' Load its properties
    DatabaseName = Root.getAttribute("name")
    DatabaseVersion = Root.getAttribute("version")
    
    ' Then go through all its children
    For Each Database In Root.childNodes
    
        ' See if this is a database
        If Database.nodeName = "database" Then
    
            ' Add the database
            Index = AppendDatabase(Database.getAttribute("name"), Database.getAttribute("process"))
    
            ' Add all the entries
            For Each Entry In Database.childNodes
            
                ' See if this is a entry
                If Entry.nodeName = "entry" Then
                
                    ' Add the entry
                    Temp = AppendEntry(Index, Entry.getAttribute("name"), , Entry.getAttribute("type"))
                    
                    ' Open the database
                    With aDatabase(Index)
                    
                        ' Add the value depending on whether or not it is an array
                        Select Case Entry.getAttribute("array")
                        Case "false"
                            
                            ' Just set the value
                            .Entries(Temp).Value = Entry.Text
                        
                        Case "true"
                    
                            ' Retrieve the boundary-item
                            Set Bound = Entry.getElementsByTagName("bound")(0)
                    
                            ' Make an array
                            ReDim .Entries(Temp).Value(Bound.getAttribute("min") To Bound.getAttribute("max"))
                    
                            ' Set its element
                            For Each Item In Entry.childNodes
                            
                                ' See if this is a item-element
                                If Item.nodeName = "item" Then
                                    
                                    ' Set the array
                                    .Entries(Temp).Value(Item.getAttribute("id")) = Item.Text
                                
                                End If
                            
                            Next
                    
                        End Select
                    
                    ' Close the database
                    End With
                
                End If
            
            Next
    
        End If
    
    Next

End Sub

' Manually append a database
Public Function AppendDatabase(sName As String, bProcess As Boolean) As Long

    ' Firstly, reallocate the array
    ReDim Preserve aDatabase(aCount)
    
    ' Set the different properties
    aDatabase(aCount).Name = sName
    aDatabase(aCount).Process = bProcess
    
    ' Return the index of the created database
    AppendDatabase = aCount
    
    ' Increase the count
    aCount = aCount + 1

End Function

' Manually append an entry
Public Function AppendEntry(ByVal Index As Long, sName As String, vValue As Variant, Optional sType As String = "Property") As Long

    ' Use the current database
    With aDatabase(Index)

        ' Firstly, reallocate the array
        ReDim Preserve .Entries(.EntryCount)
        
        ' Set the different properties
        .Entries(.EntryCount).Name = sName
        .Entries(.EntryCount).Value = vValue
        .Entries(.EntryCount).Type = sType
        
        ' Return the index of the created database
        AppendEntry = .EntryCount
        
        ' Increase the count
        .EntryCount = .EntryCount + 1
    
    End With

End Function

Public Sub ClearDatabases()

    ' Clear the array
    Erase aDatabase
    
    ' Clear the count
    aCount = 0

End Sub

Public Sub ClearEntries(ByVal Index As Long)
    
    ' Only continue if the index is valid
    If IsDatabase(Index) Then
    
        ' Clear both the array and the count
        Erase aDatabase(Index).Entries
        aDatabase(Index).EntryCount = 0

    End If

End Sub

Public Function IsDatabase(ByVal Index As Long) As Boolean

    ' Return whether or not this is a database
    IsDatabase = CBool(Index >= 0 And Index < aCount)

End Function

Public Function IsEntry(ByVal DataIndex As Long, ByVal EntryIndex As Long) As Boolean

    ' Return whether or not this is a database
    If IsDatabase(DataIndex) Then
        With aDatabase(DataIndex)
            IsEntry = CBool(.EntryCount >= 0 And Index < .EntryCount)
        End With
    End If

End Function

Public Function FindDatabase(Expression As String, Process As Boolean) As Long

    Dim Tell As Long
    
    ' Go through all the databases, ...
    For Tell = 0 To aCount - 1
    
        ' ... checking if any one of them corresponds to the string
        If (Expression = aDatabase(Tell).Name) And (aDatabase(Tell).Process = Process) Then
        
            ' Return the index
            FindDatabase = Tell
            
            ' We're done
            Exit Function
        
        End If
    
    Next
 
    ' No database found
    FindDatabase = -1
 
End Function

Public Function FindEntry(ByVal Index As Long, sName As String, vValue As Variant, sType As String)

    Dim Tell As Long
    
    ' See if the index is valid
    If IsDatabase(Index) Then
    
        ' Open the database
        With aDatabase(Index)
        
            ' Go through all entries in the database
            For Tell = 0 To .EntryCount - 1
                
                ' See if it corresponds to some of the search values
                If sName = .Entries(Tell).Name Or vValue = .Entries(Tell).Value _
                 Or sType = .Entries(Tell).Type Then
                
                    ' Return the index of the entry
                    FindEntry = Tell
                    
                    ' We're done
                    Exit Function
                
                End If
        
            Next
        
        End With
    
    End If

    ' Nothing was found
    FindEntry = -1

End Function

' Add the content of the form
Public Sub AppendForm(Form As Form, Optional ControlsExpression As String)

    Dim aControls, oControl As Object, sControl As String
    Dim lngFind As Long, Index As Long, vData As Variant

    ' Search for this form
    lngFind = FindDatabase(Form.Name, True)

    ' Then see if the form actually exists
    If lngFind >= 0 Then

        ' Clear the entries
        ClearEntries lngFind
        
        ' Use this database
        Index = lngFind
        
    Else
    
        ' No, create a new database
        Index = AppendDatabase(Form.Name, True)
    
    End If

    ' Save the caption of the form
    AppendEntry Index, "Caption", Form.Caption
    
    ' Secondly, get all the controls that we'll have to process
    aControls = Split(ControlsExpression, ";")
    
    ' Then go through all the controls
    For Each oControl In Form.Controls
    
        ' Get the name of the control
        sControl = TypeName(oControl)
        
        ' See if the control is valid
        If ControlsExpression = "*" Or InArray(aControls, sControl) >= 0 Then
        
            ' Clear variables
            vData = ""
        
            ' Read from the different controls
            Select Case sControl
            Case "ListView": vData = ToArray(oControl.ColumnHeaders, , , 1)
            Case "TabStrip": vData = ToArray(oControl.Tabs)
            Case "vbalListViewCtl1": vData = ToArray(oControl.Columns)
            Case "SSTab": vData = ToArray(oControl, "Tabs", "TabCaption")
            Case "ListBox", "ComboBox": vData = ToArray(oControl, "ListCount", "List")
            Case "CommandButton": vData = oControl.Caption
            Case Else: vData = oControl ' Just use the default property
            End Select
            
            ' Add the entry to the database
            AppendEntry Index, oControl.Name, vData, sControl
        
        End If
    
    Next

End Sub

' Convert all the data within a class to an ordinary array
Private Function ToArray(refObject As Object, Optional sCount As String = "Count", Optional sRead As String = "Item", Optional Start As Long) As Variant

    Dim Tell As Long, tempArray()
    
    ' Allocate array
    ReDim tempArray(Start To CallByName(refObject, sCount, VbGet) - 1)
    
    ' Go through all elements, ...
    For Tell = Start To UBound(tempArray)

        ' Set each element
        tempArray(Tell) = CallByName(refObject, sRead, VbGet, Tell).Text

    Next

    ' Return the array
    ToArray = tempArray
    
End Function

Private Sub WriteArray(refObject As Object, Data As Variant, sReset As String, sInitialize As String, sAdd As String, bSpecial As Boolean)

    Dim Tell As Long
    
    ' Make sure we're dealing with an array
    If Not IsArray(Data) Then
        Exit Sub
    End If
    
    ' Reset the control in question
    If sReset <> "" Then
        CallByName refObject, sReset, VbMethod
    End If
    
    ' Intialize/allocate (if neeeded) the control
    If sInitialize <> "" Then
        CallByName refObject, sInitialize, VbLet, (UBound(Data) - LBound(Data)) + 1
    End If

    ' Add all the elements
    For Tell = LBound(Data) To UBound(Data)
    
        ' Use a method/property depending on the initialize-function and bSpecial
        If Not bSpecial Then
            If sInitialize <> "" Then
                CallByName refObject, sAdd, VbLet, Tell, CStr(Data(Tell))
            Else
                CallByName refObject, sAdd, VbMethod, CStr(Data(Tell))
            End If
        Else
            ' In this case, the text paramenter is the third
            CallByName refObject, sAdd, VbMethod, , , CStr(Data(Tell))
        End If
    
    Next

End Sub
' Call when you need to update a form
Public Sub ProcessForm(Form As Form)

    On Error Resume Next
    Dim Index As Long, Tell As Long, vData, oControl As Object
    
    ' Find the form to use
    Index = FindDatabase(Form.Name, True)
    
    ' See if the index is valid
    If IsDatabase(Index) Then
    
        ' Open this database
        With aDatabase(Index)
    
            ' Go through all the entries in the database
            For Tell = 0 To .EntryCount - 1
            
                ' Attempt at getting the control
                Set oControl = Nothing
                Set oControl = CallByName(Form, .Entries(Tell).Name, VbGet)
            
                ' Continue if the control exists
                If Not (oControl Is Nothing) Then
                
                    ' Retrieve the data
                    vData = .Entries(Tell).Value
                    
                    ' Write the data differently depending on the type
                    Select Case .Entries(Tell).Type
                    Case "ListView": WriteArray oControl.ColumnHeaders, vData, "Clear", "", "Add", True
                    Case "TabStrip": WriteArray oControl.Tabs, vData, "Clear", "", "Add", True
                    Case "SSTab": WriteArray oControl, vData, "", "Tabs", "TabCaption", False
                    Case "vbalListViewCtl1": WriteArray oControl.Columns, vData, "Clear", "", "Add", True
                    Case "ListBox", "ComboBox": WriteArray oControl, vData, "Clear", "", "AddItem", False
                    Case "CommandButton": oControl.Caption = vData
                    Case Else: oControl = vData ' Just use the default property
                    End Select
                
                End If
                
            Next
    
        End With

    End If

End Sub

' Used when you need to update all forms in the project
Public Sub UpdateAll(aForms As Collection)
    
    Dim Form As Form
    
    ' Go through all the forms in the collection
    For Each Form In aForms
        
        ' Update it
        ProcessForm Form
        
    Next

End Sub

Private Function InArray(refArray, vEntry As Variant) As Long

    Dim Tell As Long
    
    ' Go through an array, ...
    For Tell = LBound(refArray) To UBound(refArray)
    
        ' Checking whether or not it contain a given value
        If refArray(Tell) = vEntry Then
        
            ' Return the index
            InArray = Tell
            
            ' Nothing more to find
            Exit Function
        
        End If
        
    Next

    ' Didn't find anything
    InArray = LBound(refArray) - 1

End Function

Private Sub Class_Initialize()

    ' Use a default version
    DatabaseVersion = "1.0"

End Sub