aaaabbbb

'Soroban – Japanese Abacus – SKH302-3
‘Harry Hardjono
‘August 2012

‘These Unicode Characters draw Card Suits: Spade, Heart, Diamond,Club
‘TestStr=Text.GetCharacter(9824)+Text.GetCharacter(9829)+Text.GetCharacter(9830)+Text.GetCharacter(9827)

‘Special Thanks for Nonki Takahashi for his ideas and encouragements.

InitLoop:
GraphicsWindow.Title=”Small Basic Abacus”
GraphicsWindow.Width = 400
GraphicsWindow.Height=400
GraphicsWindow.FontSize=20
GraphicsWindow.FontName=”Courier”
GraphicsWindow.Clear()
GraphicsWindow.Show()
GraphicsWindow.BrushColor=”white”
GraphicsWindow.FillRectangle(0,0,GraphicsWindow.Width,GraphicsWindow.Height)
GraphicsWindow.BrushColor=”black”
DoBG()
SetBead()
For i=0 To 14
BB[i]=0
SB[i]=0
EndFor
DoBead()
DoDigit()
IBB=BB
ISB=SB
DrawLoop:
BB=IBB
SB=ISB
x= GraphicsWindow.MouseX
y= GraphicsWindow.MouseY
If Mouse.IsLeftButtonDown Then
DoMouse()
DoBead()
DoDigit()
DoClick()
EndIf
Program.Delay(50) ‘Wait 50 miliseconds
Goto DrawLoop
Sub DoBG
GraphicsWindow.BrushColor=”Black” ‘Draw Frame
GraphicsWindow.FillRectangle(0,0,399,212)
GraphicsWindow.BrushColor=”White”
GraphicsWindow.FillRectangle(12,12,375,188)
GraphicsWindow.BrushColor=”Brown”
For i=0 to 14
GraphicsWindow.FillRectangle(23+(i*25),12,3,188)
endfor
GraphicsWindow.BrushColor=”Black” ‘Draw Slate & Rod
GraphicsWindow.FillRectangle(0,62,399,13)
‘Credits
GraphicsWindow.DrawText(20,300,”Four Suit Abacus”)
GraphicsWindow.DrawText(120,325,”by”)
GraphicsWindow.DrawText(150,350,”Harry M. Hardjono”)
‘Draw FourSuits
GraphicsWindow.BrushColor=”White”
GraphicsWindow.FontSize=10 ‘May need changing for different system
GraphicsWindow.DrawText(85,62,Text.GetCharacter(9824))
GraphicsWindow.DrawText(160,62,Text.GetCharacter(9829))
GraphicsWindow.DrawText(235,62,Text.GetCharacter(9830))
GraphicsWindow.DrawText(310,62,Text.GetCharacter(9827))
GraphicsWindow.FontSize=20
EndSub
Sub SetBead
‘BigBead
For i=0 to 14
GraphicsWindow.BrushColor=GraphicsWindow.GetRandomColor()
SSBB[0][i]=Shapes.AddEllipse(25,25)
Shapes.Move(SSBB[0][i],12+(i*25),12)
EndFor
‘SmallBead
For j=0 To 3
For i=0 to 14
GraphicsWindow.BrushColor=GraphicsWindow.GetRandomColor()
SSSB[j][i]=Shapes.AddEllipse(25,25)
Shapes.Move(SSSB[j][i],12+(i*25),75+(j*25))
EndFor
endfor
‘Digits
For i=0 to 14
GraphicsWindow.BrushColor=GraphicsWindow.GetRandomColor()
SSDG[i]=Shapes.AddText(“0″)
Shapes.Move(SSDG[i],17+(i*25),212)
EndFor
EndSub
Sub DoDigit
For i=0 to 14
Shapes.SetText(SSDG[i],(5*BB[i]+SB[i]))
endFor
EndSub
Sub DoBead
For i=0 to 14
Shapes.Move(SSBB[0][i],12+(i*25),12+(BB[i]*25))
EndFor
For i=0 to 14
For j=0 to 3
If (SB[i]<=j) then
Shapes.Move(SSSB[j][i],12+(i*25),75+((j+1)*25))
Else
Shapes.Move(SSSB[j][i],12+(i*25),75+((j)*25))
endif
EndFor
EndFor
EndSub
Sub DoMouse
map_var=”mx1=12;mx2=”+x+”;mx3=387;my1=0;my3=15″ ‘Xcoord mapped to 0-14
map()
cx=Math.Floor(map_var["my2"])
If (cx>=0 and cx<=14) then
If (y>12 And y<62) Then
map_var=”mx1=12;mx2=”+y+”;mx3=62;my1=2;my3=0″ ‘Ycoord mapped to 1-0
map()
cy=Math.Floor(map_var["my2"])
If (cy>=0 And cy<=1) Then
BB[cx]=cy
EndIf
EndIf
If (y>75 And y<200) Then
map_var=”mx1=75;mx2=”+y+”;mx3=200;my1=0;my3=5″ ‘Ycoord mapped to 4-0
map()
cy=Math.Floor(map_var["my2"])
If (cy>=0 And cy<=4) Then
SB[cx]=cy
EndIf
EndIf
EndIf
EndSub
Sub DoClick
if (BB<>IBB Or ISB<>SB) Then
Sound.PlayClick()
EndIf
IBB=BB
ISB=SB
EndSub
‘———————————————-
‘map function
‘———————————————-
Sub map
‘x1-x2-x3 y1-y2-y3
‘(x2-x1)/(x3-x1)=(y2-y1)/(y3-y1)
‘y1+(y3-y1)*(x2-x1)/(x3-x1)=y2
map_var["my2"]=((map_var["my3"]-map_var["my1"])*(map_var["mx2"]-map_var["mx1"])/(map_var["mx3"]-map_var["mx1"]))+map_var["my1"]
EndSub
  1. //
    1. Final del formulario
  2. Copyright (c) Microsoft Corporation. All rights reserved.

Deja un comentario