ToVBA.sb

' Convert Shapes To PowerPoint VBA 0.42
' Copyright © 2014-2016 Nonki Takahashi.  The MIT License.
' Update 2016-01-08
' Program ID XQD349-3
'
' Remove comment around line 277 for File object.
'
title = "Shapes To VBA 0.42"
CRLF = Text.GetCharacter(13) + Text.GetCharacter(10)
WQ = Text.GetCharacter(34)
UPPER = "ABCDEFGHIJKLMNOPQRSTUVWXYZ"
LOWER = "abcdefghijkomnopqrstuvwxyz"
DIGIT = "0123456789"
LCHAR = UPPER + LOWER + "_"
TCHAR = LCHAR + DIGIT
Not = "False=True;True=False;"
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
GraphicsWindow.Title = title
type = "rect=msoShapeRectangle;ell=msoShapeOVal;tri=msoShapeIsoscelesTriangle;"
SB_Workaround()
angle = 0
While "True"
  ' initialize shapes and add shapes
  Shapes_Read()
  FilenameToTitle()
  Program.Delay(3000)
  Shapes_ToPptVBA()
  Shapes_SaveVBA()
  Shapes_Remove()
EndWhile
Sub FilenameToTitle
  found = 1
  backslash = 0
  While 0 < found
    found = Text.GetIndexOf(Text.GetSubTextToEnd(filename, backslash + 1), "/")
    backslash = backslash + found
  EndWhile
  found = 1
  While 0 < found
    found = Text.GetIndexOf(Text.GetSubTextToEnd(filename, backslash + 1), "\")
    backslash = backslash + found
  EndWhile
  found = Text.GetIndexOf(Text.GetSubTextToEnd(filename, backslash + 1), ".")
  title = Text.GetSubText(filename, backslash + 1, found - 1)
  GraphicsWindow.Title = title
EndSub
Sub Color_ColorToARGB
  ' Color | Convert Color to RGB
  ' param c - color
  ' returns a, r, g, b - alpha, red, green and blue values
  If Text.StartsWith(c, "#") Then
    c = Text.ConvertToUpperCase(c)
  Else
    c = Text.ConvertToLowerCase(c)
    c = colors[c]
  EndIf
  If Text.GetLength(c) = 7 Then
    iR = 2
    a = 255
  ElseIf Text.GetLength(c) = 9 Then
    iR = 4
    hex = Text.GetSubText(c, 2, 2)
    Math_Hex2Dec()
    a = dec
  EndIf
  hex = Text.GetSubText(c, iR, 2)
  Math_Hex2Dec()
  r = dec
  hex = Text.GetSubText(c, iR + 2, 2)
  Math_Hex2Dec()
  g = dec
  hex = Text.GetSubText(c, iR + 4, 2)
  Math_Hex2Dec()
  b = dec
EndSub
Sub Colors_Init
  colors["aliceblue"]="#F0F8FF"
  colors["antiquewhite"]="#FAEBD7"
  colors["aqua"]="#00FFFF"
  colors["aquamarine"]="#7FFFD4"
  colors["azure"]="#F0FFFF"
  colors["beige"]="#F5F5DC"
  colors["bisque"]="#FFE4C4"
  colors["black"]="#000000"
  colors["blanchedalmond"]="#FFEBCD"
  colors["blue"]="#0000FF"
  colors["blueviolet"]="#8A2BE2"
  colors["brown"]="#A52A2A"
  colors["burlywood"]="#DEB887"
  colors["cadetblue"]="#5F9EA0"
  colors["chartreuse"]="#7FFF00"
  colors["chocolate"]="#D2691E"
  colors["coral"]="#FF7F50"
  colors["cornflowerblue"]="#6495ED"
  colors["cornsilk"]="#FFF8DC"
  colors["crimson"]="#DC143C"
  colors["cyan"]="#00FFFF"
  colors["darkblue"]="#00008B"
  colors["darkcyan"]="#008B8B"
  colors["darkgoldenrod"]="#B8860B"
  colors["darkgray"]="#A9A9A9"
  colors["darkgreen"]="#006400"
  colors["darkkhaki"]="#BDB76B"
  colors["darkmagenta"]="#8B008B"
  colors["darkolivegreen"]="#556B2F"
  colors["darkorange"]="#FF8C00"
  colors["darkorchid"]="#9932CC"
  colors["darkred"]="#8B0000"
  colors["darksalmon"]="#E9967A"
  colors["darkseagreen"]="#8FBC8F"
  colors["darkslateblue"]="#483D8B"
  colors["darkslategray"]="#2F4F4F"
  colors["darkturquoise"]="#00CED1"
  colors["darkviolet"]="#9400D3"
  colors["deeppink"]="#FF1493"
  colors["deepskyblue"]="#00BFFF"
  colors["dimgray"]="#696969"
  colors["dodgerblue"]="#1E90FF"
  colors["firebrick"]="#B22222"
  colors["floralwhite"]="#FFFAF0"
  colors["forestgreen"]="#228B22"
  colors["fuchsia"]="#FF00FF"
  colors["gainsboro"]="#DCDCDC"
  colors["ghostwhite"]="#F8F8FF"
  colors["gold"]="#FFD700"
  colors["goldenrod"]="#DAA520"
  colors["gray"]="#808080"
  colors["green"]="#008000"
  colors["greenyellow"]="#ADFF2F"
  colors["honeydew"]="#F0FFF0"
  colors["hotpink"]="#FF69B4"
  colors["indianred"]="#CD5C5C"
  colors["indigo"]="#4B0082"
  colors["ivory"]="#FFFFF0"
  colors["khaki"]="#F0E68C"
  colors["lavender"]="#E6E6FA"
  colors["lavenderblush"]="#FFF0F5"
  colors["lawngreen"]="#7CFC00"
  colors["lemonchiffon"]="#FFFACD"
  colors["lightblue"]="#ADD8E6"
  colors["lightcoral"]="#F08080"
  colors["lightcyan"]="#E0FFFF"
  colors["lightgoldenrodyellow"]="#FAFAD2"
  colors["lightgray"]="#D3D3D3"
  colors["lightgreen"]="#90EE90"
  colors["lightpink"]="#FFB6C1"
  colors["lightsalmon"]="#FFA07A"
  colors["lightseagreen"]="#20B2AA"
  colors["lightskyblue"]="#87CEFA"
  colors["lightslategray"]="#778899"
  colors["lightsteelblue"]="#B0C4DE"
  colors["lightyellow"]="#FFFFE0"
  colors["lime"]="#00FF00"
  colors["limegreen"]="#32CD32"
  colors["linen"]="#FAF0E6"
  colors["magenta"]="#FF00FF"
  colors["maroon"]="#800000"
  colors["mediumaquamarine"]="#66CDAA"
  colors["mediumblue"]="#0000CD"
  colors["mediumorchid"]="#BA55D3"
  colors["mediumpurple"]="#9370DB"
  colors["mediumseagreen"]="#3CB371"
  colors["mediumslateblue"]="#7B68EE"
  colors["mediumspringgreen"]="#00FA9A"
  colors["mediumturquoise"]="#48D1CC"
  colors["mediumvioletred"]="#C71585"
  colors["midnightblue"]="#191970"
  colors["mintcream"]="#F5FFFA"
  colors["mistyrose"]="#FFE4E1"
  colors["moccasin"]="#FFE4B5"
  colors["navajowhite"]="#FFDEAD"
  colors["navy"]="#000080"
  colors["oldlace"]="#FDF5E6"
  colors["olive"]="#808000"
  colors["olivedrab"]="#6B8E23"
  colors["orange"]="#FFA500"
  colors["orangered"]="#FF4500"
  colors["orchid"]="#DA70D6"
  colors["palegoldenrod"]="#EEE8AA"
  colors["palegreen"]="#98FB98"
  colors["paleturquoise"]="#AFEEEE"
  colors["palevioletred"]="#DB7093"
  colors["papayawhip"]="#FFEFD5"
  colors["peachpuff"]="#FFDAB9"
  colors["peru"]="#CD853F"
  colors["pink"]="#FFC0CB"
  colors["plum"]="#DDA0DD"
  colors["powderblue"]="#B0E0E6"
  colors["purple"]="#800080"
  colors["red"]="#FF0000"
  colors["rosybrown"]="#BC8F8F"
  colors["royalblue"]="#4169E1"
  colors["saddlebrown"]="#8B4513"
  colors["salmon"]="#FA8072"
  colors["sandybrown"]="#F4A460"
  colors["seagreen"]="#2E8B57"
  colors["seashell"]="#FFF5EE"
  colors["sienna"]="#A0522D"
  colors["silver"]="#C0C0C0"
  colors["skyblue"]="#87CEEB"
  colors["slateblue"]="#6A5ACD"
  colors["slategray"]="#708090"
  colors["snow"]="#FFFAFA"
  colors["springgreen"]="#00FF7F"
  colors["steelblue"]="#4682B4"
  colors["tan"]="#D2B48C"
  colors["teal"]="#008080"
  colors["thistle"]="#D8BFD8"
  colors["tomato"]="#FF6347"
  colors["turquoise"]="#40E0D0"
  colors["violet"]="#EE82EE"
  colors["wheat"]="#F5DEB3"
  colors["white"]="#FFFFFF"
  colors["whitesmoke"]="#F5F5F5"
  colors["yellow"]="#FFFF00"
  colors["yellowgreen"]="#9ACD32"
EndSub
Sub CS_AddColorToPalette
  ' Color Selector | Add color to palette
  ' dummy for this program
EndSub
Sub Math_CartesianToPolar
  ' Math | convert cartesian coodinate to polar coordinate
  ' param x, y - cartesian coordinate
  ' return r, a - polar coordinate
  r = Math.SquareRoot(x * x + y * y)
  If x = 0 And y > 0 Then
    a = 90 ' [degree]
  ElseIf x = 0 And y < 0 Then
    a = -90
  Else
    a = Math.ArcTan(y / x) * 180 / Math.Pi
  EndIf
  If x < 0 Then
    a = a + 180
  ElseIf x > 0 And y < 0 Then
    a = a + 360
  EndIf
EndSub
Sub Math_Hex2Dec
  ' Math | Convert hexadecimal to decimal
  ' param hex
  ' returns dec
  dec = 0
  iLen = Text.GetLength(hex)
  For iPtr = 1 To iLen
    dec = dec * 16 + Text.GetIndexOf("0123456789ABCDEF", Text.GetSubText(hex, iPtr, 1)) - 1
  EndFor
EndSub
Sub SB_RotateWorkaround
  ' Small Basic | Rotate workaround for Silverlight
  ' param x, y - original coordinate
  ' param alpha - angle [radian]
  ' returns x, y - workaround coordinate
  If shape[i]["func"] = "tri" Then
    x1 = -Math.Floor(shape[i]["x3"] / 2)
    y1 = -Math.Floor(shape[i]["y3"] / 2)
  ElseIf shape[i]["func"] = "line" Then
    x1 = -Math.Floor(Math.Abs(shape[i]["x1"] - shape[i]["x2"]) / 2)
    y1 = -Math.Floor(Math.Abs(shape[i]["y1"] - shape[i]["y2"]) / 2)
  EndIf
  ox = x - x1
  oy = y - y1
  x = x1 * Math.Cos(alpha) - y1 * Math.Sin(alpha) + ox
  y = x1 * Math.Sin(alpha) + y1 * Math.Cos(alpha) + oy
EndSub
Sub SB_AppendSub
  ' Small Basic | Append subroutine from Small Basic source file
  ' param filename - file name
  ' param subname - subroutine name
  ' return buf - subroutine buffer
  len = Text.GetLength(subname)
  _buf = "" ' for Slilverlight
  _buf = File.ReadContents(filename)
  ptr = 1
  notFound = "True"
  While notFound
    _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(_buf, ptr), "Sub")
    If _ptr = 0 Then
      _buf = ""
      Goto sbas_exit
    EndIf
    ptrSub = ptr + _ptr - 1
    ptr = ptrSub + 3
    While Text.GetSubText(_buf, ptr, 1) = " "
      ptr = ptr + 1
    EndWhile
    If Text.GetSubText(_buf, ptr, len) = subname And Text.IsSubText(TCHAR, Text.GetSubText(_buf, ptr + len, 1)) = "False" Then
      notFound = "False"
    EndIf
  EndWhile
  _ptre = _ptr - 1
  _ptrq = _ptr
  While (0 < _ptrq) And (_ptre < _ptrq) ' EOL exists before single quote (comment)
    _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(_buf, ptr), "EndSub")
    If _ptr = 0 Then
      buf = ""
      Goto sbas_exit
    EndIf
    _ptre = ptr + _ptr - 3
    While (1 <= _ptre) And (Text.GetSubText(_buf, _ptre, 2) <> CRLF)
      _ptre = _ptre - 1
    EndWhile
    _ptrq = ptr + _ptr - 2
    While (1 <= _ptrq) And (Text.GetSubText(_buf, _ptrq, 1) <> "'")
      _ptrq = _ptrq - 1
    EndWhile
    If (0 < _ptrq) And (_ptre < _ptrq) Then
      ptr = ptr + _ptr + 5
    EndIf
  EndWhile
  ptrEndSub = ptr + _ptr - 1
  ptr = ptrEndSub + 6
  len = ptr - ptrSub
  buf = buf + Text.GetSubText(_buf, ptrSub, len)
  sbas_exit:
