Created
May 17, 2013 11:10
-
-
Save wintercn/5598427 to your computer and use it in GitHub Desktop.
把Powerpoint矢量图生成SVG的VBA
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
| ' svg.vba released 11.08.2002 | |
| Private Function get_export_scaling_factor() As Single | |
| '' point to pixel conversion factor | |
| get_export_scaling_factor = (4 / 3) | |
| End Function | |
| Private Function get_textbox_height_scaling_factor() As Single | |
| '' point to pixel conversion factor, further scaled up by empirically derived factor, 1.3 too small, 1.5 unnecessarily large | |
| get_textbox_height_scaling_factor = (4 / 3) * 1.4142 | |
| End Function | |
| Private Function rgb_to_colour_hash(intRGB) As String | |
| '' converts VBA RGB integer to #rrggbb format string | |
| redRGB = Hex(intRGB Mod 256) | |
| If Len(redRGB) = 1 Then | |
| redRGB = "0" & redRGB | |
| End If | |
| greenRGB = Hex(intRGB \ 256 Mod 256) | |
| If Len(greenRGB) = 1 Then | |
| greenRGB = "0" & greenRGB | |
| End If | |
| blueRGB = Hex(intRGB \ 65536 Mod 256) | |
| If Len(blueRGB) = 1 Then | |
| blueRGB = "0" & blueRGB | |
| End If | |
| rgb_to_colour_hash = "#" & redRGB & greenRGB & blueRGB | |
| End Function | |
| Private Function get_points(ByVal s As shape, ByVal scale_factor As Single) As String | |
| '' for any poly-object, creates a string of coord pairs | |
| '' takes into account re-scaling of poly-object | |
| '' why ppt keeps the creation size, goodness knows | |
| '' | |
| '' get the original bounding box (bb) | |
| numNodes = s.Nodes.Count | |
| xyCoords = s.Vertices | |
| largest_x = xyCoords(1, 1) | |
| largest_y = xyCoords(1, 2) | |
| For i = 2 To numNodes | |
| If xyCoords(i, 1) > largest_x Then | |
| largest_x = xyCoords(i, 1) | |
| End If | |
| If xyCoords(i, 2) > largest_y Then | |
| largest_y = xyCoords(i, 2) | |
| End If | |
| Next | |
| bb_x = largest_x - s.Left | |
| bb_y = largest_y - s.Top | |
| '' get the ratio, current to original | |
| x_ratio = s.Width / bb_x | |
| y_ratio = s.Height / bb_y | |
| '' establish current top-left origin | |
| x00Coord = (xyCoords(1, 1) - s.Left) * x_ratio | |
| y00Coord = (xyCoords(1, 2) - s.Top) * y_ratio | |
| '' establish current top-left corner | |
| If s.HorizontalFlip Then | |
| x = (s.Left + (s.Width - x00Coord)) * scale_factor | |
| Else | |
| x = (s.Left + x00Coord) * scale_factor | |
| End If | |
| If s.VerticalFlip Then | |
| y = (s.Top + (s.Height - y00Coord)) * scale_factor | |
| Else | |
| y = (s.Top + y00Coord) * scale_factor | |
| End If | |
| strPoints = x & "," & y | |
| '' build remaining points | |
| For i = 2 To numNodes | |
| x00Coord = (xyCoords(i, 1) - s.Left) * x_ratio | |
| y00Coord = (xyCoords(i, 2) - s.Top) * y_ratio | |
| If s.HorizontalFlip Then | |
| x = (s.Left + (s.Width - x00Coord)) * scale_factor | |
| Else | |
| x = (s.Left + x00Coord) * scale_factor | |
| End If | |
| If s.VerticalFlip Then | |
| y = (s.Top + (s.Height - y00Coord)) * scale_factor | |
| Else | |
| y = (s.Top + y00Coord) * scale_factor | |
| End If | |
| strPoints = strPoints & " " & x & "," & y | |
| Next | |
| get_points = strPoints | |
| End Function | |
| Private Function get_svg_line_colour_hash(ByVal s As shape) As String | |
| '' get stroke (colour) | |
| rgbLine = s.Line.ForeColor.RGB | |
| hrgbLine = rgb_to_colour_hash(rgbLine) | |
| get_svg_line_colour_hash = "stroke:" & hrgbLine & ";" | |
| End Function | |
| Private Function get_svg_line_width(ByVal s As shape) As String | |
| '' get stroke-width | |
| swLine = s.Line.Weight | |
| get_svg_line_width = "stroke-width:" & swLine & "pt;" | |
| End Function | |
| Private Function get_svg_line_points(ByVal s As shape) As String | |
| '' get points | |
| export_scaling_factor = get_export_scaling_factor() | |
| If s.HorizontalFlip Then | |
| If s.VerticalFlip Then '' both flips | |
| x1 = s.Left + s.Width | |
| y1 = s.Top + s.Height | |
| x2 = s.Left | |
| y2 = s.Top | |
| Else '' horizontal flip only | |
| x1 = s.Left + s.Width | |
| y1 = s.Top | |
| x2 = s.Left | |
| y2 = s.Top + s.Height | |
| End If | |
| Else '' vertical flip only | |
| If s.VerticalFlip Then | |
| x1 = s.Left | |
| y1 = s.Top + s.Height | |
| x2 = s.Left + s.Width | |
| y2 = s.Top | |
| Else '' no flip of any kind | |
| x1 = s.Left | |
| y1 = s.Top | |
| x2 = s.Left + s.Width | |
| y2 = s.Top + s.Height | |
| End If | |
| End If | |
| x1 = Int(x1 * export_scaling_factor) | |
| y1 = Int(y1 * export_scaling_factor) | |
| x2 = Int(x2 * export_scaling_factor) | |
| y2 = Int(y2 * export_scaling_factor) | |
| get_svg_line_points = "x1=" & Chr$(34) & x1 & Chr$(34) & " y1=" & Chr$(34) & y1 & Chr$(34) & _ | |
| " x2=" & Chr$(34) & x2 & Chr$(34) & " y2=" & Chr$(34) & y2 & Chr$(34) | |
| End Function | |
| Private Function substr(ByVal t As String, ByVal f As String, ByVal r As String) As String | |
| If InStr(1, r, f, vbTextCompare) > 0 Then | |
| tStr = "" | |
| tRem = t | |
| posF = InStr(1, tRem, f, vbTextCompare) | |
| While posF > 0 | |
| tStr = Left$(tRem, posF - 1) & r | |
| tRem = Right$(tRem, Len(tRem) - (posF + Len(f) - 1)) | |
| posF = InStr(1, tRem, f, vbTextCompare) | |
| Wend | |
| tStr = tStr & tRem | |
| Else | |
| tStr = t | |
| posF = InStr(1, tStr, f, vbTextCompare) | |
| While posF > 0 | |
| tStr = Left$(tStr, posF - 1) & r & Right$(tStr, Len(tStr) - (posF + Len(f) - 1)) | |
| posF = InStr(1, tStr, f, vbTextCompare) | |
| Wend | |
| End If | |
| substr = tStr | |
| End Function | |
| Private Function textbox_to_moz_svg(ByVal s As shape) As String | |
| '' this function utter rot for code fragments | |
| '' need to re-think text box output for moz | |
| export_scaling_factor = get_export_scaling_factor() | |
| x = Int(s.Left * export_scaling_factor) | |
| y = Int(s.Top * export_scaling_factor) | |
| w = Int(s.Width * export_scaling_factor) + 1 | |
| h = Int(s.Height * export_scaling_factor) + 1 | |
| '' get contents of text box | |
| txtTextBox0 = s.TextFrame.TextRange.Text | |
| txtTextBox1 = substr(txtTextBox0, "&", "&") | |
| txtTextBox2 = substr(txtTextBox1, "<", "<") | |
| txtTextBox = substr(txtTextBox2, ">", ">") | |
| '' get font family | |
| ffText = s.TextFrame.TextRange.Font.Name ' "Arial" | |
| styFamily = "font-family:" & ffText & ";" | |
| '' get font size | |
| fsText = s.TextFrame.TextRange.Font.Size ' 12, 24,... | |
| stySize = "font-size:" & fsText & "pt;" | |
| '' get colour of font | |
| rgbText = s.TextFrame.TextRange.Font.Color.RGB | |
| hrgbText = rgb_to_colour_hash(rgbText) | |
| styFill = "fill:" & hrgbText & ";" | |
| '' get font attributes | |
| fiText = s.TextFrame.TextRange.Font.Italic ' t/f | |
| If fiText Then | |
| styStyle = "font-style:italic;" | |
| Else | |
| styStyle = "" | |
| End If | |
| fbText = s.TextFrame.TextRange.Font.Bold ' t/f | |
| If fbText Then | |
| styWeight = "font-weight:bold;" | |
| Else | |
| styWeight = "" | |
| End If | |
| fuText = s.TextFrame.TextRange.Font.Underline ' t/f | |
| If fuText Then | |
| styDeco = "text-decoration:underline;" | |
| Else | |
| styDeco = "" | |
| End If | |
| h = Int(s.Height * 2) + 1 ' textbox_height_scaling_factor, or 2.0 | |
| h1 = s.Height * export_scaling_factor | |
| svgTextBox = " <foreignObject xml:space=" & Chr$(34) & "preserve" & Chr$(34) & " x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _ | |
| " width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) & _ | |
| " style=" & Chr$(34) & styFamily & stySize & styFill & styStyle & styWeight & styDeco & Chr$(34) & ">" & txtTextBox & _ | |
| "</foreignObject>" | |
| textbox_to_moz_svg = svgTextBox | |
| End Function | |
| Private Function get_svg_rect_points(ByVal s As shape) As String | |
| '' get points | |
| export_scaling_factor = get_export_scaling_factor() | |
| x = s.Left | |
| y = s.Top | |
| w = s.Width | |
| h = s.Height | |
| x = Int(x * export_scaling_factor) | |
| y = Int(y * export_scaling_factor) | |
| w = Int(w * export_scaling_factor) | |
| h = Int(h * export_scaling_factor) | |
| get_svg_rect_points = "x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _ | |
| " width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) | |
| End Function | |
| Private Function get_svg_rect_fill(ByVal s As shape) As String | |
| '' get fill colour | |
| If s.Fill.Visible = msoFalse Then | |
| hrgbRect = "transparent" | |
| Else | |
| rgbRect = s.Fill.ForeColor.RGB | |
| hrgbRect = rgb_to_colour_hash(rgbRect) | |
| End If | |
| get_svg_rect_fill = "fill:" & hrgbRect & ";" | |
| End Function | |
| Private Function get_svg_rect_stroke_width(ByVal s As shape) As String | |
| '' get stroke-width | |
| swRect = s.Line.Weight | |
| get_svg_rect_stroke_width = "stroke-width:" & swRect & "pt;" | |
| End Function | |
| Private Function get_svg_rect_stroke(ByVal s As shape) As String | |
| '' get stroke (border colour) | |
| If s.Line.Visible = msoFalse Then | |
| hrgbStroke = "transparent" | |
| Else | |
| rgbStroke = s.Line.ForeColor.RGB | |
| hrgbStroke = rgb_to_colour_hash(rgbStroke) | |
| End If | |
| get_svg_rect_stroke = "stroke:" & hrgbStroke & ";" | |
| End Function | |
| Private Function get_svg_ellipse_points(ByVal s As shape) As String | |
| '' get points | |
| export_scaling_factor = get_export_scaling_factor() | |
| x = s.Left | |
| y = s.Top | |
| w = s.Width | |
| h = s.Height | |
| cx = Int((x + (w / 2)) * export_scaling_factor) | |
| cy = Int((y + (h / 2)) * export_scaling_factor) | |
| rx = Int((w / 2) * export_scaling_factor) | |
| ry = Int((h / 2) * export_scaling_factor) | |
| get_svg_ellipse_points = "cx=" & Chr$(34) & cx & Chr$(34) & " cy=" & Chr$(34) & cy & Chr$(34) & _ | |
| " rx=" & Chr$(34) & rx & Chr$(34) & " ry=" & Chr$(34) & ry & Chr$(34) | |
| End Function | |
| Private Function get_svg_ellipse_fill(ByVal s As shape) As String | |
| '' get colour | |
| If s.Fill.Visible = msoFalse Then | |
| hrgbEllipse = "transparent" | |
| Else | |
| rgbEllipse = s.Fill.ForeColor.RGB | |
| hrgbEllipse = rgb_to_colour_hash(rgbEllipse) | |
| End If | |
| get_svg_ellipse_fill = "fill:" & hrgbEllipse & ";" | |
| End Function | |
| Private Function get_svg_ellipse_stroke_width(ByVal s As shape) As String | |
| '' get stroke-width | |
| swEllipse = s.Line.Weight | |
| get_svg_ellipse_stroke_width = "stroke-width:" & swEllipse & "pt;" | |
| End Function | |
| Private Function get_svg_ellipse_stroke(ByVal s As shape) As String | |
| '' get stroke (border colour) | |
| If s.Line.Visible = msoFalse Then | |
| hrgbStroke = "transparent" | |
| Else | |
| rgbStroke = s.Line.ForeColor.RGB | |
| hrgbStroke = rgb_to_colour_hash(rgbStroke) | |
| End If | |
| get_svg_ellipse_stroke = "stroke:" & hrgbStroke & ";" | |
| End Function | |
| Private Function get_svg_polygon_fill(ByVal s As shape) As String | |
| '' get fill colour | |
| If s.Fill.Visible = msoFalse Then | |
| hrgbPolygon = "transparent" | |
| Else | |
| rgbPolygon = s.Fill.ForeColor.RGB | |
| hrgbPolygon = rgb_to_colour_hash(rgbPolygon) | |
| End If | |
| get_svg_polygon_fill = "fill:" & hrgbPolygon & ";" | |
| End Function | |
| Private Function get_svg_polygon_stroke(ByVal s As shape) As String | |
| '' get stroke (border colour) | |
| If s.Line.Visible = msoFalse Then | |
| hrgbPolygon = "transparent" | |
| Else | |
| rgbPolygon = s.Line.ForeColor.RGB | |
| hrgbPolygon = rgb_to_colour_hash(rgbPolygon) | |
| End If | |
| get_svg_polygon_stroke = "stroke:" & hrgbPolygon & ";" | |
| End Function | |
| Private Function get_svg_polygon_stroke_width(ByVal s As shape) As String | |
| '' get stroke-width | |
| swPolygon = s.Line.Weight | |
| get_svg_polygon_stroke_width = "stroke-width:" & swPolygon & "pt;" | |
| End Function | |
| Private Function get_svg_polygon_points(ByVal s As shape) As String | |
| export_scaling_factor = get_export_scaling_factor() | |
| strPoints = get_points(s, export_scaling_factor) | |
| get_svg_polygon_points = "points=" & Chr$(34) & strPoints & Chr$(34) | |
| End Function | |
| Private Function get_svg_polyline_stroke(ByVal s As shape) As String | |
| If s.Line.Visible = msoFalse Then | |
| hrgbPolyline = "transparent" | |
| Else | |
| rgbPolyline = s.Line.ForeColor.RGB | |
| hrgbPolyline = rgb_to_colour_hash(rgbPolyline) | |
| End If | |
| get_svg_polyline_stroke = "stroke:" & hrgbPolyline & ";" | |
| End Function | |
| Private Function get_svg_polyline_stroke_width(ByVal s As shape) As String | |
| '' get stroke-width | |
| swPolyline = s.Line.Weight | |
| get_svg_polyline_stroke_width = "stroke-width:" & swPolyline & "pt;" | |
| End Function | |
| Private Function get_svg_polyline_points(ByVal s As shape) As String | |
| '' get points | |
| export_scaling_factor = get_export_scaling_factor() | |
| strPoints = get_points(s, export_scaling_factor) | |
| get_svg_polyline_points = "points=" & Chr$(34) & strPoints & Chr$(34) | |
| End Function | |
| Private Function get_asv_svg_polyline_segment_points(ByVal s As shape, ByVal j As Integer) As String | |
| '' get segment points | |
| export_scaling_factor = get_export_scaling_factor() | |
| pairStart = s.Nodes.Item(j - 1).Points | |
| pairEnd = s.Nodes.Item(j).Points | |
| x1 = Int(pairStart(1, 1) * export_scaling_factor) | |
| y1 = Int(pairStart(1, 2) * export_scaling_factor) | |
| x2 = Int(pairEnd(1, 1) * export_scaling_factor) | |
| y2 = Int(pairEnd(1, 2) * export_scaling_factor) | |
| get_asv_svg_polyline_segment_points = "x1=" & Chr$(34) & x1 & Chr$(34) & " y1=" & Chr$(34) & y1 & Chr$(34) & _ | |
| " x2=" & Chr$(34) & x2 & Chr$(34) & " y2=" & Chr$(34) & y2 & Chr$(34) | |
| End Function | |
| Private Function polyline_to_asv_svg(ByVal s As shape) As String | |
| svg_polyline_stroke_width = get_svg_polyline_stroke_width(s) | |
| svg_polyline_stroke = get_svg_polyline_stroke(s) | |
| If s.Line.BeginArrowheadStyle = msoArrowheadOval Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadOval Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| numNodes = s.Nodes.Count | |
| If numNodes = 2 Then | |
| svg_line_points = get_asv_svg_polyline_segment_points(s, 2) | |
| svgPolyline = " <line " & svg_line_points & " style=" & Chr$(34) & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & marker_start & marker_end & "/>" | |
| Else | |
| svgPolyline = "" | |
| For j = 2 To numNodes | |
| svg_line_points = get_asv_svg_polyline_segment_points(s, j) | |
| If j = 2 Then | |
| svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & marker_start & "/>" & vbCrLf | |
| ElseIf j = numNodes Then | |
| svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & marker_end & "/>" | |
| Else | |
| svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & "/>" & vbCrLf | |
| End If | |
| svgPolyline = svgPolyline & svgLine | |
| Next | |
| End If | |
| polyline_to_asv_svg = "<!-- " & s.Name & " (polyline_to_asv_svg) -->" & vbCrLf & svgPolyline | |
| End Function | |
| Private Function get_svg_path_stroke(ByVal s As shape) As String | |
| rgbPath = s.Line.ForeColor.RGB | |
| hrgbPath = rgb_to_colour_hash(rgbPath) | |
| get_svg_path_stroke = "stroke:" & hrgbPath & ";" | |
| End Function | |
| Private Function get_svg_path_stroke_width(ByVal s As shape) As String | |
| swPath = s.Line.Weight | |
| get_svg_path_stroke_width = "stroke-width:" & swPath & "pt;" | |
| End Function | |
| Private Function get_svg_path_points(ByVal s As shape) As String | |
| '' need to document theory behind this function properly | |
| export_scaling_factor = get_export_scaling_factor() | |
| numNodes = s.Nodes.Count | |
| xyCoords = s.Vertices ' try vertices, easier | |
| largest_x = xyCoords(1, 1) | |
| largest_y = xyCoords(1, 2) | |
| For i = 2 To numNodes | |
| If xyCoords(i, 1) > largest_x Then | |
| largest_x = xyCoords(i, 1) | |
| End If | |
| If xyCoords(i, 2) > largest_y Then | |
| largest_y = xyCoords(i, 2) | |
| End If | |
| Next | |
| bb_x = largest_x - s.Left | |
| bb_y = largest_y - s.Top | |
| x_ratio = s.Width / bb_x | |
| y_ratio = s.Height / bb_y | |
| x00Coord = (xyCoords(1, 1) - s.Left) * x_ratio | |
| y00Coord = (xyCoords(1, 2) - s.Top) * y_ratio | |
| If s.HorizontalFlip Then | |
| x = (s.Left + (s.Width - x00Coord)) * export_scaling_factor | |
| Else | |
| x = (s.Left + x00Coord) * export_scaling_factor | |
| End If | |
| If s.VerticalFlip Then | |
| y = (s.Top + (s.Height - y00Coord)) * export_scaling_factor | |
| Else | |
| y = (s.Top + y00Coord) * export_scaling_factor | |
| End If | |
| strPath = " M " & x & "," & y | |
| For i = 2 To numNodes | |
| x00Coord = (xyCoords(i, 1) - s.Left) * x_ratio | |
| y00Coord = (xyCoords(i, 2) - s.Top) * y_ratio | |
| If (i Mod 3) = 2 Then | |
| strPath = strPath & " C " | |
| End If | |
| If s.HorizontalFlip Then | |
| x = (s.Left + (s.Width - x00Coord)) * export_scaling_factor | |
| Else | |
| x = (s.Left + x00Coord) * export_scaling_factor | |
| End If | |
| If s.VerticalFlip Then | |
| y = (s.Top + (s.Height - y00Coord)) * export_scaling_factor | |
| Else | |
| y = (s.Top + y00Coord) * export_scaling_factor | |
| End If | |
| strPath = strPath & " " & x & "," & y | |
| Next | |
| get_svg_path_points = "d=" & Chr$(34) & strPath & Chr$(34) | |
| End Function | |
| Private Function get_asv_svg_path_points(ByVal s As shape) As Variant | |
| numNodes = s.Nodes.Count | |
| ReDim strPath(1 To numNodes, 1 To 2) As Single | |
| export_scaling_factor = get_export_scaling_factor() | |
| xyCoords = s.Vertices | |
| largest_x = xyCoords(1, 1) | |
| largest_y = xyCoords(1, 2) | |
| For i = 2 To numNodes | |
| If xyCoords(i, 1) > largest_x Then | |
| largest_x = xyCoords(i, 1) | |
| End If | |
| If xyCoords(i, 2) > largest_y Then | |
| largest_y = xyCoords(i, 2) | |
| End If | |
| Next | |
| bb_x = largest_x - s.Left | |
| bb_y = largest_y - s.Top | |
| x_ratio = s.Width / bb_x | |
| y_ratio = s.Height / bb_y | |
| x00Coord = (xyCoords(1, 1) - s.Left) * x_ratio | |
| y00Coord = (xyCoords(1, 2) - s.Top) * y_ratio | |
| If s.HorizontalFlip Then | |
| x = (s.Left + (s.Width - x00Coord)) * export_scaling_factor | |
| Else | |
| x = (s.Left + x00Coord) * export_scaling_factor | |
| End If | |
| If s.VerticalFlip Then | |
| y = (s.Top + (s.Height - y00Coord)) * export_scaling_factor | |
| Else | |
| y = (s.Top + y00Coord) * export_scaling_factor | |
| End If | |
| strPath(1, 1) = x | |
| strPath(1, 2) = y | |
| For i = 2 To numNodes | |
| x00Coord = (xyCoords(i, 1) - s.Left) * x_ratio | |
| y00Coord = (xyCoords(i, 2) - s.Top) * y_ratio | |
| If s.HorizontalFlip Then | |
| x = (s.Left + (s.Width - x00Coord)) * export_scaling_factor | |
| Else | |
| x = (s.Left + x00Coord) * export_scaling_factor | |
| End If | |
| If s.VerticalFlip Then | |
| y = (s.Top + (s.Height - y00Coord)) * export_scaling_factor | |
| Else | |
| y = (s.Top + y00Coord) * export_scaling_factor | |
| End If | |
| strPath(i, 1) = x | |
| strPath(i, 2) = y | |
| Next | |
| get_asv_svg_path_points = strPath | |
| End Function | |
| Private Function curve_to_asv_svg(ByVal s As shape) As String | |
| '' this now redundant (?) | |
| svg_path_stroke_width = get_svg_path_stroke_width(s) | |
| svg_path_stroke = get_svg_path_stroke(s) | |
| If s.Line.BeginArrowheadStyle = msoArrowheadOval Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadOval Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| Dim svg_path_points As Variant | |
| svg_path_points = get_asv_svg_path_points(s) | |
| svgCurve = "" | |
| numNodes = s.Nodes.Count | |
| For j = 2 To numNodes | |
| svg_line_points = "x1=" & Chr$(34) & svg_path_points(j - 1, 1) & Chr$(34) & _ | |
| " y1=" & Chr$(34) & svg_path_points(j - 1, 2) & Chr$(34) & _ | |
| " x2=" & Chr$(34) & svg_path_points(j, 1) & Chr$(34) & _ | |
| " y2=" & Chr$(34) & svg_path_points(j, 2) & Chr$(34) | |
| If j = 2 Then | |
| svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_path_stroke & svg_path_stroke_width & Chr$(34) & marker_start & "/>" & vbCrLf | |
| ElseIf j = numNodes Then | |
| svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_path_stroke & svg_path_stroke_width & Chr$(34) & marker_end & "/>" | |
| Else | |
| svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_path_stroke & svg_path_stroke_width & Chr$(34) & "/>" & vbCrLf | |
| End If | |
| svgCurve = svgCurve & svgLine | |
| Next | |
| curve_to_asv_svg = svgCurve | |
| End Function | |
| Private Function decompose_group(ByVal s As shape, ByVal svgSymbol As String, ByVal hier As Integer) As String | |
| '' need to bring up-to-date with main export_to_svg procedure | |
| tfRotation = False | |
| numShapes = s.GroupItems.Count | |
| For i = 1 To numShapes | |
| Set sr = s.GroupItems(i) | |
| If sr.Rotation <> 0 Then | |
| tfRotation = True | |
| End If | |
| If sr.Type = msoGroup Then | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & " <!--g> < hier = " & hier & " -->" | |
| hier = hier + 1 | |
| svgSymbol = decompose_group(sr, svgSymbol, hier) | |
| hier = hier - 1 | |
| svgSymbol = svgSymbol & vbCrLf & indent & " <!--/g-->" | |
| ElseIf sr.Type = msoLine Then | |
| svgLine = line_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgLine | |
| ElseIf sr.Type = msoTextBox Then | |
| svgTextBox = textbox_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgTextBox | |
| ElseIf sr.Type = msoFreeform Then | |
| numNodes = sr.Nodes.Count | |
| srCoords = sr.Vertices | |
| If UBound(srCoords, 1) = (numNodes + 1) Then | |
| '' closed polyline or polygon | |
| svgPolygon = polygon_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon | |
| Else ' not a closed poly-object | |
| If sr.Nodes.Item(1).SegmentType = msoSegmentLine Then | |
| If sr.Fill.Visible Then | |
| '' polyline with fill | |
| svgPolygon = polyline_filled_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon | |
| Else | |
| '' polyline | |
| svgPolyline = polyline_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgPolyline | |
| End If | |
| Else ' msoSegmentCurve | |
| svgPath = curve_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgPath | |
| End If | |
| End If | |
| ElseIf sr.Type = msoAutoShape Then | |
| If sr.AutoShapeType = msoShapeRectangle Then | |
| svgRect = rect_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgRect | |
| ElseIf sr.AutoShapeType = msoShapeOval Then | |
| svgEllipse = ellipse_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgEllipse | |
| Else | |
| End If | |
| Else | |
| End If | |
| Next | |
| If tfRotation = True Then | |
| End If | |
| decompose_group = svgSymbol | |
| End Function | |
| Private Function moz_decompose_group(ByVal s As shape, ByVal svgSymbol As String, ByVal hier As Integer) As String | |
| '' need to bring up-to-date with main export_to_svg procedure | |
| tfRotation = False | |
| numShapes = s.GroupItems.Count | |
| For i = 1 To numShapes | |
| Set sr = s.GroupItems(i) | |
| If sr.Rotation <> 0 Then | |
| tfRotation = True | |
| End If | |
| If sr.Type = msoGroup Then | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & " <!--g> < hier = " & hier & " -->" | |
| hier = hier + 1 | |
| svgSymbol = moz_decompose_group(sr, svgSymbol, hier) | |
| hier = hier - 1 | |
| svgSymbol = svgSymbol & vbCrLf & indent & " <!--/g-->" | |
| ElseIf sr.Type = msoLine Then | |
| msgText = sr.Name & " is line" | |
| svgLine = line_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgLine | |
| ElseIf sr.Type = msoTextBox Then | |
| msgText = sr.Name & " is text" | |
| moz_svgTextBox = textbox_to_moz_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & moz_svgTextBox | |
| ElseIf sr.Type = msoFreeform Then | |
| numNodes = sr.Nodes.Count | |
| srCoords = sr.Vertices | |
| If UBound(srCoords, 1) = (numNodes + 1) Then | |
| '' closed polyline or polygon | |
| svgPolygon = polygon_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon | |
| Else ' not a closed poly-object | |
| If sr.Nodes.Item(1).SegmentType = msoSegmentLine Then | |
| If sr.Fill.Visible Then | |
| '' polyline with fill | |
| svgPolygon = polyline_filled_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon | |
| Else | |
| '' polyline | |
| svgPolyline = polyline_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgPolyline | |
| End If | |
| Else ' msoSegmentCurve | |
| msgText = sr.Name & " is path" | |
| svgPath = curve_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgPath | |
| End If | |
| End If | |
| ElseIf sr.Type = msoAutoShape Then | |
| If sr.AutoShapeType = msoShapeRectangle Then | |
| svgRect = rect_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgRect | |
| ElseIf sr.AutoShapeType = msoShapeOval Then | |
| svgEllipse = ellipse_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgEllipse | |
| Else | |
| End If | |
| Else | |
| End If | |
| Next | |
| If tfRotation = True Then | |
| End If | |
| moz_decompose_group = svgSymbol | |
| End Function | |
| Private Function asv_decompose_group(ByVal s As shape, ByVal svgSymbol As String, ByVal hier As Integer) As String | |
| '' need to bring up-to-date with main export_to_svg procedure | |
| tfRotation = False | |
| numShapes = s.GroupItems.Count | |
| For i = 1 To numShapes | |
| Set sr = s.GroupItems(i) | |
| If sr.Rotation <> 0 Then | |
| tfRotation = True | |
| End If | |
| If sr.Type = msoGroup Then | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & " <!--g> < hier = " & hier & " -->" | |
| hier = hier + 1 | |
| svgSymbol = asv_decompose_group(sr, svgSymbol, hier) | |
| hier = hier - 1 | |
| svgSymbol = svgSymbol & vbCrLf & indent & " <!--/g-->" | |
| ElseIf sr.Type = msoLine Then | |
| svgLine = line_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgLine | |
| ElseIf sr.Type = msoTextBox Then | |
| svgTextBox = textbox_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgTextBox | |
| ElseIf sr.Type = msoFreeform Then | |
| numNodes = sr.Nodes.Count | |
| srCoords = sr.Vertices | |
| If UBound(srCoords, 1) = (numNodes + 1) Then | |
| '' closed polyline or polygon | |
| svgPolygon = polygon_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon | |
| Else ' not a closed poly-object | |
| If sr.Nodes.Item(1).SegmentType = msoSegmentLine Then | |
| If sr.Fill.Visible Then | |
| '' polyline with fill | |
| svgPolygon = polyline_filled_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgPolygon | |
| Else | |
| asv_svgPolyline = polyline_to_asv_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & asv_svgPolyline | |
| End If | |
| Else ' msoSegmentCurve | |
| msgText = sr.Name & " is path" | |
| asv_svgPath = curve_to_asv_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & asv_svgPath | |
| End If | |
| End If | |
| ElseIf sr.Type = msoAutoShape Then | |
| If sr.AutoShapeType = msoShapeRectangle Then | |
| svgRect = rect_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgRect | |
| ElseIf sr.AutoShapeType = msoShapeOval Then | |
| svgEllipse = ellipse_to_svg(sr) | |
| indent = String((hier * 2), " ") | |
| svgSymbol = svgSymbol & vbCrLf & indent & svgEllipse | |
| Else | |
| End If | |
| Else | |
| End If | |
| Next | |
| If tfRotation = True Then | |
| End If | |
| asv_decompose_group = svgSymbol | |
| End Function | |
| Private Function create_defs_text() | |
| '' black markers - this could be made cleverer by dynamically writing the SVG as an arrow'ed object is encountered | |
| txtDefs = " <defs>" & vbCrLf | |
| txtDefs = txtDefs & " <marker id=" & Chr$(34) & "Triangle" & Chr$(34) & vbCrLf | |
| txtDefs = txtDefs & " viewBox=" & Chr$(34) & "-10 0 10 10" & Chr$(34) & " refX=" & Chr$(34) & "0" & Chr$(34) & " refY=" & Chr$(34) & "5" & Chr$(34) & vbCrLf | |
| txtDefs = txtDefs & " markerUnits = " & Chr$(34) & "strokeWidth" & Chr$(34) & vbCrLf | |
| txtDefs = txtDefs & " markerWidth=" & Chr$(34) & "8" & Chr$(34) & " markerHeight=" & Chr$(34) & "6" & Chr$(34) & vbCrLf | |
| txtDefs = txtDefs & " orient=" & Chr$(34) & "auto" & Chr$(34) & " style=" & Chr$(34) & "fill:3F80CD;" & Chr$(34) & ">" & vbCrLf | |
| txtDefs = txtDefs & " <polygon points=" & Chr$(34) & "-15,0 1,5 -15,10" & Chr$(34) & " />" & vbCrLf | |
| txtDefs = txtDefs & " </marker>" & vbCrLf | |
| txtDefs = txtDefs & " <marker id=" & Chr$(34) & "Circle" & Chr$(34) & vbCrLf | |
| txtDefs = txtDefs & " viewBox=" & Chr$(34) & "0 0 10 10" & Chr$(34) & " refX=" & Chr$(34) & "0" & Chr$(34) & " refY=" & Chr$(34) & "5" & Chr$(34) & vbCrLf | |
| txtDefs = txtDefs & " markerUnits = " & Chr$(34) & "strokeWidth" & Chr$(34) & vbCrLf | |
| txtDefs = txtDefs & " markerWidth=" & Chr$(34) & "8" & Chr$(34) & " markerHeight=" & Chr$(34) & "6" & Chr$(34) & vbCrLf | |
| txtDefs = txtDefs & " orient=" & Chr$(34) & "auto" & Chr$(34) & " style=" & Chr$(34) & "fill:black;" & Chr$(34) & ">" & vbCrLf | |
| txtDefs = txtDefs & " <circle cx=" & Chr$(34) & "5" & Chr$(34) & " cy=" & Chr$(34) & "5" & Chr$(34) & " r=" & Chr$(34) & "4" & Chr$(34) & " />" & vbCrLf | |
| txtDefs = txtDefs & " </marker>" & vbCrLf | |
| create_defs_text = txtDefs & " </defs>" | |
| End Function | |
| Private Function line_to_svg(ByVal s As shape) As String | |
| svg_line_points = get_svg_line_points(s) | |
| svg_line_colour = get_svg_line_colour_hash(s) | |
| svg_line_width = get_svg_line_width(s) | |
| If s.Line.BeginArrowheadStyle = msoArrowheadOval Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadOval Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| svgLine = " <line " & svg_line_points & " style=" & Chr$(34) & svg_line_colour & svg_line_width & Chr$(34) & marker_start & marker_end & "/>" | |
| line_to_svg = svgLine | |
| End Function | |
| Private Function shape_text_to_svg(ByVal s As shape) As String | |
| export_scaling_factor = get_export_scaling_factor() | |
| vertical_offset = s.TextFrame.TextRange.Font.Size | |
| x = Int(s.Left * export_scaling_factor) | |
| y = Int(s.Top * export_scaling_factor) + vertical_offset | |
| w = Int(s.Width * export_scaling_factor) + 1 | |
| h = Int(s.Height * export_scaling_factor) + 1 | |
| '' get contents of text box | |
| txtTextBox = s.TextFrame.TextRange.Text | |
| '' get font family | |
| ffText = s.TextFrame.TextRange.Font.Name ' "Arial" | |
| styFamily = "font-family:" & ffText & ";" | |
| '' get font size | |
| fsText = s.TextFrame.TextRange.Font.Size ' 12, 24,... | |
| stySize = "font-size:" & fsText & "pt;" | |
| '' get colour of font | |
| rgbText = s.TextFrame.TextRange.Font.Color.RGB | |
| hrgbText = rgb_to_colour_hash(rgbText) | |
| styFill = "fill:" & hrgbText & ";" | |
| '' get font attributes | |
| fiText = s.TextFrame.TextRange.Font.Italic ' t/f | |
| If fiText Then | |
| styStyle = "font-style:italic;" | |
| Else | |
| styStyle = "" | |
| End If | |
| fbText = s.TextFrame.TextRange.Font.Bold ' t/f | |
| If fbText Then | |
| styWeight = "font-weight:bold;" | |
| Else | |
| styWeight = "" | |
| End If | |
| fuText = s.TextFrame.TextRange.Font.Underline ' t/f | |
| If fuText Then | |
| styDeco = "text-decoration:underline;" | |
| Else | |
| styDeco = "" | |
| End If | |
| '' determine num of lines - this allows the use of tspan in the svg | |
| '' thus it supports multi-line text boxes | |
| numLines = 1 | |
| txtLine = s.TextFrame.TextRange.Lines(1) | |
| While txtLine <> "" | |
| numLines = numLines + 1 | |
| txtLine = s.TextFrame.TextRange.Lines(numLines) | |
| Wend | |
| numLines = numLines - 1 | |
| If numLines > 1 Then | |
| ''txtTextBox = s.TextFrame.TextRange.Lines(1) | |
| txtLine0 = s.TextFrame.TextRange.Lines(1) | |
| txtLine1 = substr(txtLine0, "&", "&") | |
| txtLine2 = substr(txtLine1, "<", "<") | |
| txtTextBox = substr(txtLine2, ">", ">") | |
| dy = Int(fsText * export_scaling_factor) + 1 | |
| For i = 2 To numLines | |
| ''txtLine = s.TextFrame.TextRange.Lines(i) | |
| txtLine0 = s.TextFrame.TextRange.Lines(i) | |
| txtLine1 = substr(txtLine0, "&", "&") | |
| txtLine2 = substr(txtLine1, "<", "<") | |
| txtLine = substr(txtLine2, ">", ">") | |
| txtTextBoxLine = " <tspan x=" & Chr$(34) & x & Chr$(34) & " dy=" & Chr$(34) & dy & Chr$(34) & ">" & txtLine & "</tspan>" | |
| txtTextBox = txtTextBox & vbCrLf & txtTextBoxLine | |
| Next | |
| svgTextBox = " <text xml:space=" & Chr$(34) & "preserve" & Chr$(34) & " x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _ | |
| " width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) & _ | |
| " style=" & Chr$(34) & styFamily & stySize & styFill & styStyle & styWeight & styDeco & Chr$(34) & ">" & txtTextBox & "</text>" | |
| Else '' single-line text box | |
| txtLine0 = s.TextFrame.TextRange.Lines(1) | |
| txtLine1 = substr(txtLine0, "&", "&") | |
| txtLine2 = substr(txtLine1, "<", "<") | |
| txtLine = substr(txtLine2, ">", ">") | |
| svgTextBox = " <text xml:space=" & Chr$(34) & "preserve" & Chr$(34) & " x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _ | |
| " width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) & _ | |
| " style=" & Chr$(34) & styFamily & stySize & styFill & styStyle & styWeight & styDeco & Chr$(34) & ">" & txtLine & "</text>" | |
| End If | |
| textbox_to_svg = svgTextBox | |
| End Function | |
| Private Function textbox_to_svg(ByVal s As shape) As String | |
| export_scaling_factor = get_export_scaling_factor() | |
| vertical_offset = s.TextFrame.TextRange.Font.Size | |
| x = Int(s.Left * export_scaling_factor) | |
| y = Int(s.Top * export_scaling_factor) + vertical_offset | |
| w = Int(s.Width * export_scaling_factor) + 1 | |
| h = Int(s.Height * export_scaling_factor) + 1 | |
| '' get contents of text box | |
| txtTextBox = s.TextFrame.TextRange.Text | |
| '' get font family | |
| ffText = s.TextFrame.TextRange.Font.Name ' "Arial" | |
| styFamily = "font-family:" & ffText & ";" | |
| '' get font size | |
| fsText = s.TextFrame.TextRange.Font.Size ' 12, 24,... | |
| stySize = "font-size:" & fsText & "pt;" | |
| '' get colour of font | |
| rgbText = s.TextFrame.TextRange.Font.Color.RGB | |
| hrgbText = rgb_to_colour_hash(rgbText) | |
| styFill = "fill:" & hrgbText & ";" | |
| '' get font attributes | |
| fiText = s.TextFrame.TextRange.Font.Italic ' t/f | |
| If fiText Then | |
| styStyle = "font-style:italic;" | |
| Else | |
| styStyle = "" | |
| End If | |
| fbText = s.TextFrame.TextRange.Font.Bold ' t/f | |
| If fbText Then | |
| styWeight = "font-weight:bold;" | |
| Else | |
| styWeight = "" | |
| End If | |
| fuText = s.TextFrame.TextRange.Font.Underline ' t/f | |
| If fuText Then | |
| styDeco = "text-decoration:underline;" | |
| Else | |
| styDeco = "" | |
| End If | |
| '' determine num of lines - this allows the use of tspan in the svg | |
| '' thus it supports multi-line text boxes | |
| numLines = 1 | |
| txtLine = s.TextFrame.TextRange.Lines(1) | |
| While txtLine <> "" | |
| numLines = numLines + 1 | |
| txtLine = s.TextFrame.TextRange.Lines(numLines) | |
| Wend | |
| numLines = numLines - 1 | |
| If numLines > 1 Then | |
| ''txtTextBox = s.TextFrame.TextRange.Lines(1) | |
| txtLine0 = s.TextFrame.TextRange.Lines(1) | |
| txtLine1 = substr(txtLine0, "&", "&") | |
| txtLine2 = substr(txtLine1, "<", "<") | |
| txtTextBox = substr(txtLine2, ">", ">") | |
| dy = Int(fsText * export_scaling_factor) + 1 | |
| For i = 2 To numLines | |
| ''txtLine = s.TextFrame.TextRange.Lines(i) | |
| txtLine0 = s.TextFrame.TextRange.Lines(i) | |
| txtLine1 = substr(txtLine0, "&", "&") | |
| txtLine2 = substr(txtLine1, "<", "<") | |
| txtLine = substr(txtLine2, ">", ">") | |
| txtTextBoxLine = " <tspan x=" & Chr$(34) & x & Chr$(34) & " dy=" & Chr$(34) & dy & Chr$(34) & ">" & txtLine & "</tspan>" | |
| txtTextBox = txtTextBox & vbCrLf & txtTextBoxLine | |
| Next | |
| svgTextBox = " <text xml:space=" & Chr$(34) & "preserve" & Chr$(34) & " x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _ | |
| " width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) & _ | |
| " style=" & Chr$(34) & styFamily & stySize & styFill & styStyle & styWeight & styDeco & Chr$(34) & ">" & txtTextBox & "</text>" | |
| Else '' single-line text box | |
| txtLine0 = s.TextFrame.TextRange.Lines(1) | |
| txtLine1 = substr(txtLine0, "&", "&") | |
| txtLine2 = substr(txtLine1, "<", "<") | |
| txtLine = substr(txtLine2, ">", ">") | |
| svgTextBox = " <text xml:space=" & Chr$(34) & "preserve" & Chr$(34) & " x=" & Chr$(34) & x & Chr$(34) & " y=" & Chr$(34) & y & Chr$(34) & _ | |
| " width=" & Chr$(34) & w & Chr$(34) & " height=" & Chr$(34) & h & Chr$(34) & _ | |
| " style=" & Chr$(34) & styFamily & stySize & styFill & styStyle & styWeight & styDeco & Chr$(34) & ">" & txtLine & "</text>" | |
| End If | |
| textbox_to_svg = svgTextBox | |
| End Function | |
| Private Function curve_to_svg(ByVal s As shape) As String | |
| svg_path_points = get_svg_path_points(s) | |
| svg_path_stroke_width = get_svg_path_stroke_width(s) | |
| svg_path_stroke = get_svg_path_stroke(s) | |
| If s.Line.BeginArrowheadStyle = msoArrowheadOval Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadOval Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| curve_to_svg = " <path " & svg_path_points & " style=" & Chr$(34) & "fill:transparent;" & svg_path_stroke & svg_path_stroke_width & Chr$(34) & marker_start & marker_end & "/>" | |
| End Function | |
| Private Function polyline_to_svg(ByVal s As shape) As String | |
| svg_polyline_points = get_svg_polyline_points(s) | |
| svg_polyline_stroke_width = get_svg_polyline_stroke_width(s) | |
| svg_polyline_stroke = get_svg_polyline_stroke(s) | |
| If s.Line.BeginArrowheadStyle = msoArrowheadOval Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadOval Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| polyline_to_svg = " <polyline " & svg_polyline_points & " style=" & Chr$(34) & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & marker_start & marker_end & "/>" | |
| End Function | |
| Private Function polyline_filled_to_svg(ByVal s As shape) As String | |
| svg_polyline_points = get_svg_polyline_points(s) | |
| svg_polygon_fill = get_svg_polygon_fill(s) | |
| svg_polyline_stroke_width = get_svg_polyline_stroke_width(s) | |
| svg_polyline_stroke = get_svg_polyline_stroke(s) | |
| If s.Line.BeginArrowheadStyle = msoArrowheadOval Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.BeginArrowheadStyle = msoArrowheadTriangle Then | |
| marker_start = " marker-start=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadOval Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Circle)" & Chr$(34) | |
| End If | |
| If s.Line.EndArrowheadStyle = msoArrowheadTriangle Then | |
| marker_end = " marker-end=" & Chr$(34) & "url(#Triangle)" & Chr$(34) | |
| End If | |
| polyline_filled_to_svg = " <polyline " & svg_polyline_points & " style=" & Chr$(34) & svg_polygon_fill & svg_polyline_stroke & svg_polyline_stroke_width & Chr$(34) & marker_start & marker_end & "/>" | |
| End Function | |
| Private Function polygon_to_svg(ByVal s As shape) As String | |
| svg_polygon_points = get_svg_polygon_points(s) | |
| svg_polygon_fill = get_svg_polygon_fill(s) | |
| svg_polygon_stroke_width = get_svg_polygon_stroke_width(s) | |
| svg_polygon_stroke = get_svg_polygon_stroke(s) | |
| polygon_to_svg = " <polygon " & svg_polygon_points & " style=" & Chr$(34) & svg_polygon_fill & svg_polygon_stroke & svg_polygon_stroke_width & Chr$(34) & "/>" | |
| End Function | |
| Private Function rect_to_svg(ByVal s As shape) As String | |
| svg_rect_points = get_svg_rect_points(s) | |
| svg_rect_fill = get_svg_rect_fill(s) | |
| svg_rect_stroke_width = get_svg_rect_stroke_width(s) | |
| svg_rect_stroke = get_svg_rect_stroke(s) | |
| rect_to_svg = " <rect " & svg_rect_points & " style=" & Chr$(34) & svg_rect_fill & svg_rect_stroke & svg_rect_stroke_width & Chr$(34) & "/>" | |
| End Function | |
| Private Function ellipse_to_svg(ByVal s As shape) As String | |
| svg_ellipse_points = get_svg_ellipse_points(s) | |
| svg_ellipse_fill = get_svg_ellipse_fill(s) | |
| svg_ellipse_stroke_width = get_svg_ellipse_stroke_width(s) | |
| svg_ellipse_stroke = get_svg_ellipse_stroke(s) | |
| ellipse_to_svg = " <ellipse " & svg_ellipse_points & " style=" & Chr$(34) & svg_ellipse_fill & svg_ellipse_stroke & svg_ellipse_stroke_width & Chr$(34) & "/>" | |
| End Function | |
| Sub export_to_svg() | |
| '' before release find a way to parameterise these variables | |
| fnAsv = "export.asv.svg" | |
| fnSvg = "export.svg" | |
| fnXML = "export.svg.xml" | |
| Set propsDoc = Application.ActivePresentation.BuiltInDocumentProperties | |
| titleDoc = "svg" ''propsDoc.Item("Title") | |
| descDoc = propsDoc.Item("Comments") | |
| Open fnXML For Output As #2 | |
| Print #2, " <svg xmlns=" & Chr$(34) & "http://www.w3.org/2000/svg" & Chr$(34) & _ | |
| " width=" & Chr$(34); "2048" & Chr$(34) & " height=" & Chr$(34) & "1536" & Chr$(34) & ">" | |
| Print #2, " <title>" & titleDoc & "</title>" | |
| Print #2, " <desc>" & descDoc & "</desc>" | |
| txtDefs = create_defs_text() | |
| Print #2, txtDefs | |
| Set myDocument = ActivePresentation.Slides(1) | |
| tfRotation = False | |
| tfSymbol = False | |
| numShapes = myDocument.Shapes.Count | |
| For i = 1 To numShapes | |
| Set s = myDocument.Shapes(i) | |
| If s.Rotation <> 0 Then | |
| tfRotation = True | |
| End If | |
| If s.Type = msoGroup Then | |
| tfSymbol = True | |
| svgGroup = "" '' " <!--g-->" | |
| moz_svgGroup = "" '' " <!--g-->" | |
| asv_svgGroup = "" '' " <!--g-->" | |
| hier = 1 | |
| svgGroup = decompose_group(s, svgGroup, hier) | |
| moz_svgGroup = moz_decompose_group(s, moz_svgGroup, hier) | |
| asv_svgGroup = asv_decompose_group(s, asv_svgGroup, hier) | |
| Print #2, moz_svgGroup & vbCrLf & " <!--/g-->" | |
| ElseIf s.Type = msoLine Then | |
| svgLine = line_to_svg(s) | |
| Print #2, svgLine | |
| ElseIf s.Type = msoTextBox Then | |
| svgTextBox = textbox_to_svg(s) | |
| moz_svgTextBox = textbox_to_moz_svg(s) | |
| Print #2, moz_svgTextBox | |
| ElseIf s.Type = msoFreeform Then | |
| numNodes = s.Nodes.Count | |
| sCoords = s.Vertices | |
| If UBound(sCoords, 1) = (numNodes + 1) Then | |
| '' closed polyline or polygon | |
| svgPolygon = polygon_to_svg(s) | |
| Print #2, svgPolygon | |
| Else ' not a closed poly-object | |
| If s.Nodes.Item(1).SegmentType = msoSegmentLine Then | |
| If s.Fill.Visible Then | |
| '' polyline with fill | |
| svgPolygon = polyline_filled_to_svg(s) | |
| Print #2, svgPolygon | |
| Else | |
| '' polyline | |
| svgPolyline = polyline_to_svg(s) | |
| Print #2, svgPolyline | |
| End If | |
| Else ' msoSegmentCurve | |
| svgPath = curve_to_svg(s) | |
| Print #2, svgPath | |
| End If | |
| End If | |
| ElseIf s.Type = msoAutoShape Then | |
| If s.AutoShapeType = msoShapeRectangle Then | |
| svgRect = rect_to_svg(s) | |
| Print #2, svgRect | |
| ElseIf s.AutoShapeType = msoShapeOval Then | |
| svgEllipse = ellipse_to_svg(s) | |
| Print #2, svgEllipse | |
| Else | |
| msgText = s.Name & " is unknown AutoShape" | |
| End If | |
| Else | |
| msgText = s.Name & " is unknown Shape" | |
| End If | |
| Next | |
| Print #2, " </svg>" | |
| Close #2 | |
| If tfRotation = True Then | |
| End If | |
| If tfSymbol = True Then | |
| End If | |
| End Sub | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
果然是大神。。