Type particle
Field x#
Field y#
Field ri
Field e
Field s#
Field r
Field g
Field b
Field fk#
Field gr#
End Type
SeedRnd(millisecs())

Type rocket
Field x#
Field y#
Field e
Field ri
End Type
gx = 800
gy = 600
Graphics gx,gy,16,2
SetBuffer FrontBuffer()
Timer = CreateTimer(60)

rocketvalue = 50
rocketemin = 20
rocketemax = 50
gravity# = 0.075
minparticle = 750
maxparticle = 1500

Year = Right$(CurrentDate(),4)

Local n$[4]
timefont = LoadFont("Arial",200,1)
bigfont = LoadFont("Arial", 75, 1)
Smallfont = LoadFont("Arial", 50, 1)
SetFont bigfont
n[0] = "Happy New Year " + (year+1)
n[1] = "Michael Stummvoll aka Smily0412"
n[2] = "wünscht jedem Computer-Freak,"
n[3] = "Programmierer und Blitzportal-User"
n[4] = "ein fröhliches neues Jahr"

Repeat
 Cls
 
 oldyear = Year
 year = Right$(CurrentDate(),4)
 If oldyear <> year Then
  showtext=1:rocketvalue=5
  For x = 0 To 10000
   particle.particle = New particle
   particle\x = 400
   particle\y = 300
   particle\ri = Rand(0,359)
   particle\e = 128
   particle\s = Rnd(0.0,6.0)
   particle\r = Rand(0,2)
   particle\g = Rand(0,2)
   particle\b = Rand(0,2)
   particle\gr = -2
  Next
 End if


 If Not (Rand(0,rocketvalue) Or KeyDown(57))
  rocket.rocket = New rocket
  rocket\x = Rand(0,800)
  rocket\y = 600
  rocket\ri = Rand(150,210)
  rocket\e = Rand(rocketemin,rocketemax)
 End If


 If nc < 255 And showtext nc = nc + 1
  If nc
   Color nc,nc,0
   For z = 0 To 4
    If z=0 Then SetFont bigfont
    If z=1 Then SetFont smallfont
    Text 400,130+z*60, n[z], 1, 1
   Next
  Else
  SetFont timefont
  Color 255,255,255
  Julian = JAD(currentdate())
  Julianend = JAD("31 Dec " + Year)
  ss=right(currenttime(),2)
  mm=mid$(currenttime(),4,2)
  hh=left(currenttime(),2)
  gess=hh*3600+mm*60+SS
;  Text 400,100, ,1,1
  Text 400,300, (Julianend-julian)*86400 + (86400-gess),1,1
 End if
 particles = 0
 LockBuffer BackBuffer()
 For particle.particle = Each particle
  rgb=1*$1000000 + (particle\e * particle\r)*$10000 + (particle\e * particle\g)*$100 + (particle\e * particle\b)
  rgb = rgb And $FFFFFF
  WritePixelFast particle\x, particle\y,rgb
  particle\e = particle\e - 2
  particle\x = particle\x + Sin(particle\ri) * particle\s + particle\fk
  particle\y = particle\y + Cos(particle\ri) * particle\s + particle\gr#
  particle\gr = particle\gr + gravity
  If particle\e < 0 Then Delete particle.particle
  particles=particles+1
 Next
 UnlockBuffer BackBuffer()
 Color 255,255,255
 Rockets = 0
 For Rocket.rocket = Each rocket
  Line rocket\x,rocket\y, rocket\x+Sin(rocket\ri)*10,rocket\y+Cos(rocket\ri)*10
  rocket\x = Rocket\x + Sin(rocket\ri)*10
  rocket\y = Rocket\y + Cos(rocket\ri)*10
  rocket\e = rocket\e - 1
  If rocket\e <= 0 Then
   Repeat
    r = Rand(0,2)
    g = Rand(0,2)
    b = Rand(0,2)
   Until (r or g Or b) > 2
   For x = 0 To Rand(minparticle, maxparticle)
    particle.particle = New particle
    particle\x = rocket\x
    particle\y = rocket\y
    particle\ri = Rand(0,359)
    particle\e = 128
    particle\s = Rnd(0.0,1.0)
    particle\r = r
    particle\g = g
    particle\b = b
    particle\gr = -2
    particle\fk = Sin(rocket\ri)*2
   Next
   Delete rocket.rocket
  End If
  rockets = rockets + 1
 Next
 t = WaitTimer(timer)
 Flip 0
Until KeyHit(1)

Function JAD(datum$)
  tag=Int(Left(datum$,2))
  Select Upper$(Mid$(datum$,4,3))
  Case "JAN":monat=1
  Case "FEB":monat=2
  Case "MAR":monat=3
  Case "APR":monat=4
  Case "MAY":monat=5
  Case "JUN":monat=6
  Case "JUL":monat=7
  Case "AUG":monat=8
  Case "SEP":monat=9
  Case "OCT":monat=10
  Case "NOV":monat=11
  Case "DEC":monat=12
  End Select
  jahr=Right$(datum$,4)
  If DatumPruefen(tag,monat,jahr)=1 Then
    Return ( 1461 * ( jahr + 4800 + ( monat - 14 ) / 12 ) ) / 4 + ( 367 * ( monat - 2 - 12 * ( ( monat - 14 ) / 12 ) ) ) / 12 - ( 3 * ( ( jahr + 4900 + ( monat - 14 ) / 12 ) / 100 ) ) / 4 + tag - 32075
  EndIf
End Function

Function DAJ$(tag)
  v1=tag+68569
  v2=(4*v1)/146097
  v1=v1-(146097*v2+3)/4
  v3=(4000*(v1+1))/1461001
  v1=v1-(1461*v3)/4+31
  v4=(80*v1)/2447
  v5=v4/11
  t=v1-(2447*v4)/80
  m=v4+2-(12*v5)
  j=100*(v2-49)+v3+v5
  Select m
  Case 1:monat$="Jan"
  Case 2:monat$="Feb"
  Case 3:monat$="Mar"
  Case 4:monat$="Apr"
  Case 5:monat$="May"
  Case 6:monat$="Jun"
  Case 7:monat$="Jul"
  Case 8:monat$="Aug"
  Case 9:monat$="Sep"
  Case 10:monat$="Oct"
  Case 11:monat$="Nov"
  Case 12:monat$="Dec"
  End Select
  If DatumPruefen(t,m,j)=1 Then
    Return Right$("0"+Str$(t),2)+" "+monat$+" "+Right$("0000"+Str$(j),4)
  EndIf
End Function


Function DatumPruefen(tag,monat,jahr)
  If jahr>1582 And jahr<4713 Then
    If monat>0 And monat<13 Then
      maxtage=TageImMonat(monat,jahr)
      If tag>0 And tag<maxtage+1 Then Return 1
    EndIf
  EndIf
End Function

Function TageImMonat(monat,jahr)
  If jahr<1583 Or jahr>4712 Then Return
  If monat<1 Or monat>12 Then Return
  If monat=1 Or monat=3 Or monat=5 Or monat=7 Or monat=8 Or monat=10 Or monat=12 Then Return 31
  If monat=2 Or monat=4 Or monat=6 Or monat=9 Or monat=11 Then Return 30
  If monat=2 Then
    tage=28
    If (jahr Mod 4)=0 Then tage=29
    If (jahr Mod 100)=0 Then tage=28
    If (jahr Mod 400)=0 Then tage=29
    Return tage
  EndIf
End Function