EndSub
Sub SB_Workaround
  ' Small Basic | Workaround for Silverlight
  ' returns silverlight - "True" if in remote
  color = GraphicsWindow.GetPixel(0, 0)
  If Text.GetLength(color) > 7 Then
    silverlight = "True"
    msWait = 300
  Else
    silverlight = "False"
  EndIf
EndSub
Sub Shapes_Add
  ' Shapes | add shapes as shapes data
  ' param iMin, iMax - shape indices to add
  ' param shape - array of shapes
  ' param scale - 1 if same scale
  ' return shWidth, shHeight - total size of shapes
  ' return shAngle - current angle of shapes
  Stack.PushValue("local", i)
  Stack.PushValue("local", x)
  Stack.PushValue("local", y)
  Shapes_CalcWidthAndHeight()
  s = scale
  For i = iMin To iMax
    GraphicsWindow.PenWidth = shape[i]["pw"] * s
    If shape[i]["pw"] > 0 Then
      GraphicsWindow.PenColor = shape[i]["pc"]
    EndIf
    If Text.IsSubText("rect|ell|tri|text", shape[i]["func"]) Then
      GraphicsWindow.BrushColor = shape[i]["bc"]
    EndIf
    If shape[i]["func"] = "rect" Then
      shape[i]["obj"] = Shapes.AddRectangle(shape[i]["width"] * s, shape[i]["height"] * s)
    ElseIf shape[i]["func"] = "ell" Then
      shape[i]["obj"] = Shapes.AddEllipse(shape[i]["width"] * s, shape[i]["height"] * s)
    ElseIf shape[i]["func"] = "tri" Then
      shape[i]["obj"] = Shapes.AddTriangle(shape[i]["x1"] * s, shape[i]["y1"] * s, shape[i]["x2"] * s, shape[i]["y2"] * s, shape[i]["x3"] * s, shape[i]["y3"] * s)
    ElseIf shape[i]["func"] = "line" Then
      shape[i]["obj"] = Shapes.AddLine(shape[i]["x1"] * s, shape[i]["y1"] * s, shape[i]["x2"] * s, shape[i]["y2"] * s)
    ElseIf shape[i]["func"] = "text" Then
      If silverlight Then
        fs = Math.Floor(shape[i]["fs"] * 0.9)
      Else
        fs = shape[i]["fs"]
      EndIf
      GraphicsWindow.FontSize = fs * s
      GraphicsWindow.FontName = shape[i]["fn"]
      shape[i]["obj"] = Shapes.AddText(shape[i]["text"])
    EndIf
    x = shape[i]["x"]
    y = shape[i]["y"]
    shape[i]["rx"] = x
    shape[i]["ry"] = y
    If silverlight And Text.IsSubText("tri|line", shape[i]["func"]) Then
      alpha = Math.GetRadians(shape[i]["angle"])
      SB_RotateWorkaround()
      shape[i]["wx"] = x
      shape[i]["wy"] = y
    EndIf
    Shapes.Move(shape[i]["obj"], shX + x * s, shY + y * s)
    If Text.IsSubText("rect|ell|tri|text", shape[i]["func"]) And shape[i]["angle"] <> 0 Then
      Shapes.Rotate(shape[i]["obj"], shape[i]["angle"])
    EndIf
  EndFor
  shAngle = 0
  y = Stack.PopValue("local")
  x = Stack.PopValue("local")
  i = Stack.PopValue("local")
