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: 155)

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: 162)

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?