egtstone3d/SVG/SVGVM.vb

Imports System.Globalization
Imports System.Xml

Public Class SVGVM

#Region "FIELDS & PROPERTIES"

   Private m_Img As String = String.Empty
   Public Property Img As String
      Get
         Return m_Img
      End Get
      Set(value As String)
         m_Img = value
      End Set
   End Property

   Private m_Svg As String = String.Empty
   Public ReadOnly Property Svg As String
      Get
         Return m_Svg
      End Get
   End Property

   Private m_LocalMyCanvas As MyCanvas
   Public ReadOnly Property LocalMyCanvas As MyCanvas
      Get
         Return m_LocalMyCanvas
      End Get
   End Property

   Private m_SVG_Visibility As Visibility = Visibility.Collapsed
   Public Property SVG_Visibility As Visibility
      Get
         Return m_SVG_Visibility
      End Get
      Set(value As Visibility)
         m_SVG_Visibility = value
      End Set
   End Property

   Private m_Img_Visibility As Visibility = Visibility.Collapsed
   Public Property Img_Visibility As Visibility
      Get
         Return m_Img_Visibility
      End Get
      Set(value As Visibility)
         m_Img_Visibility = value
      End Set
   End Property

#End Region    ' Fields & Properties

#Region "CONSTRUCTOR"

   Sub New(SVG_File As String)
      ' Verifico estensione
      If System.IO.Path.GetExtension(SVG_File) = ".png" Then
         m_Img = SVG_File
         m_Svg = ""
         m_Img_Visibility = Visibility.Visible
      Else
         m_Svg = SVG_File
         m_Img = ""
         m_SVG_Visibility = Visibility.Visible
      End If
      Dim CanvWidth As Integer = 145
      Dim CanvHeight As Integer = CInt(CanvWidth / 1.4)
      m_LocalMyCanvas = New MyCanvas(CanvWidth, CanvHeight)
      If System.IO.File.Exists(m_Svg) Then
         ReadMyXML(m_Svg, m_LocalMyCanvas)
      End If
   End Sub

#End Region    ' Constructor

End Class

#Region "ELEMENTI PER LA GESTIONE SVG"

Public Class MyCanvas

#Region "FIELDS & PROPERTIES"

   Private m_CurrCanvas As New Canvas
   Public Property CurrCanvas As Canvas
      Get
         Return m_CurrCanvas
      End Get
      Set(value As Canvas)
         m_CurrCanvas = value
      End Set
   End Property

   Private m_ListPath As New List(Of MyPath)
   Public Property ListPath As List(Of MyPath)
      Get
         Return m_ListPath
      End Get
      Set(value As List(Of MyPath))
         m_ListPath = value
      End Set
   End Property

   Private m_ViewBoxDim As String
   Public Property ViewBoxDim As String
      Get
         Return m_ViewBoxDim
      End Get
      Set(value As String)
         m_ViewBoxDim = value
      End Set
   End Property

#End Region    ' Fields & Properties

#Region "CONSTRUCTOR"

   Sub New(Width As Integer, Height As Integer)
      m_CurrCanvas.Width = Width
      m_CurrCanvas.Height = Height
      m_CurrCanvas.ClipToBounds = True
   End Sub

#End Region    ' Constructor

#Region "METHODS"

   Public Sub LoadCanvas()
      For Each ItemPath As MyPath In m_ListPath
         m_CurrCanvas.Children.Add(ItemPath.CurrPath)
      Next
   End Sub

   Public Sub UpdateMyPath(CurrPath As MyPath)
      m_CurrCanvas.Children.Remove(CurrPath.CurrPath)
      m_CurrCanvas.Children.Add(CurrPath.CurrPath)
   End Sub

#End Region    ' Methods

End Class

Public Class MyPath

#Region "FIELDS & PROPERTIES"

   Private m_CurrPath As New System.Windows.Shapes.Path
   Public Property CurrPath As System.Windows.Shapes.Path
      Get
         Return m_CurrPath
      End Get
      Set(value As System.Windows.Shapes.Path)
         m_CurrPath = value
      End Set
   End Property

   Private m_CanvX As Double
   Public ReadOnly Property CanvX As Double
      Get
         Return m_CanvX
      End Get
   End Property

   Private m_CanvY As Double
   Public ReadOnly Property CanvY As Double
      Get
         Return m_CanvY
      End Get
   End Property

   Private m_DimX As Double
   Public ReadOnly Property DimX As Double
      Get
         Return m_DimX
      End Get
   End Property

   Private m_DimY As Double
   Public ReadOnly Property DimY As Double
      Get
         Return m_DimY
      End Get
   End Property

   Private m_id As String
   Public ReadOnly Property id As String
      Get
         Return m_id
      End Get
   End Property

   Private m_d As String
   Public ReadOnly Property d As String
      Get
         Return m_d
      End Get
   End Property

   Private m_fill As String
   Public Property fill As String
      Get
         Return m_fill
      End Get
      Set(value As String)
         m_fill = value
      End Set
   End Property

   Private m_fill_opacity As Double
   Public Property fill_opacity As Double
      Get
         Return m_fill_opacity
      End Get
      Set(value As Double)
         m_fill_opacity = value
      End Set
   End Property

   Private m_stroke As String
   Public Property stroke As String
      Get
         Return m_stroke
      End Get
      Set(value As String)
         m_stroke = value
      End Set
   End Property

   Private m_stroke_opacity As Double
   Public Property stroke_opacity As Double
      Get
         Return m_stroke_opacity
      End Get
      Set(value As Double)
         m_stroke_opacity = value
      End Set
   End Property

   Private m_stroke_width As Double
   Public Property stroke_width As Double
      Get
         Return m_stroke_width
      End Get
      Set(value As Double)
         m_stroke_width = value
      End Set
   End Property

