06-13-2022, 06:45 PM
A few circle drawing routines that use the draw command. You can never have too many options.
Code: (Select All)
'draw circles
'by James D. Jarvis
' a few subs with to draw circles and pie charts
Screen _NewImage(800, 500, 256)
'$dynamic 'this is just set to dynamic for the piechart part of the demo
Print "A few subs to draw cricles, arcs, and pie charts using simple math and the draw command."
Print "Not perfect yet, but they work for smaller circles."
Locate 3, 1: Print "A simple filled circle"
_Delay 0.85
dcircle 200, 100, 10, 12
Locate 3, 1: Print "An arc from 0 t0 270"
_Delay 0.85
darc 200, 100, 20, 13, 0, 270
Locate 3, 1: Print "An arc from 140 0 320"
_Delay 0.85
darc 200, 100, 56, 10, 140, 320
Locate 3, 1: Print "A pie slice with different color borders "
_Delay 0.85
dpieslice 100, 100, 20, 2, 10, 0, 60
Dim pd(3)
pd(1) = 5
pd(2) = 10
pd(3) = 15
piechart 300, 300, 70, 15, pd()
For t = 1 To 10
_Limit 5
Next t
Cls
'showing a pie chart if one of the fields grows and another has a decreese
For x = 5 To 20
_Limit 3
pd(1) = x
pd(3) = pd(3) * .9
Cls
dcircle 200, 100, 10, 12 'copied so it doesn't vanish
darc 200, 100, 20, 13, 0, 270 'copied so it doesn't vanish
darc 200, 100, 56, 13, 140, 320 'copied so it doesn't vanish
dpieslice 100, 100, 20, 2, 10, 0, 60 'copied so it doesn't vanish
piechart 300, 300, 70, 15, pd()
_Display
Next x
'showing a pie chart gaining entries
For n = 1 To 12
_Limit 3
np = UBound(pd) + n
ReDim _Preserve pd(np)
pd(np) = 15 - n
Cls
dcircle 200, 100, 10, 12 'copied so it doesn't vanish
darc 200, 100, 20, 13, 0, 270 'copied so it doesn't vanish
darc 200, 100, 56, 13, 140, 320 'copied so it doesn't vanish
dpieslice 100, 100, 20, 2, 10, 0, 60 'copied so it doesn't vanish
piechart 300, 300, 70, 15, pd()
_Display
'getting a color leak I haven't figured out just yet
Locate 1, 1: Print "Haven't tracked down why that bleed happens just yet. Hope you find some of this useful."
Next n
Sub dcircle (xx, yy, r, klr)
'draw a circle
PSet (xx, yy), klr
Draw "c" + Str$(klr)
For d = 0 To 360 Step 1
Draw "ta " + Str$(d) + " r" + Str$(r) + " bl" + Str$(r)
Next d
End Sub
Sub darc (xx, yy, r, klr, arc1, arc2)
'draws an arc, will draw an unfilled circle if the arc goes from 0 to 360
PSet (xx, yy), klr
Draw "c" + Str$(klr)
For d = arc1 To arc2 Step 1
Draw "ta " + Str$(d) + " br" + Str$(r - 1) + "r bl" + Str$(r)
Next d
End Sub
Sub dpieslice (xx, yy, r, klr, fill, arc1, arc2)
'draws and fills a pie slice
PSet (xx, yy), klr
Draw "c" + Str$(klr)
For d = arc1 To arc2 Step 0.3
Draw "ta " + Str$(d) + " br" + Str$(r - 1) + "r bl" + Str$(r)
Next d
Draw "ta" + Str$(arc1) + " r " + Str$(r) + "bl" + Str$(r)
Draw "ta" + Str$(arc2) + " r " + Str$(r) + "bl" + Str$(r)
Draw "ta" + Str$((arc1 + arc2) / 2) + "br " + Str$(Int(r / 2)) + "P" + Str$(fill) + "," + Str$(klr) + " bl" + Str$(Int(r / 2))
End Sub
Sub piechart (xx, yy, r, klr, a())
'takes array a() as raw data and calculates size of pie wedges to be drawn
Dim portion(UBound(a))
total = 0
For ss = 1 To UBound(a)
total = a(ss) + total
Next ss
For ss = 1 To UBound(a)
portion(ss) = a(ss) / total
Next ss
a1 = 0
'pie wedges are drawn AND filled with colors starting from color 1
For ss = 1 To UBound(a)
ap = portion(ss) * 360
a2 = a1 + ap
dpieslice xx, yy, r, klr, ss, a1, a2
a1 = a2
Next ss
End Sub