Microsoft Small Basic

Program Listing: DNP396

List Program

' Caption Maker - Shapes Generator
' Version 0.2
' Copyright © 2017-2018 Nonki Takahashi. The MIT License.
' Last update 2018-07-15

GraphicsWindow.Title = "Caption Maker 0.2"
Init()
buttonClicked = "False"
Controls.ButtonClicked = OnButtonClicked
While "True"
' wait OK button
While Not[buttonClicked] Or (lastButton <> btnOK)
If buttonClicked And (lastButton = btnSave) Then
SaveCaptionProgram()
Else
Program.Delay(100)
EndIf
EndWhile
buttonClicked = "False"

' delete shapes if needed
If shape <> "" Then
Shapes_Remove()
shape = ""
iMin = 1
iMax = 0
EndIf

' caption
angle = 0
bc = "Black"
fn = "Trebuchet MS"
fb = "True"
fs = 50
txt = Controls.GetTextBoxText(tbox)
caption = txt
Font_GetTextWidth()
x = gw - 20 - width
y = gh - 20 - 50
Shapes_AddText()
Shapes_Normalize()

Shapes_DumpProgram()
EndWhile

Sub Init
WQ = Text.GetCharacter(34)
LF = Text.GetCharacter(10)
Not = "False=True;True=False;"
order = "1=func;2=x;3=y;4=width;5=height;6=x1;7=y1;8=x2;9=y2;"
order = order + "10=x3;11=y3;12=text;13=fn;14=fs;15=fb;16=fi;"
order = order + "17=pw;18=pc;19=bc;"
nOrder = Array.GetItemCount(order)
gw = 598
gh = 428
GraphicsWindow.Width = gw
GraphicsWindow.Height = gh
iMin = 1
iMax = 0
pc = ""
pw = 0
x = 0
y = 0
width = 0
height = 0
x1 = 0
y1 = 0
x2 = 0
y2 = 0
x3 = 0
y3 = 0
angle = 0
fb = ""
fi = ""
GraphicsWindow.BrushColor = "LightGray"
GraphicsWindow.FillRectangle(0, 0, gw, gh / 2)
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.DrawText(10, 13, "Caption")
tbox = Controls.AddTextBox(62, 10)
btnOK = Controls.AddButton("OK", 230, 8)
btnSave = Controls.AddButton("Save", 268, 8)
GraphicsWindow.FontName = "Consolas"
GraphicsWindow.FontSize = 14
mbox = Controls.AddMultiLineTextBox(10, 40)
Controls.SetSize(mbox, gw - 20, gh / 2 - 50)
EndSub

Sub OnButtonClicked
buttonClicked = "True"
lastButton = Controls.LastClickedButton
EndSub

Sub SaveCaptionProgram
path = Program.Directory + "\" + caption + ".sb"
' The following line could be harmful and has been automatically commented.
' File.WriteContents(path, buf)
EndSub

Sub Font_GetTextWidth
' param fs - font size
' param fn - font name
' param fb - font bold
' param fi - font italic
' param txt - text to get width in px
' return width - text width
yc = 300
GraphicsWindow.BrushColor = "#FFFFFF"
GraphicsWindow.FillRectangle(0, yc, gw, gh - yc)
GraphicsWindow.FontSize = fs
GraphicsWindow.FontName = fn
GraphicsWindow.FontBold = fb
GraphicsWindow.FontItalic = fi
GraphicsWindow.BrushColor = "#FEFEFE"
GraphicsWindow.DrawText(0, yc, "||")
y0 = yc
y1 = yc + fs
x0 = 0
x1 = fs * 2
If gw < x1 Then
x1 = gw - 1
EndIf
Font_Measure()
px0 = px
GraphicsWindow.BrushColor = "#FFFFFF"
GraphicsWindow.FillRectangle(0, yc, gw, gh - yc)
str = "|" + txt + "|"
GraphicsWindow.BrushColor = "#FEFEFE"
GraphicsWindow.DrawText(0, yc, str)
x1 = fs * Text.GetLength(str)
If gw < x1 Then
x1 = gw - 1
EndIf
Font_Measure()
width = px - px0
EndSub