#End Region    ' Fields & Properties

#Region "CONSTRUCTOR"

   Sub New(Id As String, D As String, CanvX As Double, CanvY As Double, DimX As Double, DimY As Double, Fill As String, FillOpacity As Double, Stroke As String, StrokeOpacity As Double, StrokeWidthAttribute As Double)
      m_id = Id
      m_d = D
      m_CanvX = CanvX
      m_CanvY = CanvY
      m_DimX = DimX
      m_DimY = DimY
      m_fill = Fill
      m_fill_opacity = FillOpacity
      m_stroke = Stroke
      m_stroke_opacity = StrokeOpacity
      m_stroke_width = StrokeWidthAttribute
      LoadPath()
   End Sub

#End Region    ' Constructor

#Region "METHODS"

   Public Sub LoadPath()
      ' Carico la geometria
      m_CurrPath.Data = Geometry.Parse(d)
      ' Carico il colore di sfondo
      SetBrushFromRGBString(m_fill, m_CurrPath.Fill)
      ' Carico colore linea
      SetBrushFromRGBString(m_stroke, m_CurrPath.Stroke)
      ' Carico spessore linea
      If m_stroke_width < 5 Then m_stroke_width = 10
      m_CurrPath.StrokeThickness = m_stroke_width
      ' Applico l'opacità della superificie
      m_CurrPath.Opacity = m_fill_opacity
      ' Calcolo e applico la traslazione e la scalatura
      Dim myTransformGroup As New TransformGroup()
      Dim ScaleX As Double = m_CanvX / DimX
      Dim ScaleY As Double = m_CanvY / DimY
      Dim OffX As Double = (m_CanvX - Math.Min(ScaleX, ScaleY) * DimX) / 2
      Dim OffY As Double = (m_CanvY - Math.Min(ScaleX, ScaleY) * DimY) / 2
      myTransformGroup.Children.Add(New ScaleTransform(Math.Min(ScaleX, ScaleY), Math.Min(ScaleX, ScaleY)))
      myTransformGroup.Children.Add(New TranslateTransform(OffX, OffY))
      m_CurrPath.RenderTransform = myTransformGroup
   End Sub

   Private Sub SetBrushFromRGBString(sFill As String, ByRef brFill As Brush)
      If String.IsNullOrEmpty(sFill) Then
         brFill = Brushes.DarkRed
         Return
      End If
      Dim s1 As String = sFill
      If s1.Contains("rgb") Then
         s1 = s1.Replace("rgb(", "")
         s1 = s1.Replace(")", "")
         Dim s2 As String = ""
         For Each s As String In s1.Split(",")
            s2 &= CInt(s).ToString("x2")
         Next
         brFill = New BrushConverter().ConvertFrom("#" & s2)
      End If
   End Sub

#End Region    ' Methods

End Class

Public Module XMLReader

