Arcs and PieSlices
These routines follow Basic Trig functions that start 0 Degrees/Radians Due East and go Clock wise around the screen from there:
Code: (Select All)
Option _Explicit
_Title "Arc & PieSlice (Filled) testing, escape for 2nd test" ' bplus rev 2024-10-15
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 250, 60
Dim As Single xc, yc, a, x1, y1, s, e, r, degree10, at, xoff, yoff, radius, x, y, cnt
Dim sa$
Dim cc As _Unsigned Long
degree10 = _Pi(2 / 36)
xc = 400: yc = 300
r = 250
Do
Cls
cc = _RGB32(Rnd * 155 + 100, Rnd * 255, Rnd * 255, Rnd * 200 + 55)
s = Rnd * _Pi(2): e = Rnd * _Pi(2)
For a = 0 To _Pi(1.999) Step degree10
' Regular East = 0 calcs
x1 = xc + r * Cos(a)
y1 = yc + r * Sin(a)
at = Int(_R2D(_Atan2(y1 - yc, x1 - xc)) + .0001)
If at < 0 Then at = at + 360
sa$ = _Trim$(Str$(at))
xoff = _PrintWidth(sa$) / 2
yoff = 16 / 2
_PrintString (x1 - xoff, y1 - yoff), sa$
Next
radius = Rnd * 100 + 100
Arc 400, 300, radius, s, e, cc
PieSlice 400, 300, radius - 10, s, e, cc, 1 ' test all fills !!!!
Print "Start Angle:"; Int(_R2D(s)) ' covert to degrees
Print "End Angle:"; Int(_R2D(e))
Print: Print "zzz, Press any...."
Sleep
Loop Until _KeyDown(27)
Cls
_KeyClear
_Title "Failure if the Screen floods by a bad Paint Job, any ky quits."
Do
cc = _RGB32(Rnd * 155 + 100, Rnd * 255, Rnd * 255, Rnd * 200 + 55)
s = Rnd * _Pi(2): e = Rnd * _Pi(2)
radius = Rnd * 100 + 10
x = Rnd * _Width: y = Rnd * _Height
Arc x, y, radius, s, e, cc
PieSlice x, y, radius - 5, s, e, cc, 1 ' test all fills !!!!
_Limit 1
cnt = cnt + 1
If cnt Mod 50 = 49 Then Cls
Loop While InKey$ = ""
Sub Arc (CX, CY, R, RAStart, RAStop, C~&) ' rev 2024-10-14
'CX, CY Center Circle point, R = radius, C~& = color
' RaStart and RAStop are Radian angles,
' RAStart is first angle clockwise from due East = 0 Radians
' Arc will start drawing there and go clockwise until raEnd is reached
'note in Basic: degrees start due East = 0 and go clockwise
Dim raEnd, stepper, a
If RAStop < RAStart Then raEnd = RAStop + _Pi(2) Else raEnd = RAStop
stepper = 1 / R
For a = RAStart To raEnd Step stepper
If (a - RAStart) < stepper Then
PSet (CX + R * Cos(a), CY + R * Sin(a)), C~&
Else
Line -(CX + R * Cos(a), CY + R * Sin(a)), C~&
End If
Next
End Sub
Sub PieSlice (XC, YC, R, RStart, REnd, C As _Unsigned Long, FillTF) 'rev 2024-10-15
' XC, YC Center for arc circle with radius R
' RStart is the Radian Start Angle, use _D2R for conversion from Degrees to Radians
' REnd is Radian End Angle
' Arc will start at rStart and go clockwise around to rEnd Radians
Dim rStop, rMid, stepper, a, x, y
Dim bc As _Unsigned Long
bc = _RGB32(_Red32(C), _Green32(C), _Blue32(C))
If REnd < RStart Then rStop = REnd + _Pi(2) Else rStop = REnd
rMid = rStop - RStart
Line (XC, YC)-(XC + R * Cos(RStart), YC + R * Sin(RStart)), bc
Line (XC, YC)-(XC + R * Cos(rStop), YC + R * Sin(rStop)), bc
stepper = 1 / R ' the bigger the radius the smaller the steps
For a = RStart To rStop Step stepper
x = XC + R * Cos(a)
y = YC + R * Sin(a)
If a > RStart Then Line -(x, y), bc Else PSet (x, y), bc
Next
If FillTF Then Paint (XC + R / 2 * Cos(RStart + rMid / 2), YC + R / 2 * Sin(RStart + rMid / 2)), C, bc
End SubMore Newly revised PieSlice and testing code, works for transparent colors with more dependable Fills.
Code: (Select All)
Option _Explicit
_Title "Arc & PieSlice (Filled) testing, escape for 2nd test" ' bplus rev 2024-10-15
Randomize Timer
Screen _NewImage(800, 600, 32)
_ScreenMove 250, 60
Dim As Single xc, yc, a, x1, y1, s, e, r, degree10, at, xoff, yoff, radius, x, y, cnt
Dim sa$
Dim cc As _Unsigned Long
degree10 = _Pi(2 / 36)
xc = 400: yc = 300
r = 250
Do
Cls
cc = _RGB32(Rnd * 155 + 100, Rnd * 255, Rnd * 255, Rnd * 200 + 55)
s = Rnd * _Pi(2): e = Rnd * _Pi(2)
For a = 0 To _Pi(1.999) Step degree10
' Regular East = 0 calcs
x1 = xc + r * Cos(a)
y1 = yc + r * Sin(a)
at = Int(_R2D(_Atan2(y1 - yc, x1 - xc)) + .0001)
If at < 0 Then at = at + 360
sa$ = _Trim$(Str$(at))
xoff = _PrintWidth(sa$) / 2
yoff = 16 / 2
_PrintString (x1 - xoff, y1 - yoff), sa$
Next
radius = Rnd * 100 + 100
Arc 400, 300, radius, s, e, cc
PieSlice 400, 300, radius - 10, s, e, cc, 1 ' test all fills !!!!
Print "Start Angle:"; Int(_R2D(s)) ' covert to degrees
Print "End Angle:"; Int(_R2D(e))
Print: Print "zzz, Press any...."
Sleep
Loop Until _KeyDown(27)
Cls
_KeyClear
_Title "Failure if the Screen floods by a bad Paint Job, any ky quits."
Do
cc = _RGB32(Rnd * 155 + 100, Rnd * 255, Rnd * 255, Rnd * 200 + 55)
s = Rnd * _Pi(2): e = Rnd * _Pi(2)
radius = Rnd * 100 + 10
x = Rnd * _Width: y = Rnd * _Height
Arc x, y, radius, s, e, cc
PieSlice x, y, radius - 5, s, e, cc, 1 ' test all fills !!!!
_Limit 1
cnt = cnt + 1
If cnt Mod 50 = 49 Then Cls
Loop While InKey$ = ""
Sub Arc (CX, CY, R, RAStart, RAStop, C~&) ' rev 2024-10-14
'CX, CY Center Circle point, R = radius, C~& = color
' RaStart and RAStop are Radian angles,
' RAStart is first angle clockwise from due East = 0 Radians
' Arc will start drawing there and go clockwise until raEnd is reached
'note in Basic: degrees start due East = 0 and go clockwise
Dim raEnd, stepper, a
If RAStop < RAStart Then raEnd = RAStop + _Pi(2) Else raEnd = RAStop
stepper = 1 / R
For a = RAStart To raEnd Step stepper
If (a - RAStart) < stepper Then
PSet (CX + R * Cos(a), CY + R * Sin(a)), C~&
Else
Line -(CX + R * Cos(a), CY + R * Sin(a)), C~&
End If
Next
End Sub
Sub PieSlice (XC, YC, R, RStart, REnd, C As _Unsigned Long, FillTF) 'rev 2024-10-15
' XC, YC Center for arc circle with radius R
' RStart is the Radian Start Angle, use _D2R for conversion from Degrees to Radians
' REnd is Radian End Angle
' Arc will start at rStart and go clockwise around to rEnd Radians
Dim rStop, rMid, stepper, a, x, y
Dim bc As _Unsigned Long
bc = _RGB32(_Red32(C), _Green32(C), _Blue32(C))
If REnd < RStart Then rStop = REnd + _Pi(2) Else rStop = REnd
rMid = rStop - RStart
Line (XC, YC)-(XC + R * Cos(RStart), YC + R * Sin(RStart)), bc
Line (XC, YC)-(XC + R * Cos(rStop), YC + R * Sin(rStop)), bc
stepper = 1 / R ' the bigger the radius the smaller the steps
For a = RStart To rStop Step stepper
x = XC + R * Cos(a)
y = YC + R * Sin(a)
If a > RStart Then Line -(x, y), bc Else PSet (x, y), bc
Next
If FillTF Then Paint (XC + R / 2 * Cos(RStart + rMid / 2), YC + R / 2 * Sin(RStart + rMid / 2)), C, bc
End Sub
b = b + ...