EndSub
Sub Shapes_CalcDetectBorder
  ' Shapes | Calculate detect border
  ' param i - index of shapes
  If shape[i]["func"] = "line" Then           ' line
    x = shape[i]["x2"] - shape[i]["x1"]
    y = shape[i]["y2"] - shape[i]["y1"]
    Math_CartesianToPolar()
    If a >= 180 Then
      a = a - 180
    EndIf
    shape[i]["angle"] = a
    cx = shape[i]["x"] + Math.Abs(x) / 2
    cy = shape[i]["y"] + Math.Abs(y) / 2
    len = Math.SquareRoot(x * x + y * y)
    shape[i]["_x0"] = Math.Floor(cx - len / 2)
    shape[i]["_x1"] = Math.Floor(cx + len / 2)
    shape[i]["_y0"] = cy - 4
    shape[i]["_y1"] = cy + 4
  Else                                        ' rectangle, ellipse or triangle
    If shape[i]["func"] = "tri" Then          ' triangle
      shape[i]["width"] = shape[i]["x3"]
      shape[i]["height"] = shape[i]["y2"]
    EndIf
    shape[i]["_x0"] = shape[i]["x"]
    shape[i]["_y0"] = shape[i]["y"]
    shape[i]["_x1"] = shape[i]["x"] + shape[i]["width"]
    shape[i]["_y1"] = shape[i]["y"] + shape[i]["height"]
  EndIf