Sub Font_Measure
' return px - width in pixel (px)
_y = Math.Floor((y0 + y1) / 2)
For _x = x0 To x1
color = GraphicsWindow.GetPixel(_x, _y)
If Not[Text.EndsWith(color, "FFFFFF")] Then
left = _x
_x = x1 ' exit For
EndIf
EndFor
For _x = x1 To x0 Step -1
color = GraphicsWindow.GetPixel(_x, _y)
If Not[Text.EndsWith(color, "FFFFFF")] Then
right = _x
_x = x0 ' exit For
EndIf
EndFor
For _x = right To x0 Step -1
color = GraphicsWindow.GetPixel(_x, _y)
If Text.EndsWith(color, "FFFFFF") Then
right = _x + 1
_x = x0 ' exit For
EndIf
EndFor
px = right - left
EndSub

Sub Shapes_AddEllipse
' param x, y - top left position
' param width
' param height
Shapes_EntryClear()
Shapes_PenToEntry()
Shapes_BrushToEntry()
func = "ell"
Shapes_FuncToEntry()
Shapes_MoveToEntry()
Shapes_RotateToEntry()
Shapes_EntryToArray()
EndSub

Sub Shapes_AddLine
' param x1, y1 - first point
' param x2, y2 - second point
Shapes_EntryClear()
Shapes_PenToEntry()
func = "line"
Shapes_FuncToEntry()
Shapes_MoveToEntry()
Shapes_RotateToEntry()
Shapes_EntryToArray()
EndSub

Sub Shapes_AddRectangle
' param x, y - top left position
' param width
' param height
Shapes_EntryClear()
Shapes_PenToEntry()
Shapes_BrushToEntry()
func = "rect"
Shapes_FuncToEntry()
Shapes_MoveToEntry()
Shapes_RotateToEntry()
Shapes_EntryToArray()
EndSub

Sub Shapes_AddText
' param x, y - top left position
' param txt - text
Shapes_EntryClear()
Shapes_PenToEntry()
Shapes_BrushToEntry()
Shapes_FontToEntry()
func = "text"
Shapes_FuncToEntry()
Shapes_MoveToEntry()
Shapes_RotateToEntry()
Shapes_EntryToArray()
EndSub

Sub Shapes_AddTriangle
' param x1, y1 - first point
' param x2, y2 - second point
' param x3, y3 - third point
Shapes_EntryClear()
Shapes_PenToEntry()
Shapes_BrushToEntry()
func = "tri"
Shapes_FuncToEntry()
Shapes_MoveToEntry()
Shapes_RotateToEntry()
Shapes_EntryToArray()
EndSub

Sub Shapes_BrushToEntry
GraphicsWindow.BrushColor = bc
shp["bc"] = bc
EndSub

Sub Shapes_DumpProgram
buf = "Sub Shapes_Init_Caption" + LF
buf = buf + " ' Shapes | Initialize shapes data" + LF
buf = buf + " ' return shX, shY - current position of shapes" + LF
buf = buf + " ' return shape - array of shapes" + LF
buf = buf + " shX = " + shX + " ' x offset" + LF
buf = buf + " shY = " + shY + " ' y offset" + LF
buf = buf + " shape = " + WQ + WQ + LF
For i = iMin To iMax
buf = buf + " shape[" + i + "] = " + WQ
shp = shape[i]
For j = 1 To nOrder
If shp[order[j]] <> "" Then
buf = buf + order[j] + "=" + shp[order[j]] + ";"
EndIf
EndFor
buf = buf + WQ + LF
EndFor
buf = buf + "EndSub" + LF
Controls.SetTextBoxText(mbox, buf)
EndSub

Sub Shapes_EntryClear
shp = ""
EndSub

Sub Shapes_EntryToArray
iMax = iMax + 1
shape[iMax] = shp
EndSub

Sub Shapes_FontToEntry
GraphicsWindow.FontSize = fs
shp["fs"] = fs
GraphicsWindow.FontName = fn
shp["fn"] = fn
GraphicsWindow.FontBold = fb
shp["fb"] = fb
GraphicsWindow.FontItalic = fi
shp["fi"] = fi
EndSub

