Bright Circle Colors

[SierraKen]

I know most of you have seen these colors before, as I have, but for some reason I haven't used them much myself yet. Today I found some color code from someone's post on FB and tried them out, using globe depth.  
Press the Space Bar to make different ones or Esc to quit.

Code: (Select All)

'Bright Circle Colors



Screen _NewImage(800, 600, 32)

Randomize Timer

_Title "Press the Space Bar to make different ones or Esc to quit."

Do

    For circles = 1 To 10

        x = Rnd * 800: y = Rnd * 600: sz = .1

        For s = sz + Rnd * 200 To sz Step -.1

            Circle (x, y), s, _RGB32(&H8B, &H5C - s, &HF6)

        Next s



        x = Rnd * 800: y = Rnd * 600: sz = .1

        For s = sz + Rnd * 200 To sz Step -.1

            Circle (x, y), s, _RGB32(&HEC, &H48 - s, &H99)

        Next s



        x = Rnd * 800: y = Rnd * 600: sz = .1

        For s = sz + Rnd * 200 To sz Step -.1

            Circle (x, y), s, _RGB32(&H10, &HB9 - s, &H81)

        Next s



        x = Rnd * 800: y = Rnd * 600: sz = .1

        For s = sz + Rnd * 200 To sz Step -.1

            Circle (x, y), s, _RGB32(&H60, &HA5 - s, &HFA)

        Next s

    Next circles

    Do: a$ = InKey$

        If a$ = Chr$(27) Then End

    Loop Until a$ = " "

    Cls

Loop

[DANILIN]

Fly since 1978

Code: (Select All)

    For circles = 1 To 1000
        Print " " ' DANILIN
...
... Step -.5
...
_Delay .2: Next circles

is it seen?

Code: (Select All)

[qbjs]https://qbjs.org/?mode=auto&src=https://qb64phoenix.com/forum/attachment.php?aid=4691[/qbjs]

[bplus]

My very first proggie posted here:

Code: (Select All)

_Title "Light up your balls" 'b+ 2022-04-24

Screen _NewImage(800, 600, 32)

_ScreenMove 300, 40

Randomize Timer

balls = 25

Dim r(balls), x(balls), y(balls), c~&(balls)

For i = 1 To balls

    r(i) = Rnd * 80 + 15

    x(i) = Rnd * _Width

    y(i) = Rnd * _Height

    c~&(i) = _RGB32(Rnd * 100, Rnd * 100, Rnd * 100)

Next

For f## = 0 To 1 Step .01

    Cls

    For b = 0 To balls

        rr = _Red32(c~&(b)): gg = _Green32(c~&(b)): bb = _Blue32(c~&(b))

        m~& = midInk~&(rr, gg, bb, 255, 255, 255, f##)

        drawBall x(b), y(b), r(b), m~&

    Next

    Print f##

    _Display

    _Limit 10

Next



Function midInk~& (r1%, g1%, b1%, r2%, g2%, b2%, fr##)

    midInk~& = _RGB32(r1% + (r2% - r1%) * fr##, g1% + (g2% - g1%) * fr##, b1% + (b2% - b1%) * fr##)

End Function



Sub drawBall (x, y, r, c As _Unsigned Long)

    Dim rred As Long, grn As Long, blu As Long, rr As Long, f

    rred = _Red32(c): grn = _Green32(c): blu = _Blue32(c)

    For rr = r To 0 Step -1

        f = .5 * (1 - rr / r) + .5

        fcirc x, y, rr, _RGB32(rred * f, grn * f, blu * f)

    Next

End Sub



'from Steve Gold standard

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

    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 Sub

Ah the memories

[SierraKen]

Pretty cool guys!

[DANILIN]

Make it 3D

Code: (Select All)

Screen 12 ' krugi.bas  DANILIN

c1 = 4: c2 = 1: s = 5: r = 78

d = 2 * r: x = 100 + d

For k = 1 To 10

    For i = 1 To d Step s: Cls

        For j = r To 22 Step -.3

            Circle (x - r + i, 100 + r), j, c1

        Next

        For j = r To 22 Step -.3

            Circle (x + r - i, 100 + r), j, c2

    Next: _Display: _Delay .02: Next

Swap c1, c2: Next

Code: (Select All)

[qbjs]https://qbjs.org/?mode=auto&src=https://qb64phoenix.com/forum/attachment.php?aid=4701[/qbjs]