#Region "METHODS"

   Public Sub ReadMyXML(FilePath As String, Canv As MyCanvas)
      'Create the XML Reader
      Dim m_xmlr As XmlTextReader = New XmlTextReader(FilePath)
      'Disable whitespace so that you don't have to read over whitespaces
      m_xmlr.WhitespaceHandling = WhitespaceHandling.None
      ' Leggo la prima riga: '?xml' tag
      m_xmlr.Read()
      ' Passo a leggere la successiva: 'svg' tag
      m_xmlr.Read()
      ' Leggo gli attributi di questo tag (dimensioni)
      Dim ViewBoxDim = m_xmlr.GetAttribute("viewBox")
      Canv.ViewBoxDim = ViewBoxDim
      ' Elaboro i dati per avere la scalatura del disegno
      Dim DimViewBox As String() = ViewBoxDim.ToString.Split(" ")
      Dim DimX As Integer = Math.Abs(CInt(DimViewBox(2))) + Math.Abs(CInt(DimViewBox(0)))
      Dim DimY As Integer = Math.Abs(CInt(DimViewBox(3))) + Math.Abs(CInt(DimViewBox(1)))

      ' Leggo in loop i tag: 'path'
      While Not m_xmlr.EOF
         m_xmlr.Read()
         If Not m_xmlr.IsStartElement() Then
            Continue While
         End If
         ' recupero il valore dell'attributo 'id'
         Dim idAttribute = m_xmlr.GetAttribute("id")
         ' recupero il valore dell'attributo 'd'
         Dim dAttribute = m_xmlr.GetAttribute("d")
         ' recupero il valore dell'attributo 'fill'
         Dim fillAttribute = m_xmlr.GetAttribute("fill")
         ' recupero il valore dell'attributo 'fill-opacity'
         Dim fillOpacityAttribute = m_xmlr.GetAttribute("fill-opacity")
         ' recupero il valore dell'attributo 'stroke'
         Dim strokeAttribute = m_xmlr.GetAttribute("stroke")
         ' recupero il valore dell'attributo 'stroke-opacity'
         Dim strokeOpacityAttribute = m_xmlr.GetAttribute("stroke-opacity")
         ' recupero il valore dell'attributo 'stroke - Width'
         Dim strokeWidthAttribute = m_xmlr.GetAttribute("stroke-width")
         ' carico l'elemento in lista solo se esiste un'immagine
         If Not String.IsNullOrEmpty(idAttribute) And Not String.IsNullOrEmpty(dAttribute) Then
            Dim fillOpacity As Double = 1 ' CDbl(fillOpacityAttribute)
            StringToDouble(fillOpacityAttribute, fillOpacity)
            Dim strokeOpacity As Double = 1 ' CDbl(strokeOpacityAttribute)
            StringToDouble(strokeOpacityAttribute, strokeOpacity)
            Dim strokeWidth As Double = 1
            StringToDouble(strokeWidthAttribute, strokeWidth)
            Canv.ListPath.Add(New MyPath(idAttribute, dAttribute, Canv.CurrCanvas.Width, Canv.CurrCanvas.Height, DimX, DimY, fillAttribute, fillOpacity, strokeAttribute, strokeOpacity, strokeWidth))
         End If

      End While
      ' Libero il file dalla lettura
      m_xmlr.Close()
      ' popolo la canvas con le Ptah che ho caricato
      Canv.LoadCanvas()
   End Sub

   Public Sub WriteMyXML(FilePath As String, Canv As MyCanvas)

      Dim _namespaceDefault As String = "http://www.w3.org/2000/svg"

      Dim doc As New Xml.XmlDocument

      Dim elm As System.Xml.XmlNode
      Dim elmSub As System.Xml.XmlNode
      Dim elmMain As Xml.XmlNode

      doc = New Xml.XmlDocument

      elmMain = doc.CreateElement("svg")
      elmSub = elmMain.Attributes.Append(doc.CreateAttribute("viewBox"))
      elmSub.Value = Canv.ViewBoxDim
      elmSub = elmMain.Attributes.Append(doc.CreateAttribute("xmlns"))
      elmSub.Value = _namespaceDefault

      For Each itemPath As MyPath In Canv.ListPath
         elm = elmMain.AppendChild(doc.CreateElement("path"))

         elmSub = elm.Attributes.Append(doc.CreateAttribute("id"))
         elmSub.Value = itemPath.id

         elmSub = elm.Attributes.Append(doc.CreateAttribute("d"))
         elmSub.Value = itemPath.d

         If Not String.IsNullOrEmpty(itemPath.fill) Then
            elmSub = elm.Attributes.Append(doc.CreateAttribute("fill"))
            elmSub.Value = itemPath.fill
         End If

         If Not String.IsNullOrEmpty(itemPath.fill_opacity) Then
            elmSub = elm.Attributes.Append(doc.CreateAttribute("fill-opacity"))
            elmSub.Value = itemPath.fill_opacity.ToString(CultureInfo.InvariantCulture)
         End If

         If Not String.IsNullOrEmpty(itemPath.stroke) Then
            elmSub = elm.Attributes.Append(doc.CreateAttribute("stroke"))
            elmSub.Value = itemPath.stroke
         End If

         If Not String.IsNullOrEmpty(itemPath.stroke_opacity) Then
            elmSub = elm.Attributes.Append(doc.CreateAttribute("stroke-opacity"))
            elmSub.Value = itemPath.stroke_opacity.ToString(CultureInfo.InvariantCulture)
         End If

         If Not String.IsNullOrEmpty(itemPath.stroke_width) Then
            elmSub = elm.Attributes.Append(doc.CreateAttribute("stroke-width"))
            elmSub.Value = itemPath.stroke_width.ToString(CultureInfo.InvariantCulture)
         End If

      Next

      doc.AppendChild(doc.CreateXmlDeclaration("1.0", "UTF-8", ""))
      doc.AppendChild(elmMain)
      doc.Save(FilePath)

   End Sub

#End Region    ' Methods

End Module

#End Region    ' Elementi per la gestione SVG