Microsoft Small Basic

Program Listing: MNV389-5

List Program

' Abacus 0.61
' Copyright (c) 2012-2014 Nonki Takahashi.
'
' Lisence:
' The MIT Lisence (MIT)
' http://en.wikipedia.org/wiki/MIT_License
'
' History :
' 0.61 2013-05-20 Added workaround for Silverlight. (MNV389-5)
' 0.5 2012-09-05 Corrected unit points. (MNV389-3)
' 0.4 2012-09-04 Supported mouse drag. (MNV389-2)
' 0.3 2012-08-04 Used image for bead. (MNV389-1)
' 0.2 2012-08-03 Added unit points. (MNV389-0)
' 0.1 2012-08-03 Created. (MNV389)
'
' Reference:
' [1] http://social.technet.microsoft.com/wiki/contents/articles/21691.small-basic-known-issue-21691-rectangle-and-ellipse-become-smaller-in-remote.aspx
' [2] http://social.technet.microsoft.com/wiki/contents/articles/21694.small-basic-known-issue-21694-font-and-pen-width-change-earlier-in-remote.aspx
'
SB_Workaround()
title = "Abacus 0.61"
GraphicsWindow.Title = title
scale = 3 ' [pixel/mm]
x0 = 20 * scale ' [pixel]
y0 = 20 * scale ' [pixel]
dx = 15 ' [mm]
dy = 5 ' [mm]
fw = 4 ' frame width [mm]
rh = 52 ' rod height [mm]
bh = 8 ' bead height [mm]
GraphicsWindow.BackgroundColor = "LightGray"
imgBead = ImageList.LoadImage("http://www.nonkit.com/smallbasic.files/bead.png")
For i = 0 To 14
CreateRod()
EndFor
DrawFrame()
CreateBeam()
clicked = "False"
GraphicsWindow.MouseDown = OnMouseDown
GraphicsWindow.MouseUp = OnMouseUp
GraphicsWindow.MouseMove = OnMouseMove
While "True"
Program.Delay("100")
If clicked Then
MoveBeads()
Program.Delay("200")
If released Then
clicked = "False"
released = "False"
EndIf
EndIf
EndWhile
Sub CreateBead
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = "SaddleBrown"
abacus[i]["oBead" + n] = Shapes.AddImage(imgBead)
If n = 5 Then
y = y0 + fw * scale
Else
y = y0 + (15 + fw + dy + (n - 1) * bh) * scale
EndIf
Shapes.Move(abacus[i]["oBead" + n], x0 + ((14 - i) * dx + 12 - 13 / 2) * scale, y)
EndSub
Sub CreateBeam
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = "Black"
width = (234 - 2 * fw) * scale
oBeam = Shapes.AddRectangle(width, 2 * scale)
Shapes.Move(oBeam, x0 + fw * scale, y0 + (13 + fw) * scale)
GraphicsWindow.BrushColor = "White"
oBeam = Shapes.AddRectangle(width, 1 * scale)
Shapes.Move(oBeam, x0 + fw * scale, y0 + (13.5 + fw) * scale)
GraphicsWindow.BrushColor = "Black"
For i = 0 To 14
If Math.Remainder(i, 3) = 1 Then
oUnitPoint = Shapes.AddEllipse(1 * scale, 1 * scale)
Shapes.Move(oUnitPoint, x0 + ((14 - i) * dx + 11.5) * scale, y0 + (13.5 + fw) * scale)
EndIf
EndFor
EndSub
Sub CreateRod
' param i - rod index (means i^10)
' param dx - rod to rod
GraphicsWindow.PenWidth = 0
GraphicsWindow.BrushColor = "#332110"
abacus[i]["oRod"] = Shapes.AddRectangle(2 * scale, rh * scale)
Shapes.Move(abacus[i]["oRod"], x0 + ((14 - i) * dx + 11) * scale, y0 + fw * scale)
n = 5
CreateBead()
For n = 1 To 4
CreateBead()
EndFor
GraphicsWindow.BrushColor = "Black"
GraphicsWindow.FontSize = 20
abacus[i]["digit"] = "0"
abacus[i]["oDigit"] = Shapes.AddText(abacus[i]["digit"])
Shapes.Move(abacus[i]["oDigit"], x0 + ((14 - i) * dx + 10) * scale, y0 + 65 * scale)
EndSub
Sub DrawFrame
GraphicsWindow.PenColor = "Black"
GraphicsWindow.PenWidth = fw * scale
x = x0 + (fw / 2) * scale
y = y0 + (fw / 2) * scale
width = (234 - fw) * scale
height = (rh + fw) * scale
If silverlight Then
xWA = x - fw * scale / 2
yWA = y - fw * scale / 2
wWA = width + fw * scale
hWA = height + fw * scale
GraphicsWindow.DrawRectangle(xWA, yWA, wWA, hWA) ' [1] see Reference
Program.Delay(msWait) ' [2] see Reference
Else
GraphicsWindow.DrawRectangle(x, y, width, height)
EndIf
GraphicsWindow.Width = x0 * 2 + width
GraphicsWindow.Height = y0 * 2.7 + height
EndSub
Sub MoveBeads
i = 14 - Math.Floor((mx - (x0 + fw * scale)) / (dx * scale))
If i < 0 Or 14 < i Then
Goto mb_return
EndIf
' Check 5-unit bead
on = Math.Floor(abacus[i]["digit"] / 5)
y1 = y0 + (fw + on * dy) * scale
y2 = y0 + (fw + on * dy + bh) * scale
If y1 <= my And my <= y2 Then
Sound.PlayClick()
If on = 1 Then
y = y0 + fw * scale
abacus[i]["digit"] = abacus[i]["digit"] - 5
Else ' on = 0
y = y0 + (fw + dy) * scale
abacus[i]["digit"] = abacus[i]["digit"] + 5
EndIf
Shapes.Move(abacus[i]["oBead5"], x0 + ((14 - i) * dx + 12 - 13 / 2) * scale, y)
Shapes.SetText(abacus[i]["oDigit"], abacus[i]["digit"])
Goto mb_return
EndIf
' Check 1-unit beads
rem = Math.Remainder(abacus[i]["digit"], 5)
If rem > 0 Then ' check on-beads
y1 = y0 + (fw + 15) * scale
y2 = y0 + (fw + 15 + rem * bh) * scale
If y1 <= my And my <= y2 Then
Sound.PlayClick()
n = Math.Floor((my - y1) / (bh * scale)) + 1
abacus[i]["digit"] = abacus[i]["digit"] - rem + n - 1
For b = rem To n Step -1
y = y0 + (15 + fw + dy + (b - 1) * bh) * scale
Shapes.Move(abacus[i]["oBead" + b], x0 + ((14 - i) * dx + 12 - 13 / 2) * scale, y)
EndFor
Shapes.SetText(abacus[i]["oDigit"], abacus[i]["digit"])
Goto mb_return
EndIf
EndIf
If rem < 4 Then ' check off-beads
y1 = y0 + (fw + 15 + (rem * bh) + dy) * scale
y2 = y0 + (fw + 15 + (4 * bh) + dy) * scale
If y1 <= my And my <= y2 Then
Sound.PlayClick()
n = Math.Floor((my - y1) / (bh * scale)) + rem + 1
abacus[i]["digit"] = abacus[i]["digit"] - rem + n
For b = rem + 1 To n
y = y0 + (15 + fw + (b - 1) * bh) * scale
Shapes.Move(abacus[i]["oBead" + b], x0 + ((14 - i) * dx + 12 - 13 / 2) * scale, y)
EndFor
Shapes.SetText(abacus[i]["oDigit"], abacus[i]["digit"])
Goto mb_return
EndIf
EndIf
mb_return:
EndSub
Sub OnMouseMove
mx = GraphicsWindow.MouseX
my = GraphicsWindow.MouseY
EndSub
Sub OnMouseDown
released = "False"
clicked = "True"
EndSub
Sub OnMouseUp
released = "True"
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