Graphics 1024,768,16,1
SetBuffer BackBuffer()
SeedRnd MilliSecs()

Type rak
Field x#,y#,xm#,ym#,f
End Type

Type parti
Field x#,y#,xm#,ym#,r,g,b
End Type

Global r.rak,p.parti
Global gx=GraphicsWidth(),gy=GraphicsHeight()
Global tr,img=CreateImage(gx,gy)

mx=MouseX()
my=MouseY()

timer=CreateTimer(24)
While GetMouse()=0 And MouseX()=mx And my=MouseY() And GetKey=0

If tr<MilliSecs()
tr=MilliSecs()+Rand(1000,5000)
crrak()
EndIf

uprak()
upparti()
gfx()
WaitTimer(timer)
Wend
End

Function crrak()
r=New rak
r\x=Rand(gx)
r\y=gy

r\f=Rand(-30,35)

rich=Rand(150,210)

speed=Rnd(15,35)

r\xm=Sin(rich)*speed
r\ym=Cos(rich)*speed
End Function

Function uprak()
For r=Each rak
r\f=r\f+1

r\x=r\x+r\xm
r\y=r\y+r\ym
r\ym=r\ym+.4

If r\x<0 Or r\x>gx r\xm=-r\xm
;If r\y<0 r\y=0 r\ym=0

r2# = Sqr(((r\xm)^2)+((r\ym)^2))
If r\ym<0
rich=360-ASin((r\xm)/r2)
Else
rich=180-ACos((r\xm)/r2)+90
EndIf

If r\f<40
crparti(1,rich,0)
Else
d=Rnd(1,10)
For x=1 To 200
crparti(2,rich,d)
Next
Delete r
EndIf

Next
End Function

Function crparti(x,ri,f)
p=New parti
p\x=r\x
p\y=r\y
If x=1
p\xm=Sin(ri+Rnd(-10,10))*20
p\ym=Cos(ri+Rnd(-10,10))*20
p\r=255
p\g=255
p\b=0
Else
power=Rand(30)
rich=Rand(360)
p\xm=r\xm+Sin(rich)*power
p\ym=r\ym+Cos(rich)*power
Select f
Case 1 p\r=255 p\g=255
Case 2 p\g=255
Case 3 p\r=255
Case 4 p\b=255
Case 5 p\r=255 p\b=255
Case 6 p\r=255 p\g=128
Case 7 p\g=255 p\b=255
End Select
If f>7 p\r=255 p\g=255 p\b=255
EndIf
End Function

Function upparti()
For p=Each parti

p\x=p\x+p\xm
p\y=p\y+p\ym
p\ym=p\ym+.5
p\xm=p\xm*.95
p\ym=p\ym*.95

If p\y<0 p\ym=Abs(p\ym) p\y=2


If p\b
p\b=p\b-10
If p\b<0 p\b=0
ElseIf p\g
p\g=p\g-10
If p\g<0 p\g=0
Else
p\r=p\r-10
If p\r<0 p\r=0
EndIf

Color p\r,p\g,p\b
Oval p\x-1,p\y-1,3,3

If p\r+p\g+p\b=0 Delete p
Next
End Function

Function gfx()
t=MilliSecs()

SetBuffer ImageBuffer(img)
Rect 0,0,gx,gy
SetBuffer BackBuffer()

CopyRect 0,0,gx,gy,0,0,BackBuffer(),ImageBuffer(img)
Flip
Cls
If img DrawImage img,0,6

End Function