EndSub
Sub Shapes_CalcRotatePos
  ' Shapes | Calculate position for rotated shape
  ' param["x"], param["y"] - position of a shape
  ' param["width"], param["height"] - size of a shape
  ' param ["cx"], param["cy"] - center of rotation
  ' param ["angle"] - rotate angle
  ' return x, y - rotated position of a shape
  _cx = param["x"] + param["width"] / 2
  _cy = param["y"] + param["height"] / 2
  x = _cx - param["cx"]
  y = _cy - param["cy"]
  Math_CartesianToPolar()
  a = a + param["angle"]
  x = r * Math.Cos(a * Math.Pi / 180)
  y = r * Math.Sin(a * Math.Pi / 180)
  _cx = x + param["cx"]
  _cy = y + param["cy"]
  x = _cx - param["width"] / 2
  y = _cy - param["height"] / 2
EndSub
Sub Shapes_CalcWidthAndHeight
  ' Shapes | Calculate total width and height of shapes
  ' param iMin, iMax - shape indices to add
  ' return shWidth, shHeight - total size of shapes
  For i = iMin To iMax
    If shape[i]["func"] = "tri" Or shape[i]["func"] = "line" Then
      xmin = shape[i]["x1"]
      xmax = shape[i]["x1"]
      ymin = shape[i]["y1"]
      ymax = shape[i]["y1"]
      If shape[i]["x2"] < xmin Then
        xmin = shape[i]["x2"]
      EndIf
      If xmax < shape[i]["x2"] Then
        xmax = shape[i]["x2"]
      EndIf
      If shape[i]["y2"] < ymin Then
        ymin = shape[i]["y2"]
      EndIf
      If ymax < shape[i]["y2"] Then
        ymax = shape[i]["y2"]
      EndIf
      If shape[i]["func"] = "tri" Then
        If shape[i]["x3"] < xmin Then
          xmin = shape[i]["x3"]
        EndIf
        If xmax < shape[i]["x3"] Then
          xmax = shape[i]["x3"]
        EndIf
        If shape[i]["y3"] < ymin Then
          ymin = shape[i]["y3"]
        EndIf
        If ymax < shape[i]["y3"] Then
          ymax = shape[i]["y3"]
        EndIf
      EndIf
      shape[i]["width"] = xmax - xmin
      shape[i]["height"] = ymax - ymin
    EndIf
    If i = 1 Then
      shWidth = shape[i]["x"] + shape[i]["width"]
      shHeight = shape[i]["y"] + shape[i]["height"]
    Else
      If shWidth < shape[i]["x"] + shape[i]["width"] Then
        shWidth = shape[i]["x"] + shape[i]["width"]
      EndIf
      If shHeight < shape[i]["y"] + shape[i]["height"] Then
        shHeight = shape[i]["y"] + shape[i]["height"]
      EndIf
    EndIf
  EndFor
