click mousebutton (there is a different effect for left/right/middle)
Code: Select all
' Fireworks
' by stef
OPTION STATIC
OPTION EXPLICIT
CONST MAXPARTICLES=3600 '300;600;900;1500;3000; 6000; 12000;24000;48000
CONST SCREENW=800
CONST SCREENH=600
declare sub initparticles()
declare sub calcparticles()
declare sub drawparticles()
declare sub createcolours()
declare sub createstars()
declare sub drawstars()
dim shared grav as single =0.02
dim shared posx as integer
dim shared posy as integer
dim shared buttons as integer
dim shared col as integer
dim shared col_red as integer
dim shared col_green as integer
dim shared col_blue as integer=255
dim shared colfactor as integer =5 ' only: 1; 5; 15
dim shared counter as integer
dim shared mousestatus as integer
dim shared colourstatus as integer
type tstars
x as integer
y as integer
end type
type tparticles
x as single
y as single
dx as single
dy as single
size as integer
angle as single
speed as single
col as integer
end type
dim shared stars(100) as tstars
dim shared particle(MAXPARTICLES) as tparticles
SCREEN 19, 16, 2, 1
SCREENSET 1, 0
RANDOMIZE TIMER
Dim Im As Byte Ptr
Im = Imagecreate(SCREENW, SCREENH, RGB(5, 5, 5))
createstars()
DO
GETMOUSE posx, posy,, buttons
if buttons=0 then
'if not Bit(buttons, 0) THEN
mousestatus=0
endif
if mousestatus=0 then
IF Bit(buttons, 0) THEN
initparticles()
mousestatus=1
colourstatus=1
endif
IF Bit(buttons, 2) THEN
initparticles()
mousestatus=1
colourstatus=2
endif
IF Bit(buttons, 1) THEN
initparticles()
mousestatus=1
colourstatus=3
endif
endif
drawstars()
calcparticles()
drawparticles()
put (0,0),im,alpha,5
locate 1,1,0
print "click LM/RM/MM"
SCREENCOPY
LOOP UNTIL INKEY$=CHR$(27)
Imagedestroy Im
end
sub initparticles()
dim x as integer
for x= 0 to MAXPARTICLES
createcolours()
particle(x).col=rgb(col_red,col_green,col_blue)
particle(x).x=posx
particle(x).y=posy
particle(x).size=Rnd*3+1
particle(x).angle=(Rnd*360)*0.017453293
particle(x).speed=Rnd*5+0.1
particle(x).dx=sin(particle(x).angle)*particle(x).speed
particle(x).dy=cos(particle(x).angle)*particle(x).speed
next
end sub
sub calcparticles()
dim x as integer
if colourstatus= 1 then
createcolours()
col=rgb(col_red,col_green,col_blue)
endif
for x= 0 to MAXPARTICLES
if colourstatus= 2 then
createcolours()
col=rgb(col_red,col_green,col_blue)
particle(x).size=1
endif
if colourstatus<3 then
particle(x).col=col
endif
particle(x).x=particle(x).x+particle(x).dx
particle(x).y=particle(x).y+particle(x).dy
particle(x).dy=particle(x).dy+grav
next
end sub
sub drawparticles()
dim x as integer
for x= 0 to MAXPARTICLES
circle (particle(x).x,particle(x).y),particle(x).size,particle(x).col,,,,F
next
end sub
sub createcolours()
If col_red<255 And col_green =0 And col_blue =255 Then col_red=col_red+colfactor
If col_red=255 And col_green=0 And col_blue >0 Then col_blue=col_blue-colfactor
If col_red=255 And col_green < 255 And col_blue =0 Then col_green=col_green+colfactor
If col_red>0 And col_green = 255 And col_blue =0 Then col_red=col_red-colfactor
If col_red=0 And col_green = 255 And col_blue <255 Then col_blue=col_blue+colfactor
If col_red=0 And col_green >0 And col_blue =255 Then col_green=col_green-colfactor
end sub
sub drawstars()
dim c as integer
for counter =0 to 100
c=rnd*255
if c>127 then
circle (stars(counter).x,stars(counter).y),rnd*2,rgb(c,c,c),,,,F
endif
next
end sub
sub createstars()
dim c as integer
for counter =0 to 100
stars(counter).x=rnd*SCREENW
stars(counter).y=rnd*SCREENH
next
end sub