09-20-2024, 11:36 PM
(09-20-2024, 10:51 PM)SMcNeill Wrote: This one is simple. You're using two different variables of the same name and different types.I got it working - thanks!
Code: (Select All)Dim Shared cBlue As _Unsigned Long
In your program, you're using the variable named cBlue... But you DIM SHARED cBlue~&.... those aren't the same variables.
cBlue defaults to a single. cBlue~& is an unsigned long.
singles don't carry blue transparency values, so they get rounded to 0.
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
' 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~&
DrawNext iX, iY, iR, iC
iX = 300 ' iScreenWidth% \ 4
iY = 300 ' iScreenHeight% \ 4
iR = 50
iC = cRed~&
DrawNext iX, iY, iR, iC
iX = 400 ' iScreenWidth% \ 4
iY = 300 ' iScreenHeight% \ 4
iR = 50
iC = cLime~&
DrawNext iX, iY, iR, iC
'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~&)
Color cCyan~&, cEmpty~&
Print Left$(_Trim$(Str$(x%)) + " ", 3) + " " + Left$(_Trim$(Str$(y%)) + " ", 3) + " " + Left$(_Trim$(Str$(r%)) + " ", 6) + " " + ColorToString$(c~&)
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
' /////////////////////////////////////////////////////////////////////////////
Function ColorToString$ (MyValue~&)
Dim Mystring As String
Select Case MyValue~&
Case cRed~&:
Mystring = "Red"
Case cOrangeRed~&:
Mystring = "OrangeRed"
Case cDarkOrange~&:
Mystring = "DarkOrange"
Case cOrange~&:
Mystring = "Orange"
Case cGold~&:
Mystring = "Gold"
Case cYellow~&:
Mystring = "Yellow"
Case cOliveDrab1~&:
Mystring = "OliveDrab1"
Case cLime~&:
Mystring = "Lime"
Case cMediumSpringGreen~&:
Mystring = "MediumSpringGreen"
Case cSpringGreen~&:
Mystring = "SpringGreen"
Case cCyan~&:
Mystring = "Cyan"
Case cDeepSkyBlue~&:
Mystring = "DeepSkyBlue"
Case cDodgerBlue~&:
Mystring = "DodgerBlue"
Case cSeaBlue~&:
Mystring = "SeaBlue"
Case cBlue~&:
Mystring = "Blue"
Case cBluePurple~&:
Mystring = "BluePurple"
Case cDeepPurple~&:
Mystring = "DeepPurple"
Case cPurple~&:
Mystring = "Purple"
Case cPurpleRed~&:
Mystring = "PurpleRed"
Case cDarkRed~&:
Mystring = "DarkRed"
Case cBrickRed~&:
Mystring = "BrickRed"
Case cDarkGreen~&:
Mystring = "DarkGreen"
Case cGreen~&:
Mystring = "Green"
Case cOliveDrab~&:
Mystring = "OliveDrab"
Case cLightPink~&:
Mystring = "LightPink"
Case cHotPink~&:
Mystring = "HotPink"
Case cDeepPink~&:
Mystring = "DeepPink"
Case cMagenta~&:
Mystring = "Magenta"
Case cBlack~&:
Mystring = "Black"
Case cDimGray~&:
Mystring = "DimGray"
Case cGray~&:
Mystring = "Gray"
Case cDarkGray~&:
Mystring = "DarkGray"
Case cSilver~&:
Mystring = "Silver"
Case cLightGray~&:
Mystring = "LightGray"
Case cGainsboro~&:
Mystring = "Gainsboro"
Case cWhiteSmoke~&:
Mystring = "WhiteSmoke"
Case cWhite~&:
Mystring = "White"
Case cDarkBrown~&:
Mystring = "DarkBrown"
Case cLightBrown~&:
Mystring = "LightBrown"
Case cKhaki~&:
Mystring = "Khaki"
Case cEmpty~&:
Mystring = "Empty"
Case Else:
Mystring = _Trim$(Str$(MyValue~&))
End Select
ColorToString$ = Mystring
End Function ' ColorToString$