EndSub
Sub Shapes_Move
  ' Shapes | Move shapes
  ' param iMin, iMax - shape indices to add
  ' param shape - array of shapes
  ' param scale - to zoom
  ' param x, y - position to move
  ' return shX, shY - new position of shapes
  Stack.PushValue("local", i)
  s = scale
  shX = x
  shY = y
  For i = iMin To iMax
    If silverlight And Text.IsSubText("tri|line", shape[i]["func"]) Then
      _x = shape[i]["wx"]
      _y = shape[i]["wy"]
    Else
      _x = shape[i]["rx"]
      _y = shape[i]["ry"]
    EndIf
    Shapes.Move(shape[i]["obj"], shX + _x * s, shY + _y * s)
  EndFor
  i = Stack.PopValue("local")
EndSub
Sub Shapes_Open
  ' Shapes | Show input program to open
  TOPY = 10   ' top y
  LEFTX = 10  ' left x
  CAPTIONCOLOR = "White"
  POPUPCOLOR = "Black"
  TEXTCOLOR = "Black"
  GraphicsWindow.PenWidth = 0
  GraphicsWindow.BrushColor = POPUPCOLOR
  oPopup = Shapes.AddRectangle(gw, gh)
  Shapes.SetOpacity(oPopup, 64)
  Shapes.Move(oPopup, LEFTX - 10, TOPY - 10)
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  oCaption = Shapes.AddText("Filename")
  Shapes.Move(oCaption, LEFTX, TOPY + 3)
  GraphicsWindow.BrushColor = TEXTCOLOR
  oFilename = Controls.AddTextBox(LEFTX + 80, TOPY)
  Controls.SetSize(oFilename, 300, 24)
  Controls.SetTextBoxText(oFilename, Program.Directory + "\")
  oText = Controls.AddTextBox(LEFTX, TOPY + 30)
  Controls.SetSize(oText, gw - 20, gh - 80)
  oOK = Controls.AddButton("OK", gw - 40, gh - 32)
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  oMsg = Shapes.AddText("Enter shapes filename or paste Shapes_Init to text box")
  Shapes.Move(oMsg, LEFTX, gh - 26)
  typed = "False"
  clicked = "False"
  Controls.ButtonClicked = Shapes_OnButtonClicked
  Controls.TextTyped = Shapes_OnTextTyped
  subname = "Shapes_Init"
  While Not[clicked]
    If typed Then
      filename = Controls.GetTextBoxText(oFilename)
      buf = ""
      SB_AppendSub()
      Controls.SetTextBoxText(oText, buf)
      typed = "False"
    Else
      Program.Delay(200)
    EndIf
  EndWhile
  buf = Controls.GetTextBoxText(oText)
  Controls.Remove(oCaption)
  Controls.Remove(oFilename)
  Controls.Remove(oText)
  Controls.Remove(oOK)
  Controls.Remove(oPopup)
EndSub
Sub Shapes_OnTextTyped
  typed = "True"
EndSub
Sub Shapes_Read
  ' Shapes | Read shapes from a file or a text box
  Shapes_Open()
  ' Parse "shX = ..."
  ptr = Text.GetIndexOf(buf, "shX = ")
  If ptr = 0 Then
    Goto rs_exit
  EndIf
  shX = ""
  ptr = ptr + 6
  c = Text.GetSubText(buf, ptr, 1)
  While Text.GetIndexOf("0123456789", c) > 0
    shX = Text.Append(shX, c)
    ptr = ptr + 1
    c = Text.GetSubText(buf, ptr, 1)
  EndWhile
  ' Parse "shY = ..."
  _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "shY = ")
  If _ptr = 0 Then
    Goto rs_exit
  EndIf
  shY = ""
  ptr = ptr + _ptr + 5
  c = Text.GetSubText(buf, ptr, 1)
  While Text.GetIndexOf("0123456789", c) > 0
    shY = Text.Append(shY, c)
    ptr = ptr + 1
    c = Text.GetSubText(buf, ptr, 1)
  EndWhile
  ' Parse "shape[i] = ..."
  While "True"
    _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "shape[")
    If _ptr = 0 Then
      Goto rs_exit
    EndIf
    ptr = ptr + _ptr + 5
    _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), "] = " + WQ)
    If _ptr = 0 Then
      Goto rs_exit
    EndIf
    i = Text.GetSubText(buf, ptr, _ptr - 1)
    ptr = ptr + _ptr + 4
    _ptr = Text.GetIndexOf(Text.GetSubTextToEnd(buf, ptr), WQ)
    If _ptr = 0 Then
      Goto rs_exit
    EndIf
    shape[nShapes + i] = Text.GetSubText(buf, ptr, _ptr - 1)
    ptr = ptr + _ptr
  EndWhile
  rs_exit:
  iMin = nShapes + 1
  nShapes = Array.GetItemCount(shape)
  iMax = nShapes
  For i = iMin To iMax
    shape[i]["x"] = shape[i]["x"] + shX
    shape[i]["y"] = shape[i]["y"] + shY
    If shape[i]["func"] = "tri" And (shape[i]["y2"] < shape[i]["y1"]) Then
      shape[i]["y2"] = shape[i]["y1"]
      shape[i]["y1"] = shape[i]["y3"]
      shape[i]["y3"] = shape[i]["y2"]
      shape[i]["angle"] = shape[i]["angle"] + 180
      If shape[i]["angle"] >= 360 Then
        shape[i]["angle"] = shape[i]["angle"] - 360
      EndIf
    EndIf
    Shapes_CalcDetectBorder()
    If shape[i]["pc"] <> "" Then
      color = shape[i]["pc"]
      CS_AddColorToPalette()
    EndIf
    If shape[i]["bc"] <> "" Then
      color = shape[i]["bc"]
      CS_AddColorToPalette()
    EndIf
  EndFor
  shX = 0
  shY = 0
  scale = 1
  Shapes_Add()
