Proggies - Printable Version

Code: (Select All)

'Option _Explicit

_Title "Spinner 2 press enter to save imagee, try + and - " 'b+ 2021-06-18



' 2023-09-25 convert to QBJS

' 2023-09-27 use FArc for Fat Arcs!

' 2025-01-01

$If WEB Then

        import G2D From "lib/graphics/2d.bas"

$End If



Dim As Long b, r, kh, stepper

Dim a

Dim K As _Unsigned Long

Screen _NewImage(700, 700, 32): _ScreenMove 250, 0

stepper = 5

DO

    Cls , &HFFDDDDFF

    b = b + 1

    For r = 10 To 330 Step stepper ' tsh73 suggested fix for inner most

        a = _D2R(b * r / (2 * stepper))

        If Int(r / stepper) Mod 2 Then K = &HFF00AA66 Else K = &HFF000066

        FArc 350, 350, r, .4 * stepper, a, a + _Pi, K

    Next

    _Display

    DO

        kh = 0

        While kh = 0: kh = _KeyHit: Wend

        If kh = 13 Then _SaveImage "spinner2.png": End

        If kh = 43 Then stepper = stepper + 1

        If kh = 45 Then stepper = stepper - 1

    LOOP UNTIL kh = 13 OR kh = 27 OR kh = 43 OR kh = 45

LOOP UNTIL kh = 27

SYSTEM



'2023-02-04 Fill Arc draw an arc with thickness, tested in Profile Pong 3-0

' this sub needs sub FCirc(CX As Long, CY As Long, R As Long, C As _Unsigned Long) for dots

Sub FArc (x, y, r, thickness, RadianStart, RadianStop, c As _Unsigned Long)

    Dim al, a

    'x, y origin of arc, r = radius, thickness is radius of dots, c = color

    'RadianStart is first angle clockwise from due East = 0 in Radians

    ' arc will start drawing there and clockwise until RadianStop angle reached



    If RadianStop < RadianStart Then

        FArc x, y, r, thickness, RadianStart, _Pi(2), c

        FArc x, y, r, 0, thickness, RadianStop, c

    Else

        al = _Pi * r * r * (RadianStop - RadianStart) / _Pi(2)

        For a = RadianStart To RadianStop Step 1 / r

            FCirc x + r * Cos(a), y + r * Sin(a), thickness, c

        Next

    End If

End Sub



' modified for QBJS AND QB64

Sub FCirc (CX As Long, CY As Long, R As Long, C As _Unsigned Long)



    ' put this at top of QB64 to QBJS code

    '$If WEB Then

    '        import G2D From "lib/graphics/2d.bas"

    '$End If





    $If WEB Then

            G2D.FillCircle CX, CY, R, C

    $Else

        Dim Radius As Long, RadiusError As Long

        Dim X As Long, Y As Long

        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 If

End Sub

Code: (Select All)

While 1

    Cls , &HFFDDDDFF

    b = b + 1

    For r = 10 To 330 Step stepper ' tsh73 suggested fix for inner most

        a = _D2R(b * r / (2 * stepper))

        If Int(r / stepper) Mod 2 Then K = &HFF00AA66 Else K = &HFF000066

        FArc 350, 350, r, .4 * stepper, a, a + _Pi, K

    Next

    _Display

    kh = 0

    While kh = 0: kh = _KeyHit: Wend

    If kh = 13 Then _SaveImage "spinner2.png": End

    If kh = 43 Then stepper = stepper + 1

    If kh = 45 Then stepper = stepper - 1

    If kh = 27 Then System ' <<<<<<<<<<<<<<<<<<<<<<<< add line for escape

Wend