Thread Rating:
  • 0 Vote(s) - 0 Average
  • 1
  • 2
  • 3
  • 4
  • 5
blue circle isn't drawing and print isn't working?
#5
(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.  Tongue

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.
I got it working - thanks!

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$
Reply


Messages In This Thread
RE: blue circle isn't drawing and print isn't working? - by madscijr - 09-20-2024, 11:36 PM



Users browsing this thread: 5 Guest(s)