EndSub
Sub Shapes_Remove
  ' Shapes | Remove shapes
  ' param iMin, iMax - shapes indices to remove
  ' param shape - array of shapes
  Stack.PushValue("local", i)
  For i = iMin To iMax
    Shapes.Remove(shape[i]["obj"])
  EndFor
  i = Stack.PopValue("local")
EndSub
Sub Shapes_Rotate
  ' Shapes | Rotate shapes
  ' param iMin, iMax - shapes indices to rotate
  ' param shape - array of shapes
  ' param scale - to zoom
  ' param angle - to rotate
  Stack.PushValue("local", i)
  Stack.PushValue("local", x)
  Stack.PushValue("local", y)
  s = scale
  param["angle"] = angle
  param["cx"] = shWidth / 2
  param["cy"] = shHeight / 2
  For i = iMin To iMax
    param["x"] = shape[i]["x"]
    param["y"] = shape[i]["y"]
    param["width"] = shape[i]["width"]
    param["height"] = shape[i]["height"]
    Shapes_CalcRotatePos()
    shape[i]["rx"] = x
    shape[i]["ry"] = y
    If silverlight And Text.IsSubText("tri|line", shape[i]["func"]) Then
      alpha = Math.GetRadians(angle + shape[i]["angle"])
      SB_RotateWorkAround()
      shape[i]["wx"] = x
      shape[i]["wy"] = y
    EndIf
    Shapes.Move(shape[i]["obj"], shX + x * s, shY + y * s)
    Shapes.Rotate(shape[i]["obj"], angle + shape[i]["angle"])
  EndFor
  y = Stack.PopValue("local")
  x = Stack.PopValue("local")
  i = Stack.PopValue("local")
