mirror of
https://github.com/FellippeHeitor/InForm.git
synced 2025-01-15 11:59:34 +00:00
425 lines
13 KiB
QBasic
425 lines
13 KiB
QBasic
|
': This program uses
|
||
|
|
': InForm - GUI library for QB64 - v1.0
|
||
|
|
': Fellippe Heitor, 2016-2019 - fellippe@qb64.org - @fellippeheitor
|
||
|
|
': https://github.com/FellippeHeitor/InForm
|
||
|
|
'-----------------------------------------------------------
|
||
|
|
|
||
|
|
'Improved fireworks:
|
||
|
|
' - Particles now leave a trail behind
|
||
|
|
' - Round explosions (sin/cos been used...)
|
||
|
|
' - Explosion sound effect.
|
||
|
|
|
||
|
|
OPTION _EXPLICIT
|
||
|
|
|
||
|
|
TYPE Vector
|
||
|
|
x AS SINGLE
|
||
|
|
y AS SINGLE
|
||
|
|
END TYPE
|
||
|
|
|
||
|
|
TYPE Particle
|
||
|
|
Pos AS Vector
|
||
|
|
Vel AS Vector
|
||
|
|
Acc AS Vector
|
||
|
|
Visible AS _BYTE
|
||
|
|
Exploded AS _BYTE
|
||
|
|
ExplosionStep AS _BYTE
|
||
|
|
ExplosionMax AS _BYTE
|
||
|
|
Color AS _UNSIGNED LONG
|
||
|
|
Size AS _BYTE
|
||
|
|
END TYPE
|
||
|
|
|
||
|
|
REDIM SHARED Firework(1 TO 1) AS Particle
|
||
|
|
REDIM SHARED Boom(1 TO UBOUND(Firework) * 2, 1) AS Particle
|
||
|
|
DIM SHARED Trail(1 TO 20000) AS Particle
|
||
|
|
|
||
|
|
DIM SHARED StartPointLimit AS SINGLE, InitialVel AS SINGLE
|
||
|
|
DIM SHARED Gravity AS Vector, Pause AS _BYTE, distant AS LONG
|
||
|
|
|
||
|
|
InitialVel = -30
|
||
|
|
Gravity.y = .8
|
||
|
|
distant = _SNDOPEN("distant.wav")
|
||
|
|
|
||
|
|
RANDOMIZE TIMER
|
||
|
|
|
||
|
|
': Controls' IDs: ------------------------------------------------------------------
|
||
|
|
DIM SHARED BabyYoureAFirework AS LONG
|
||
|
|
DIM SHARED Canvas AS LONG
|
||
|
|
DIM SHARED MaxFireworksLB AS LONG
|
||
|
|
DIM SHARED MaxFireworksTrackBar AS LONG
|
||
|
|
DIM SHARED MaxParticlesLB AS LONG
|
||
|
|
DIM SHARED MaxParticlesTrackBar AS LONG
|
||
|
|
DIM SHARED ShowTextCB AS LONG
|
||
|
|
DIM SHARED YourTextHereTB AS LONG
|
||
|
|
DIM SHARED HappyNewYearLB AS LONG
|
||
|
|
|
||
|
|
': External modules: ---------------------------------------------------------------
|
||
|
|
'$INCLUDE:'../../InForm/InForm.bi'
|
||
|
|
'$INCLUDE:'Fireworks.frm'
|
||
|
|
|
||
|
|
': Event procedures: ---------------------------------------------------------------
|
||
|
|
SUB __UI_BeforeInit
|
||
|
|
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_OnLoad
|
||
|
|
_TITLE "Baby, you're a firework"
|
||
|
|
StartPointLimit = Control(Canvas).Height / 3
|
||
|
|
Control(MaxFireworksTrackBar).Value = 20
|
||
|
|
Control(MaxParticlesTrackBar).Value = 150
|
||
|
|
ToolTip(MaxFireworksTrackBar) = "20"
|
||
|
|
ToolTip(MaxParticlesTrackBar) = "150"
|
||
|
|
REDIM _PRESERVE Firework(1 TO Control(MaxFireworksTrackBar).Value) AS Particle
|
||
|
|
REDIM _PRESERVE Boom(1 TO UBOUND(Firework) * 2, Control(MaxParticlesTrackBar).Value) AS Particle
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_BeforeUpdateDisplay
|
||
|
|
STATIC JustExploded AS _BYTE
|
||
|
|
STATIC t AS INTEGER, Initial AS _BYTE, InitialX AS INTEGER, lastInitial#
|
||
|
|
|
||
|
|
DIM AS LONG j, i, a
|
||
|
|
DIM AS _UNSIGNED LONG thisColor
|
||
|
|
|
||
|
|
_DEST Control(Canvas).HelperCanvas
|
||
|
|
|
||
|
|
IF JustExploded THEN
|
||
|
|
JustExploded = False
|
||
|
|
CLS , _RGB32(0, 0, 50)
|
||
|
|
ELSE
|
||
|
|
CLS
|
||
|
|
END IF
|
||
|
|
IF _CEIL(RND * 20) < 2 OR (Initial = False AND TIMER - lastInitial# > .1) THEN
|
||
|
|
'Create a new particle
|
||
|
|
FOR j = 1 TO UBOUND(Firework)
|
||
|
|
IF Firework(j).Visible = False THEN
|
||
|
|
Firework(j).Vel.y = InitialVel
|
||
|
|
Firework(j).Vel.x = 3 - _CEIL(RND * 6)
|
||
|
|
IF Initial = True THEN
|
||
|
|
Firework(j).Pos.x = _CEIL(RND * Control(Canvas).Width)
|
||
|
|
ELSE
|
||
|
|
Firework(j).Pos.x = InitialX * (Control(Canvas).Width / 15)
|
||
|
|
InitialX = InitialX + 1
|
||
|
|
lastInitial# = TIMER
|
||
|
|
IF InitialX > 15 THEN Initial = True
|
||
|
|
END IF
|
||
|
|
Firework(j).Pos.y = Control(Canvas).Height + _CEIL(RND * StartPointLimit)
|
||
|
|
Firework(j).Visible = True
|
||
|
|
Firework(j).Exploded = False
|
||
|
|
Firework(j).ExplosionStep = 0
|
||
|
|
Firework(j).Size = _CEIL(RND * 2)
|
||
|
|
IF Firework(j).Size = 1 THEN
|
||
|
|
Firework(j).ExplosionMax = 9 + _CEIL(RND * 41)
|
||
|
|
ELSE
|
||
|
|
Firework(j).ExplosionMax = 9 + _CEIL(RND * 71)
|
||
|
|
END IF
|
||
|
|
Firework(j).ExplosionMax = 20 '0
|
||
|
|
EXIT FOR
|
||
|
|
END IF
|
||
|
|
NEXT j
|
||
|
|
END IF
|
||
|
|
|
||
|
|
'Show trail
|
||
|
|
FOR i = 1 TO UBOUND(Trail)
|
||
|
|
IF NOT Pause THEN Trail(i).Color = Darken(Trail(i).Color, 70)
|
||
|
|
IF Trail(i).Size = 1 THEN
|
||
|
|
PSET (Trail(i).Pos.x, Trail(i).Pos.y), Trail(i).Color
|
||
|
|
ELSE
|
||
|
|
PSET (Trail(i).Pos.x, Trail(i).Pos.y), Trail(i).Color
|
||
|
|
PSET (Trail(i).Pos.x - 1, Trail(i).Pos.y), Trail(i).Color
|
||
|
|
PSET (Trail(i).Pos.x + 1, Trail(i).Pos.y), Trail(i).Color
|
||
|
|
PSET (Trail(i).Pos.x, Trail(i).Pos.y - 1), Trail(i).Color
|
||
|
|
PSET (Trail(i).Pos.x, Trail(i).Pos.y + 1), Trail(i).Color
|
||
|
|
END IF
|
||
|
|
NEXT i
|
||
|
|
|
||
|
|
'Update and show particles
|
||
|
|
FOR i = 1 TO UBOUND(Firework)
|
||
|
|
'Update trail particles
|
||
|
|
|
||
|
|
IF Firework(i).Visible = True AND Firework(i).Exploded = False AND NOT Pause THEN
|
||
|
|
t = t + 1: IF t > UBOUND(Trail) THEN t = 1
|
||
|
|
Trail(t).Pos.x = Firework(i).Pos.x
|
||
|
|
Trail(t).Pos.y = Firework(i).Pos.y
|
||
|
|
Trail(t).Color = _RGB32(255, 255, 255)
|
||
|
|
|
||
|
|
'New position
|
||
|
|
Firework(i).Vel.y = Firework(i).Vel.y + Gravity.y
|
||
|
|
Firework(i).Pos.y = Firework(i).Pos.y + Firework(i).Vel.y
|
||
|
|
Firework(i).Pos.x = Firework(i).Pos.x + Firework(i).Vel.x
|
||
|
|
END IF
|
||
|
|
|
||
|
|
'Explode the particle if it reaches max height
|
||
|
|
IF Firework(i).Vel.y > 0 THEN
|
||
|
|
IF Firework(i).Exploded = False THEN
|
||
|
|
Firework(i).Exploded = True
|
||
|
|
JustExploded = True
|
||
|
|
|
||
|
|
IF Firework(1).Size = 1 THEN
|
||
|
|
IF distant THEN _SNDPLAYCOPY distant, .5
|
||
|
|
ELSE
|
||
|
|
IF distant THEN _SNDPLAYCOPY distant, 1
|
||
|
|
END IF
|
||
|
|
|
||
|
|
thisColor~& = _RGB32(_CEIL(RND * 255), _CEIL(RND * 255), _CEIL(RND * 255))
|
||
|
|
a = 0
|
||
|
|
FOR j = 1 TO UBOUND(Boom, 2)
|
||
|
|
Boom(i, j).Pos.x = Firework(i).Pos.x
|
||
|
|
Boom(i, j).Pos.y = Firework(i).Pos.y
|
||
|
|
Boom(i, j).Vel.y = SIN(a) * (RND * 10)
|
||
|
|
Boom(i, j).Vel.x = COS(a) * (RND * 10)
|
||
|
|
a = a + 1
|
||
|
|
Boom(i, j).Color = thisColor~&
|
||
|
|
|
||
|
|
Boom(i * 2, j).Pos.x = Firework(i).Pos.x + 5
|
||
|
|
Boom(i * 2, j).Pos.y = Firework(i).Pos.y + 5
|
||
|
|
Boom(i * 2, j).Vel.y = Boom(i, j).Vel.y
|
||
|
|
Boom(i * 2, j).Vel.x = Boom(i, j).Vel.x
|
||
|
|
a = a + 1
|
||
|
|
Boom(i * 2, j).Color = thisColor~&
|
||
|
|
NEXT
|
||
|
|
END IF
|
||
|
|
END IF
|
||
|
|
|
||
|
|
'Show particle
|
||
|
|
IF Firework(i).Exploded = False THEN
|
||
|
|
IF Firework(i).Size = 1 THEN
|
||
|
|
PSET (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255)
|
||
|
|
ELSE
|
||
|
|
PSET (Firework(i).Pos.x, Firework(i).Pos.y), _RGB32(255, 255, 255)
|
||
|
|
PSET (Firework(i).Pos.x - 1, Firework(i).Pos.y), _RGB32(255, 255, 255)
|
||
|
|
PSET (Firework(i).Pos.x + 1, Firework(i).Pos.y), _RGB32(255, 255, 255)
|
||
|
|
PSET (Firework(i).Pos.x, Firework(i).Pos.y - 1), _RGB32(255, 255, 255)
|
||
|
|
PSET (Firework(i).Pos.x, Firework(i).Pos.y + 1), _RGB32(255, 255, 255)
|
||
|
|
END IF
|
||
|
|
ELSEIF Firework(i).Visible THEN
|
||
|
|
IF NOT Pause THEN Firework(i).ExplosionStep = Firework(i).ExplosionStep + 1
|
||
|
|
FOR j = 1 TO UBOUND(Boom, 2)
|
||
|
|
IF Firework(i).Size = 1 THEN
|
||
|
|
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y), Boom(i, j).Color
|
||
|
|
ELSE
|
||
|
|
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||
|
|
PSET (Boom(i, j).Pos.x - 1, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||
|
|
PSET (Boom(i, j).Pos.x + 1, Boom(i, j).Pos.y), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||
|
|
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y - 1), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||
|
|
PSET (Boom(i, j).Pos.x, Boom(i, j).Pos.y + 1), Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||
|
|
END IF
|
||
|
|
IF NOT Pause THEN
|
||
|
|
t = t + 1: IF t > UBOUND(Trail) THEN t = 1
|
||
|
|
Trail(t).Pos.x = Boom(i, j).Pos.x
|
||
|
|
Trail(t).Pos.y = Boom(i, j).Pos.y
|
||
|
|
Trail(t).Size = Boom(i, j).Size
|
||
|
|
Trail(t).Color = Darken(Boom(i, j).Color, 100 - (Firework(i).ExplosionStep * 100) / Firework(i).ExplosionMax)
|
||
|
|
|
||
|
|
t = t + 1: IF t > UBOUND(Trail) THEN t = 1
|
||
|
|
Trail(t).Pos.x = Boom(i * 2, j).Pos.x
|
||
|
|
Trail(t).Pos.y = Boom(i * 2, j).Pos.y
|
||
|
|
Trail(t).Size = Boom(i * 2, j).Size
|
||
|
|
Trail(t).Color = Darken(Boom(i * 2, j).Color, 150)
|
||
|
|
|
||
|
|
Boom(i, j).Vel.y = Boom(i, j).Vel.y + Gravity.y / 10
|
||
|
|
Boom(i, j).Pos.x = Boom(i, j).Pos.x + Boom(i, j).Vel.x '+ Firework(i).Vel.x
|
||
|
|
Boom(i, j).Pos.y = Boom(i, j).Pos.y + Boom(i, j).Vel.y
|
||
|
|
Boom(i * 2, j).Vel.y = Boom(i * 2, j).Vel.y + Gravity.y / 10
|
||
|
|
Boom(i * 2, j).Pos.x = Boom(i * 2, j).Pos.x + Boom(i * 2, j).Vel.x '+ Firework(i).Vel.x
|
||
|
|
Boom(i * 2, j).Pos.y = Boom(i * 2, j).Pos.y + Boom(i * 2, j).Vel.y
|
||
|
|
END IF
|
||
|
|
NEXT
|
||
|
|
IF Firework(i).ExplosionStep > Firework(i).ExplosionMax THEN Firework(i).Visible = False
|
||
|
|
END IF
|
||
|
|
NEXT
|
||
|
|
|
||
|
|
Control(HappyNewYearLB).Hidden = NOT Control(ShowTextCB).Value
|
||
|
|
|
||
|
|
_DEST 0
|
||
|
|
Control(Canvas).PreviousValue = 0
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_BeforeUnload
|
||
|
|
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_Click (id AS LONG)
|
||
|
|
SELECT CASE id
|
||
|
|
CASE BabyYoureAFirework
|
||
|
|
|
||
|
|
CASE Canvas
|
||
|
|
Pause = NOT Pause
|
||
|
|
IF Pause THEN
|
||
|
|
Caption(HappyNewYearLB) = "PAUSED"
|
||
|
|
ELSE
|
||
|
|
Caption(HappyNewYearLB) = Text(YourTextHereTB)
|
||
|
|
END IF
|
||
|
|
CASE MaxFireworksLB
|
||
|
|
|
||
|
|
CASE MaxFireworksTrackBar
|
||
|
|
|
||
|
|
CASE MaxParticlesLB
|
||
|
|
|
||
|
|
CASE MaxParticlesTrackBar
|
||
|
|
|
||
|
|
CASE ShowTextCB
|
||
|
|
|
||
|
|
CASE YourTextHereTB
|
||
|
|
|
||
|
|
CASE HappyNewYearLB
|
||
|
|
|
||
|
|
END SELECT
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_MouseEnter (id AS LONG)
|
||
|
|
SELECT CASE id
|
||
|
|
CASE BabyYoureAFirework
|
||
|
|
|
||
|
|
CASE Canvas
|
||
|
|
|
||
|
|
CASE MaxFireworksLB
|
||
|
|
|
||
|
|
CASE MaxFireworksTrackBar
|
||
|
|
|
||
|
|
CASE MaxParticlesLB
|
||
|
|
|
||
|
|
CASE MaxParticlesTrackBar
|
||
|
|
|
||
|
|
CASE ShowTextCB
|
||
|
|
|
||
|
|
CASE YourTextHereTB
|
||
|
|
|
||
|
|
CASE HappyNewYearLB
|
||
|
|
|
||
|
|
END SELECT
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_MouseLeave (id AS LONG)
|
||
|
|
SELECT CASE id
|
||
|
|
CASE BabyYoureAFirework
|
||
|
|
|
||
|
|
CASE Canvas
|
||
|
|
|
||
|
|
CASE MaxFireworksLB
|
||
|
|
|
||
|
|
CASE MaxFireworksTrackBar
|
||
|
|
|
||
|
|
CASE MaxParticlesLB
|
||
|
|
|
||
|
|
CASE MaxParticlesTrackBar
|
||
|
|
|
||
|
|
CASE ShowTextCB
|
||
|
|
|
||
|
|
CASE YourTextHereTB
|
||
|
|
|
||
|
|
CASE HappyNewYearLB
|
||
|
|
|
||
|
|
END SELECT
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_FocusIn (id AS LONG)
|
||
|
|
SELECT CASE id
|
||
|
|
CASE MaxFireworksTrackBar
|
||
|
|
|
||
|
|
CASE MaxParticlesTrackBar
|
||
|
|
|
||
|
|
CASE ShowTextCB
|
||
|
|
|
||
|
|
CASE YourTextHereTB
|
||
|
|
|
||
|
|
END SELECT
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_FocusOut (id AS LONG)
|
||
|
|
SELECT CASE id
|
||
|
|
CASE MaxFireworksTrackBar
|
||
|
|
|
||
|
|
CASE MaxParticlesTrackBar
|
||
|
|
|
||
|
|
CASE ShowTextCB
|
||
|
|
|
||
|
|
CASE YourTextHereTB
|
||
|
|
|
||
|
|
END SELECT
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_MouseDown (id AS LONG)
|
||
|
|
SELECT CASE id
|
||
|
|
CASE BabyYoureAFirework
|
||
|
|
|
||
|
|
CASE Canvas
|
||
|
|
|
||
|
|
CASE MaxFireworksLB
|
||
|
|
|
||
|
|
CASE MaxFireworksTrackBar
|
||
|
|
|
||
|
|
CASE MaxParticlesLB
|
||
|
|
|
||
|
|
CASE MaxParticlesTrackBar
|
||
|
|
|
||
|
|
CASE ShowTextCB
|
||
|
|
|
||
|
|
CASE YourTextHereTB
|
||
|
|
|
||
|
|
CASE HappyNewYearLB
|
||
|
|
|
||
|
|
END SELECT
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_MouseUp (id AS LONG)
|
||
|
|
SELECT CASE id
|
||
|
|
CASE BabyYoureAFirework
|
||
|
|
|
||
|
|
CASE Canvas
|
||
|
|
|
||
|
|
CASE MaxFireworksLB
|
||
|
|
|
||
|
|
CASE MaxFireworksTrackBar
|
||
|
|
|
||
|
|
CASE MaxParticlesLB
|
||
|
|
|
||
|
|
CASE MaxParticlesTrackBar
|
||
|
|
|
||
|
|
CASE ShowTextCB
|
||
|
|
|
||
|
|
CASE YourTextHereTB
|
||
|
|
|
||
|
|
CASE HappyNewYearLB
|
||
|
|
|
||
|
|
END SELECT
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_KeyPress (id AS LONG)
|
||
|
|
SELECT CASE id
|
||
|
|
CASE MaxFireworksTrackBar
|
||
|
|
|
||
|
|
CASE MaxParticlesTrackBar
|
||
|
|
|
||
|
|
CASE ShowTextCB
|
||
|
|
|
||
|
|
CASE YourTextHereTB
|
||
|
|
|
||
|
|
END SELECT
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_TextChanged (id AS LONG)
|
||
|
|
SELECT CASE id
|
||
|
|
CASE YourTextHereTB
|
||
|
|
Caption(HappyNewYearLB) = Text(YourTextHereTB)
|
||
|
|
END SELECT
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_ValueChanged (id AS LONG)
|
||
|
|
Control(id).Value = INT(Control(id).Value)
|
||
|
|
SELECT CASE id
|
||
|
|
CASE ShowTextCB
|
||
|
|
|
||
|
|
CASE MaxFireworksTrackBar
|
||
|
|
REDIM _PRESERVE Firework(1 TO Control(MaxFireworksTrackBar).Value) AS Particle
|
||
|
|
ToolTip(id) = STR$(Control(MaxFireworksTrackBar).Value)
|
||
|
|
CASE MaxParticlesTrackBar
|
||
|
|
REDIM _PRESERVE Boom(1 TO UBOUND(Firework) * 2, Control(MaxParticlesTrackBar).Value) AS Particle
|
||
|
|
ToolTip(id) = STR$(Control(MaxParticlesTrackBar).Value)
|
||
|
|
END SELECT
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
SUB __UI_FormResized
|
||
|
|
END SUB
|
||
|
|
|
||
|
|
'$INCLUDE:'../../InForm/InForm.ui'
|
||
|
|
'$INCLUDE:'../../InForm/xp.uitheme'
|