cSkinConfiguration Serialization misses border setting

Summary

Id: 755.3
Type: Bug Bug
Current Status: Open

Detail

23 Mar 2003 Open Sergey Pitutin

The bug is in serialization of cSkinConfiguration - border setting is not saving and restoring. This code will solve this problem (cSkinConfiguration class).

'---------------------Begin of
code-----------------------------------------
Public Sub Restore( _
      ByVal sXml As String, _
      picCaption As StdPicture, _
      picBorders As StdPicture _
   )
   ' Set defaults:
   SetDefaults
   
   ' Load the data:
   Dim x As New DOMDocument
   If x.loadXML(sXml) Then
      ' ok
      Dim nodTop As IXMLDOMNode
      Set nodTop = x.selectSingleNode("//NeoCaptionSkin")
      If (nodTop Is Nothing) Then
         Err.Raise vbObjectError + 1048 + 513, _
            App.EXEName & _
            ".cSkinConfiguration", "NeoCaptionSkin element not found in XML document."
      Else
         Dim nodItem As IXMLDOMNode
         For Each nodItem In nodTop.childNodes
            Select Case nodItem.nodeName
            Case "Name"
               Name = nodItem.firstChild.nodeValue
            Case "Caption"
               restoreCaption nodItem
            Case "Buttons"
               restoreButtons nodItem
            Case "Menu"
               restoreMenu nodItem
            Case "Effects"
               restoreEffects nodItem
            Case "Borders"
               restoreBorders nodItem
            End Select
         Next
      End If
      Set Caption = picCaption
      Set Borders = picBorders
   Else
      ' problem
      Err.Raise vbObjectError + 1048 + 513, _
         App.EXEName & ".cSkinConfiguration", _
         "The XML document could not be loaded: " + _
         x.parseError.reason + " at position " + x.parseError.filepos
   End If
End Sub
 
Private Sub restoreBorders(nodEffects As IXMLDOMNode)
   Dim attr As IXMLDOMAttribute
   For Each attr In nodEffects.Attributes
      Select Case attr.Name
      Case "borderHasInactiveVersion"
         BorderHasInactiveVersion = LCase(attr.value) = "yes"
      Case "leftBorderWidth"
        LeftBorderWidth = attr.value
      Case "rightBorderWidth"
        RightBorderWidth = attr.value
      Case "topSizingBorderHeight"
        TopSizingBorderHeight = attr.value
      Case "bottomSizingBorderHeight"
        BottomSizingBorderHeight = attr.value
      End Select
   Next
End Sub
 
Public Function Store() As String
   Dim x As New DOMDocument
   Dim nodTop As IXMLDOMNode
   Set nodTop = x.createElement("NeoCaptionSkin")
   
   ' Name
   Dim nodName As IXMLDOMNode
   Set nodName = x.createElement("Name")
   nodName.Text = Name
   nodTop.appendChild nodName
   
   ' Caption
   Dim nodCaption As IXMLDOMNode
   Set nodCaption = x.createElement("Caption")
   addAttribute nodCaption, "activeLeftEnd", ActiveLeftEnd
   addAttribute nodCaption, "activeRightStart", ActiveRightStart
   addAttribute nodCaption, "activeRightEnd", ActiveRightEnd
   addAttribute nodCaption, "inactiveOffset", InactiveOffset
   addAttribute nodCaption, "activeColor", ActiveCaptionColor
   addAttribute nodCaption, "inactiveColor", InActiveCaptionColor
   storeFont nodCaption, CaptionFont
   addAttribute nodCaption, "drawTitle", DrawTitle
   addAttribute nodCaption, "titleStartOffsetY", TitleStartOffsetY
   nodTop.appendChild nodCaption
   
   ' Buttons
   Dim nodButtons As IXMLDOMNode
   Set nodButtons = x.createElement("Buttons")
   addAttribute nodButtons, "buttonWidth", ButtonWidth
   addAttribute nodButtons, "buttonHeight", ButtonHeight
   addAttribute nodButtons, "controlButtonHasInactiveVersion", _
      ControlButtonHasInactiveVersion
   addAttribute nodButtons, "customControlButtonPosition", _
      CustomControlButtonPosition
   addAttribute nodButtons, "controlButtonOffsetX", ControlButtonOffsetX
   addAttribute nodButtons, "controlButtonOffsetY", ControlButtonOffsetY
   nodTop.appendChild nodButtons
      
   ' Menu
   Dim nodMenu As IXMLDOMNode
   Set nodMenu = x.createElement("Menu")
   addAttribute nodMenu, "activeMenuColor", ActiveMenuColor
   addAttribute nodMenu, "activeMenuColorOver", ActiveMenuColorOver
   addAttribute nodMenu, "inActiveMenuColor", InActiveMenuColor
   addAttribute nodMenu, "menuBackgroundColor", MenuBackgroundColor
   storeFont nodMenu, MenuFont
   addAttribute nodMenu, "menuStartOffsetY", MenuStartOffsetY
   addAttribute nodMenu, "menuStartOffsetX", MenuStartOffsetX
   nodTop.appendChild nodMenu
   
   ' Borders
   Dim nodBorders As IXMLDOMNode
   Set nodBorders = x.createElement("Borders")
   addAttribute nodBorders, "borderHasInactiveVersion", _
      BorderHasInactiveVersion
   addAttribute nodBorders, "leftBorderWidth", LeftBorderWidth
   addAttribute nodBorders, "rightBorderWidth", RightBorderWidth
   addAttribute nodBorders, "topSizingBorderHeight", _
      TopSizingBorderHeight
   addAttribute nodBorders, "bottomSizingBorderHeight", _
      BottomSizingBorderHeight
    nodTop.appendChild nodBorders
   ' Effects
   Dim nodEffects As IXMLDOMNode
   Set nodEffects = x.createElement("Effects")
   addAttribute nodEffects, "transparentColor", TransparentColor
   Dim nodColourise As IXMLDOMNode
   Set nodColourise = x.createElement("Colourise")
   addAttribute nodColourise, "active", Colourise
   addAttribute nodColourise, "hue", Hue
   addAttribute nodColourise, "saturation", Saturation
   nodEffects.appendChild nodColourise
   Dim nodAdjustRGB As IXMLDOMNode
   Set nodAdjustRGB = x.createElement("AdjustRGB")
   addAttribute nodAdjustRGB, "active", AdjustRGB
   addAttribute nodAdjustRGB, "percentRed", PercentRed
   addAttribute nodAdjustRGB, "percentBlue", PercentBlue
   addAttribute nodAdjustRGB, "percentGreen", PercentGreen
   nodEffects.appendChild nodAdjustRGB
   nodTop.appendChild nodEffects
   
   x.appendChild nodTop
   
   Store = x.xml
End Function
'---------------------End of
code-------------------------------------------
 

Best regards,

Sergey Pitutin