EndSub
Sub Shapes_SaveVBA
  ' Shapes | Show output program to save
  ' param vba - program buffer
  ' define constant
  TOPY = 10   ' top y
  LEFTX = 10  ' left x
  POPUPCOLOR = "Black"
  TEXTCOLOR = "Black"
  CAPTIONCOLOR = "White"
  GraphicsWindow.PenWidth = 0
  GraphicsWindow.BrushColor = POPUPCOLOR
  oPopup = Shapes.AddRectangle(gw, gh)
  Shapes.SetOpacity(oPopup, 64)
  Shapes.Move(oPopup, LEFTX - 10, TOPY - 10)
  GraphicsWindow.BrushColor = TEXTCOLOR
  oText = Controls.AddTextBox(LEFTX, TOPY)
  Controls.SetSize(oText, gw - 20, gh - 50)
  Controls.SetTextBoxText(oText, vba)
  Shapes.SetOpacity(oText, 32)
  oOK = Controls.AddButton("OK", gw - 40, gh - 32)
  GraphicsWindow.BrushColor = CAPTIONCOLOR
  oMsg = Shapes.AddText("Click textbox above, push Ctrl+A, Ctrl+C to copy and save to your editor")
  Shapes.Move(oMsg, LEFTX, gh - 26)
  clicked = "False"
  Controls.ButtonClicked = Shapes_OnButtonClicked
  While Not[clicked]
    Program.Delay(500)
  EndWhile
  Controls.Remove(oText)
  Controls.Remove(oMsg)
  Controls.Remove(oOK)
  Controls.Remove(oPopup)
