09-20-2024, 10:42 PM
OK, I'm a little stumped, I'm trying to use Steve's circle drawing routine from a while back, to draw a red circle and a blue circle, and print on the screen the x,y, radius of the circle and the color. It's drawing the red circle, but not the blue one, and no text is appearing. If I could get a 2nd set of eyes to expose my foolishness, that would be most appreciated!
Code: (Select All)
' Circle code by SMcNeill from:
' Circles and Ellipses(Tilt and Fill)
' https://qb64phoenix.com/forum/showthread.php?tid=1806
' CONSTANTS
Const FALSE = 0
Const TRUE = Not FALSE
' COLORS
Dim Shared cRed~&
Dim Shared cOrangeRed~&
Dim Shared cDarkOrange~&
Dim Shared cOrange~&
Dim Shared cGold~&
Dim Shared cYellow~&
Dim Shared cOliveDrab1~&
Dim Shared cLime~&
Dim Shared cMediumSpringGreen~&
Dim Shared cSpringGreen~&
Dim Shared cCyan~&
Dim Shared cDeepSkyBlue~&
Dim Shared cDodgerBlue~&
Dim Shared cSeaBlue~&
Dim Shared cBlue~&
Dim Shared cBluePurple~&
Dim Shared cDeepPurple~&
Dim Shared cPurple~&
Dim Shared cPurpleRed~&
Dim Shared cDarkRed~&
Dim Shared cBrickRed~&
Dim Shared cDarkGreen~&
Dim Shared cGreen~&
Dim Shared cOliveDrab~&
Dim Shared cLightPink~&
Dim Shared cHotPink~&
Dim Shared cDeepPink~&
Dim Shared cMagenta~&
Dim Shared cBlack~&
Dim Shared cDimGray~&
Dim Shared cGray~&
Dim Shared cDarkGray~&
Dim Shared cSilver~&
Dim Shared cLightGray~&
Dim Shared cGainsboro~&
Dim Shared cWhiteSmoke~&
Dim Shared cWhite~&
Dim Shared cDarkBrown~&
Dim Shared cLightBrown~&
Dim Shared cKhaki~&
Dim Shared cEmpty~&
Dim Shared iScreenWidth%
Dim Shared iScreenHeight%
' SET SHARED VALUES
cRed = _RGB32(255, 0, 0)
cOrangeRed = _RGB32(255, 69, 0)
cDarkOrange = _RGB32(255, 140, 0)
cOrange = _RGB32(255, 165, 0)
cGold = _RGB32(255, 215, 0)
cYellow = _RGB32(255, 255, 0)
cOliveDrab1 = _RGB32(192, 255, 62)
cLime = _RGB32(0, 255, 0)
cMediumSpringGreen = _RGB32(0, 250, 154)
cSpringGreen = _RGB32(0, 255, 160)
cCyan = _RGB32(0, 255, 255)
cDeepSkyBlue = _RGB32(0, 191, 255)
cDodgerBlue = _RGB32(30, 144, 255)
cSeaBlue = _RGB32(0, 64, 255)
cBlue = _RGB32(0, 0, 255)
cBluePurple = _RGB32(64, 0, 255)
cDeepPurple = _RGB32(96, 0, 255)
cPurple = _RGB32(128, 0, 255)
cPurpleRed = _RGB32(128, 0, 192)
cDarkRed = _RGB32(160, 0, 64)
cBrickRed = _RGB32(192, 0, 32)
cDarkGreen = _RGB32(0, 100, 0)
cGreen = _RGB32(0, 128, 0)
cOliveDrab = _RGB32(107, 142, 35)
cLightPink = _RGB32(255, 182, 193)
cHotPink = _RGB32(255, 105, 180)
cDeepPink = _RGB32(255, 20, 147)
cMagenta = _RGB32(255, 0, 255)
cBlack = _RGB32(0, 0, 0)
cDimGray = _RGB32(105, 105, 105)
cGray = _RGB32(128, 128, 128)
cDarkGray = _RGB32(169, 169, 169)
cSilver = _RGB32(192, 192, 192)
cLightGray = _RGB32(211, 211, 211)
cGainsboro = _RGB32(220, 220, 220)
cWhiteSmoke = _RGB32(245, 245, 245)
cWhite = _RGB32(255, 255, 255)
cDarkBrown = _RGB32(128, 64, 0)
cLightBrown = _RGB32(196, 96, 0)
cKhaki = _RGB32(240, 230, 140)
cEmpty = _RGB32(0, 0, 0, 0) ' _RGBA(red, green, blue, alpha) where alpha& specifies the alpha component transparency value from 0 (fully transparent) to 255 (opaque).
iScreenWidth% = 1024 ' 800
iScreenHeight% = 768 ' 600
' LOCAL VARIABLES
Dim iX As Integer
Dim iY As Integer
Dim iR As Integer
Dim iC As _Unsigned Long
Dim sT As String
' CLEAR SCREEN & DRAW CIRCLES
Screen _NewImage(iScreenWidth%, iScreenHeight%, 32)
'Screen _NewImage(_DesktopWidth, _DesktopHeight, 32)
_ScreenMove 0, 0
_Dest 0: Cls , cBlack
'_Display ' update screen with changes & wait for next update
'_AutoDisplay ' RETURN TO AUTODISPLAY
Color , cBlack: Cls
Color cWhite, cEmpty
Print "X Y Radius Color"
iX = 200 ' iScreenWidth% \ 2
iY = 200 ' iScreenHeight% \ 2
iR = 50
iC = cBlue
sT = "blue"
DrawNext iX, iY, iR, iC, sT
iX = 300 ' iScreenWidth% \ 4
iY = 300 ' iScreenHeight% \ 4
iR = 50
iC = cRed
sT = "red"
DrawNext iX, iY, iR, iC, sT
'Call EllipseFill(550, 100, 150, 75, TransBlue)
'Call EllipseFill(570, 120, 150, 75, TransGreen)
'Call EllipseTilt(200, 400, 150, 75, 0, TransGreen)
'Call EllipseTilt(220, 420, 150, 75, 3.14 / 4, TransRed)
'Call EllipseTiltFill(0, 550, 400, 150, 75, 3.14 / 6, TransRed)
'Call EllipseTiltFill(0, 570, 420, 150, 75, 3.14 / 4, TransGreen)
'sleep
End
' /////////////////////////////////////////////////////////////////////////////
Sub DrawNext (x%, y%, r%, c~&, text$)
Color cCyan, cEmpty
Print Left$(_Trim$(Str$(x%)) + " ", 3) + " " + Left$(_Trim$(Str$(y%)) + " ", 3) + " " + Left$(_Trim$(Str$(r%)) + " ", 6) + " " + text$
Call CircleFill(x%, y%, r%, c~&)
End Sub ' DrawNext
' /////////////////////////////////////////////////////////////////////////////
Sub CircleFill (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)
' CX = center x coordinate
' CY = center y coordinate
' R = radius
' C = fill color
Dim Radius As Integer, RadiusError As Integer
Dim X As Integer, Y As Integer
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub ' CircleFill
' /////////////////////////////////////////////////////////////////////////////
Sub EllipseFill (CX As Integer, CY As Integer, a As Integer, b As Integer, C As _Unsigned Long)
' CX = center x coordinate
' CY = center y coordinate
' a = semimajor axis
' b = semiminor axis
' C = fill color
If a = 0 Or b = 0 Then Exit Sub
Dim h2 As _Integer64
Dim w2 As _Integer64
Dim h2w2 As _Integer64
Dim x As Integer
Dim y As Integer
w2 = a * a
h2 = b * b
h2w2 = h2 * w2
Line (CX - a, CY)-(CX + a, CY), C, BF
Do While y < b
y = y + 1
x = Sqr((h2w2 - y * y * w2) \ h2)
Line (CX - x, CY + y)-(CX + x, CY + y), C, BF
Line (CX - x, CY - y)-(CX + x, CY - y), C, BF
Loop
End Sub ' EllipseFill
' /////////////////////////////////////////////////////////////////////////////
Sub EllipseTilt (CX, CY, a, b, ang, C As _Unsigned Long)
' CX = center x coordinate
' CY = center y coordinate
' a = semimajor axis
' b = semiminor axis
' ang = clockwise orientation of semimajor axis in radians (0 default)
' C = fill color
For k = 0 To 6.283185307179586 + .025 Step .025
i = a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
j = -a * Cos(k) * Sin(ang) + b * Sin(k) * Cos(ang)
i = i + CX
j = -j + CY
If k <> 0 Then
Line -(i, j), C
Else
PSet (i, j), C
End If
Next
End Sub ' EllipseTilt
' /////////////////////////////////////////////////////////////////////////////
Sub EllipseTiltFill (destHandle&, CX, CY, a, b, ang, C As _Unsigned Long)
' destHandle& = destination handle
' CX = center x coordinate
' CY = center y coordinate
' a = semimajor axis
' b = semiminor axis
' ang = clockwise orientation of semimajor axis in radians (0 default)
' C = fill color
Dim max As Integer, mx2 As Integer, i As Integer, j As Integer
Dim prc As _Unsigned Long
Dim D As Integer, S As Integer
D = _Dest: S = _Source
prc = _RGB32(255, 255, 255, 255)
If a > b Then max = a + 1 Else max = b + 1
mx2 = max + max
tef& = _NewImage(mx2, mx2)
_Dest tef&
_Source tef&
For k = 0 To 6.283185307179586 + .025 Step .025
i = max + a * Cos(k) * Cos(ang) + b * Sin(k) * Sin(ang)
j = max + a * Cos(k) * Sin(ang) - b * Sin(k) * Cos(ang)
If k <> 0 Then
Line (lasti, lastj)-(i, j), prc
Else
PSet (i, j), prc
End If
lasti = i: lastj = j
Next
Dim xleft(mx2) As Integer, xright(mx2) As Integer, x As Integer, y As Integer
For y = 0 To mx2
x = 0
While Point(x, y) <> prc And x < mx2
x = x + 1
Wend
xleft(y) = x
While Point(x, y) = prc And x < mx2
x = x + 1
Wend
While Point(x, y) <> prc And x < mx2
x = x + 1
Wend
If x = mx2 Then xright(y) = xleft(y) Else xright(y) = x
Next
_Dest destHandle&
For y = 0 To mx2
If xleft(y) <> mx2 Then Line (xleft(y) + CX - max, y + CY - max)-(xright(y) + CX - max, y + CY - max), C, BF
Next
_Dest D: _Dest S
_FreeImage tef&
End Sub ' EllipseTiltFill