Screen _NewImage(800, 600, 32)



oldstart = 0

pi = _Pi

oldx = 0

oldy = 0

ch = 15

_Title "SierraKen's Fireworks Show!"

Randomize Timer

Do

    For changes = 1 To ch

        r = Rnd * 255

        g = Rnd * 255

        b = Rnd * 255

        For d = 200 To Rnd * 200 Step -.02

            s = s + (Rnd + 10)

            x = Cos(s * pi / 180) * d

            y = Sin(s * pi / 180) * d

            For sz = .1 To 1 Step .1

                Circle (x + oldx + 400, y + oldy + 300), sz, _RGB32(r, g, b)

            Next sz

        Next d

        oldx = x

        oldy = y

        Sound 1000, .2

        _Delay .1

        Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 15), BF

    Next changes

    For t = 1 To 8

        Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 50), BF

        _Delay .2

    Next t

    _Delay Rnd * 1.2

    a = a + 1

    If a = 30 Then

        ch = 200

        s = 2

    End If

    If a = 31 Then End

    Cls

Loop Until InKey$ <> ""

'Fireworks 2 by SierraKen



'Thanks B+ for the inspiration.



Screen _NewImage(800, 600, 32)

Dim x(200), y(200), xx(200), yy(200)

Dim centerx(200), centery(200)

Dim c(200)



_Title "Fireworks"



GoSub more



Randomize Timer

Do

    ce = ce + 1

    If ce > 100 Then ce = 1

    centerx(ce) = (Rnd * 400) + 200

    centery(ce) = (Rnd * 300) + 200

    red = (Rnd * 200) + 55: green = (Rnd * 200) + 55: blue = (Rnd * 200) + 55

    If red > green And red > blue And red < 200 Then red = 255

    If green > red And green > blue And green < 200 Then green = 255

    If blue > red And blue > green And blue < 200 Then blue = 255



    c(ce) = _RGB32(red, green, blue)



    GoSub trajectile



    For b = 1 To 400

        For e = 1 To 100

            x(e) = x(e) + xx(e)

            y(e) = y(e) + yy(e)

            cx = x(e) + centerx(ce)

            cy = y(e) + centery(ce)

            fillCircle cx, cy, 2, c(ce)

        Next e

        _Delay .005

        Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF

    Next b

    t = 1

    GoSub more

Loop Until InKey$ = Chr$(27)

End



more:

For t = 1 To 100

    r = Rnd * 8

    a = Rnd * _Pi(2)

    x(t) = r * Cos(a)

    y(t) = r * Sin(a)

    xx(t) = (Rnd * 2) - 1

    yy(t) = (Rnd * 2) - 1

Next t

Return



trajectile:

For ty = 600 To centery(ce) Step -1

    fillCircle centerx(ce), ty, 2, _RGB32(255, 255, 255)

    _Delay .002

    Line (0, 0)-(800, 600), _RGB32(0, 0, 0, 10), BF

Next ty

Return



'from Steve Gold standard

Sub fillCircle (CX As Integer, CY As Integer, R As Integer, C As _Unsigned Long)

    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