EndSub
Sub Shapes_OnButtonClicked
  clicked = "True"
EndSub
Sub Shapes_ToPptVBA
  ' Shapes | Convert shapes to PowerPoint VBA
  ' param shape - shapes array
  ' param iMin, iMax - index for shapes array
  ' param title - for subroutine name
  ' return vba
  If title = "" Then
    title = "Shapes"
  EndIf
  vba = "Sub Draw" + title + "()" + CRLF
  vba = vba + "'" + CRLF
  vba = vba + "' Draw" + title + CRLF
  vba = vba + "'" + CRLF
  vba = vba + " Dim index As Long" + CRLF
  vba = vba + " Dim myDocument As Slide" + CRLF
  vba = vba + " s = 100 / 211 ' to create image file" + CRLF
  vba = vba + " s = 1 ' to create clip art" + CRLF
  vba = vba + " index = ActiveWindow.View.Slide.SlideIndex" + CRLF
  vba = vba + " Set myDocument = ActivePresentation.Slides(index)" + CRLF
  For i = iMin To iMax
    shi = shape[i]
    vba = vba + "' shape[" + i + "]=" + WQ + shi + WQ + CRLF
    If shi["func"] = "line" Then
      vba = vba + " With myDocument.Shapes.AddConnector("
      vba = vba + "msoConnectorStraight, _" + CRLF
      vba = vba + " "
      vba = vba + (shi["x"] + shi["x1"]) + " * s, "
      vba = vba + (shi["y"] + shi["y1"]) + " * s, "
      vba = vba + (shi["x"] + shi["x2"]) + " * s, "
      vba = vba + (shi["y"] + shi["y2"]) + " * s)" + CRLF
    ElseIf Text.IsSubText("rect|ell|tri", shi["func"]) Then
      vba = vba + " With myDocument.Shapes.AddShape("
      vba = vba + type[shi["func"]] + ", _" + CRLF
      vba = vba + " "
      vba = vba + shi["x"] + " * s, "
      vba = vba + shi["y"] + " * s, "
      If shi["func"] = "tri" Then
        vba = vba + shi["x3"] + " * s, "
        vba = vba + shi["y3"] + " * s)" + CRLF
      Else
        vba = vba + shi["width"] + " * s, "
        vba = vba + shi["height"] + " * s)" + CRLF
      EndIf
    EndIf
    If shi["pc"] <> "" Then
      vba = vba + " "
      vba = vba + ".Line.ForeColor.RGB = RGB("
      c = shi["pc"]
      Color_ColorToARGB()
      vba = vba + r + ", "
      vba = vba + g + ", "
      vba = vba + b + ")" + CRLF
      If a <> 255 Then
        t = Math.Round((255 - a) / 255 * 100) / 100
        vba = vba + " "
        vba = vba + ".Line.Transparency = " + t + CRLF
      EndIf
    EndIF
    If shi["pw"] = "0" Then
      vba = vba + " "
      vba = vba + ".Line.Visible = msoFalse" + CRLF
    Else
      vba = vba + " "
      vba = vba + ".Line.Visible = msoTrue" + CRLF
      pt = shi["pw"] * 1.2
      vba = vba + " "
      vba = vba + ".Line.Weight = " + pt + " * s" + CRLF
    EndIF
    If shi["bc"] <> "" Then
      vba = vba + " "
      vba = vba + ".Fill.ForeColor.RGB = RGB("
      c = shi["bc"]
      Color_ColorToARGB()
      vba = vba + r + ", "
      vba = vba + g + ", "
      vba = vba + b + ")" + CRLF
      If a <> 255 Then
        t = Math.Round((255 - a) / 255 * 100) / 100
        vba = vba + " "
        vba = vba + ".Fill.Transparency = " + t + CRLF
      EndIf
    EndIF
    If shi["angle"] <> ""  And shi["func"] <> "line" Then
      vba = vba + " "
      vba = vba + ".IncrementRotation " + shi["angle"] + CRLF
    EndIf
    vba = vba + " End With" + CRLF
  EndFor
  vba = vba + "End Sub" + CRLF
EndSub