Sub Shapes_FuncToEntry
shp["func"] = func
obj = ""
If func = "ell" Then
obj = Shapes.AddEllipse(width, height)
shp["width"] = Math.Floor(width * 100) / 100
shp["height"] = Math.Floor(height * 100) / 100
ElseIf func = "rect" Then
obj = Shapes.AddRectangle(width, height)
shp["width"] = Math.Floor(width * 100) / 100
shp["height"] = Math.Floor(height * 100) / 100
ElseIf func = "tri" Then
obj = Shapes.AddTriangle(x1, y1, x2, y2, x3, y3)
shp["x1"] = Math.Floor(x1 * 100) / 100
shp["y1"] = Math.Floor(y1 * 100) / 100
shp["x2"] = Math.Floor(x2 * 100) / 100
shp["y2"] = Math.Floor(y2 * 100) / 100
shp["x3"] = Math.Floor(x3 * 100) / 100
shp["y3"] = Math.Floor(y3 * 100) / 100
ElseIf func = "line" Then
obj = Shapes.AddLine(x1, y1, x2, y2)
shp["x1"] = Math.Floor(x1 * 100) / 100
shp["y1"] = Math.Floor(y1 * 100) / 100
shp["x2"] = Math.Floor(x2 * 100) / 100
shp["y2"] = Math.Floor(y2 * 100) / 100
ElseIf func = "text" Then
obj = Shapes.AddText(txt)
shp["text"] = txt
EndIf
If obj <> "" Then
shp["obj"] = obj
EndIf
EndSub

Sub Shapes_Normalize
For i = 1 To iMax
shp = shape[i]
If Text.IsSubText("line|tri", shp["func"]) Then
xmin = shp["x1"]
ymin = shp["y1"]
If shp["x2"] < xmin Then
xmin = shp["x2"]
EndIf
If shp["y2"] < ymin Then
ymin = shp["y2"]
EndIf
If shp["func"] = "tri" Then
If shp["x3"] < xmin Then
xmin = shp["x3"]
EndIf
If shp["y3"] < ymin Then
ymin = shp["y3"]
EndIf
shp["x3"] = shp["x3"] - xmin
shp["y3"] = shp["y3"] - ymin
EndIf
shp["x"] = shp["x"] + xmin
shp["y"] = shp["y"] + ymin
shp["x1"] = shp["x1"] - xmin
shp["y1"] = shp["y1"] - ymin
shp["x2"] = shp["x2"] - xmin
shp["y2"] = shp["y2"] - ymin
shape[i] = shp
EndIf
EndFor
If 0 < iMax Then
shp = shape[1]
xmin = shp["x"]
ymin = shp["y"]
xmax = shp["x"]
ymax = shp["y"]
EndIf
For i = 2 To iMax
shp = shape[i]
If shp["x"] < xmin Then
xmin = shp["x"]
EndIf
If shp["y"] < ymin Then
ymin = shp["y"]
EndIf
If xmax < shp["x"] Then
xmax = shp["x"]
EndIf
If ymax < shp["y"] Then
ymax = shp["y"]
EndIf
EndFor
shX = xmin
shY = ymin
For i = 1 To iMax
shp = shape[i]
shp["x"] = shp["x"] - xmin
shp["y"] = shp["y"] - ymin
If shp["angle"] = 0 Then
shp["angle"] = ""
EndIf
shape[i] = shp
EndFor
EndSub

Sub Shapes_MoveToEntry
Shapes.Move(obj, x, y)
shp["x"] = Math.Floor(x * 100) / 100
shp["y"] = Math.Floor(y * 100) / 100
EndSub

Sub Shapes_PenToEntry
GraphicsWindow.PenWidth = pw
shp["pw"] = pw
If 0 < pw Then
GraphicsWindow.PenColor = pc
shp["pc"] = pc
EndIf
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
shp = shape[i]
Shapes.Remove(shp["obj"])
EndFor
i = Stack.PopValue("local")
EndSub

Sub Shapes_RotateToEntry
If angle <> 0 Then
Shapes.Rotate(obj, angle)
shp["angle"] = Math.Floor(angle * 100) / 100
EndIf
EndSub