Vector-UML-Klassen.vb

  Public Enum VUMLVisibility
    [Public]
    [Protected]
    [Private]
  End Enum
  Public Class VUMLMethod
    Public Name As String
    Public IsVoid As Boolean
    Public ReturnValue As String
    Public Parameters As New List(Of String())
    Public Visibility As VUMLVisibility
    Public Overrides Function ToString() As String
      Return If(Visibility = VUMLVisibility.Public, "+", If(Visibility = VUMLVisibility.Private, "-", "#")) + _
             "  " + If(IsVoid, "!", "?") + "  " + Name + " (" + GetParametersString() + ") " + If(IsVoid, "", " : " + ReturnValue)
    End Function
    Public Function GetParametersString() As String
      Dim para(Parameters.Count - 1) As String
      For i = 0 To para.Length - 1
        para(i) = Join(Parameters(i), " : ")
      Next
      Return Join(para, ", ")
    End Function
    Public Shared Function FromString(ByVal str As String) As VUMLMethod
      Dim d = System.Text.RegularExpressions.Regex.Match(str, "^\s*([+#-])\s*([\!\?])\s*([a-zA-Z0-9_-]+)\s*\(([^)]*)\)(\s*:\s*([a-zA-Z0-9_-]+))?\s*$")
      If d.Success = False Then Return Nothing
      Dim m As New VUMLMethod
      Select Case d.Groups(1).Value
        Case "+" : m.Visibility = VUMLVisibility.Public
        Case "#" : m.Visibility = VUMLVisibility.Protected
        Case "-" : m.Visibility = VUMLVisibility.Private
      End Select
      m.Name = d.Groups(3).Value
      If d.Groups(2).Value = "?" And d.Groups(6).Success Then _
      m.ReturnValue = d.Groups(6).Value Else m.IsVoid = True
      Dim params() As String = Split(d.Groups(4).Value, ",")
      For Each para In params
        Dim splitted() = Split(para, ":")
        If splitted.Length <> 2 Then Continue For
        splitted(0) = Trim(splitted(0)) : splitted(1) = Trim(splitted(1))
        m.Parameters.Add(splitted)
      Next
      Return m
    End Function
  End Class
  Public Class VUMLAttribute
    Public Name As String
    Public Type As String
    Public Visibility As VUMLVisibility
    Public Overrides Function ToString() As String
      Return If(Visibility = VUMLVisibility.Public, "+", If(Visibility = VUMLVisibility.Private, "-", "#")) + _
             "  " + Name + " : " + Type
    End Function
    Public Shared Function FromString(ByVal str As String) As VUMLAttribute
      Dim d = System.Text.RegularExpressions.Regex.Match(str, "^\s*([+#-])\s*([a-zA-Z0-9_()\[\]-]+)\s*:\s*([a-zA-Z0-9_()\[\]-]+)\s*$")
      If d.Success = False Then Return Nothing
      Dim a As New VUMLAttribute
      Select Case d.Groups(1).Value
        Case "+" : a.Visibility = VUMLVisibility.Public
        Case "#" : a.Visibility = VUMLVisibility.Protected
        Case "-" : a.Visibility = VUMLVisibility.Private
      End Select
      a.Name = d.Groups(2).Value
      a.Type = d.Groups(3).Value
      Return a
    End Function
  End Class

  Public Class VUMLClass
    Inherits VObject
    Public fill As Brush = New SolidBrush(Color.Transparent)

    Public Visibility As VUMLVisibility
    Public ClassName As String
    Public Methods As New List(Of VUMLMethod)
    Public Attributes As New List(Of VUMLAttribute)
    Public Subtitle As String

    Private Shared font1 As New Font("Microsoft Sans Serif", 12, FontStyle.Bold, GraphicsUnit.Point)
    Private Shared font2 As New Font("Microsoft Sans Serif", 8, FontStyle.Regular, GraphicsUnit.Point)

    Protected Overrides Sub DrawObjectInternal(ByVal g As System.Drawing.Graphics)
      Dim box1Height As Integer = 30 + If(String.IsNullOrEmpty(Subtitle), 0, 15)
      g.FillRectangle(Brushes.White, bounds)
      g.FillRectangle(fill, Left, Top, Width, box1Height)

      If HasBorder() Then g.DrawLine(borderPen, Left, Top + box1Height, bounds.Right, Top + box1Height)
      DrawBorder(g)

      g.DrawString(ClassName, font1, Brushes.White, Left + 3, Top + 3)
      g.DrawString(Subtitle, font2, Brushes.White, Left + 3, Top + 20)

      Dim yy = Top + box1Height + 4

      For Each v In Attributes
        Dim siz = g.MeasureString(v.ToString, font2, Width - 10)
        g.DrawString(v.ToString, font2, Brushes.Black, New Rectangle(Left + 3, yy, Width, siz.Height))
        yy += siz.Height + 3

      Next

      yy += 5
      If HasBorder() Then g.DrawLine(borderPen, Left, yy, bounds.Right, yy)
      yy += 5

      For Each v In Methods
        Dim siz = g.MeasureString(v.ToString, font2, Width - 10)
        g.DrawString(v.ToString, font2, Brushes.Black, New Rectangle(Left + 3, yy, Width, siz.Height))
        yy += siz.Height + 3

      Next

      'DrawSelection(g)
    End Sub

    Public Overrides Property Color2() As System.Drawing.Color
      Get
        Return DirectCast(fill, SolidBrush).Color
      End Get
      Set(ByVal value As System.Drawing.Color)
        DirectCast(fill, SolidBrush).Color = value
        OnContentChanged()
      End Set
    End Property

    Public Sub ParseHtmlContent(ByVal str As String)
      Dim LINES() = Split(str, vbNewLine)
      Dim block As Integer = 0
      For i = 0 To LINES.Length - 1
        Dim line = Helper.DecodeHtmlTags(Helper.StripHtmlTags(LINES(i)))

        If LINES(i).Contains("<!--Attr-->") Then block = 1
        If LINES(i).Contains("<!--Meth-->") Then block = 2

        If String.IsNullOrEmpty(line) Then Continue For

        If LINES(i).Contains("<!--Class-->") Then ClassName = line
        If LINES(i).Contains("<!--Subtitle-->") Then Subtitle = line


        If block = 1 Then
          Dim a = VUMLAttribute.FromString(line)
          If a IsNot Nothing Then Attributes.Add(a)
        End If
        If block = 2 Then
          Dim m = VUMLMethod.FromString(line)
          If m IsNot Nothing Then Methods.Add(m)
        End If

      Next
    End Sub

    Public Overrides Function ToHtml() As String
      Dim out As New System.Text.StringBuilder
      out.Append(MyBase.ToHtml)
      out.AppendLine("<div id=""" + name + """ style=""position: absolute; " & GetHtmlBorder() & GetHtmlRotation() & "  " & _
                        "z-index: " & Me.ZIndex & "; margin-left: " & Me.bounds.X & "px; margin-top: " & Me.bounds.Y & "px; height: " & Me.bounds.Height & "px; width: " & Me.bounds.Width & "px; " & _
                        """>")
      out.AppendLine("<p class='title' style='color:white; background-color: " & Helper.Color2HTMLString(DirectCast(fill, SolidBrush).Color) & ";'>")
      out.AppendLine("<!--Class--><b>" + Helper.EncodeHtmlTags(ClassName) + "</b>")
      out.AppendLine(If(Not String.IsNullOrEmpty(Subtitle), "<!--Subtitle--><br/>" + Helper.EncodeHtmlTags(Subtitle), ""))
      out.AppendLine("</p>")
      out.AppendLine("<!--Attr--><hr />")

      For Each v In Attributes
        out.AppendLine("<p>" + Helper.EncodeHtmlTags(v.ToString()) + "</p>")
      Next

      out.AppendLine("<!--Meth--><hr />")

      For Each v In Methods
        out.AppendLine("<p>" + Helper.EncodeHtmlTags(v.ToString()) + "</p>")
      Next
      out.AppendLine("</div>")
      Return out.ToString()
    End Function

    Public Overrides Sub Deserialize(ByVal Data() As String)
      Dim rOffset As Integer
      MyBase.Deserialize(Data, rOffset)
      ReDim Preserve Data(rOffset + 1)
      Me.fill = New SolidBrush(Helper.String2Color(Data(rOffset + 0)))
    End Sub

    Public Overrides Function Serialize() As String()
      Dim data() = MyBase.Serialize()
      ReDim Preserve data(CommonDataOffset + 1)
      data(CommonDataOffset + 0) = Helper.Color2String(DirectCast(fill, SolidBrush).Color)
      Return data
    End Function


  End Class