New Years Eve Fireworks!

[SierraKen]

I experimented a lot this afternoon and came up with this. 
Happy New Years!

Edit: This version doesn't have the fireworks sound and isn't as good as one in a zip file a couple replies down. 

Code: (Select All)

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

[bplus]

Here's my review:
https://qb64phoenix.com/forum/showthread...=fireworks

[eoredson]

Nice display!

Could add a Explosion.wav file to make firework sounds?

Erik.

[SierraKen]

Thanks for the idea Eoredson! I just found a fireworks mp3 and edited it a bit to fit my fireworks show. Here is the zip file with the .bas program and .mp3 file, put both in the same folder.

The zip file is: Ken's Firework Show 2024.zip

Edit: Adding trails, the zip will be on the next reply.

[SierraKen]

Here is the new and improved fireworks show. It has trails and they mostly go toward the direction of most of the explosions. I also changed the graphics a little bit to look a little better. 

Here is the zip file, named Ken's Firework Show 2024.zip

[DANILIN]

Experiment: your program inside topic


  feuer.bas (Size: 739 bytes / Downloads: 64)

Code: (Select All)

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

  2025.bas (Size: 3.14 KB / Downloads: 64)

Code: (Select All)

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

Include your program into collection

https://qb64phoenix.com/forum/showthread...8#pid30588

[SierraKen]

Awesome concept. I'm guessing it can't use mp3's so you used my first version.

[bplus]

I found some more! see here:
https://qb64phoenix.com/forum/showthread...5#pid30875

reply #6

[SierraKen]

Here is a much more realistic fireworks I just made. It has no sound on this one though, I figured to make it simple. B+ it looks a lot like yours, but I only used 4 lines of your code, the SIN, COS, PI, and RND lines. Yours was an inspiration for me, thank you! Mine only shoots one at a time. I hope you like it. Check out the differences between them.  

Edit: There's a better version I made on the next page of replies that has more sparks and a circular path instead of this square one.  

Code: (Select All)

'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

[bplus]

Yeah they look good! but curious why the burst looks square?