Sorry your browser is not supported!

Type tDMode
   hWnd,hDc,Width,Height,Depth as dWord
EndType
Global Display as tDMode
Get_Desktop()
While inkey$()="" and MouseClick()=0 :Sync:EndWhile
End
Function Get_Desktop()
  ` Disable Escapekey
  ` Disable SystemKeys`
   Hide Window : Sync : Wait 100
   Load Dll "User32.dll",1
   Load Dll "Gdi32.dll",2
   Display.hWnd   = Call dll(1,"GetDesktopWindow")
   Display.Width  = Call dll(1,"GetSystemMetrics",0)
   Display.Height = Call dll(1,"GetSystemMetrics",1)
   Display.hDc    = Call dll(1,"GetDC",0)
   Display.Depth  = Call dll(2,"GetDeviceCaps",Display.hDc,12)
   Set Display Mode Display.Width,Display.Height,Display.Depth,1
   Color Backdrop RGB(0,0,128)
   Sync rate 0 : Sync On : Sync : Lock Pixels
   For Y=0 to Display.Height-1
      For X=0 to Display.Width-1
         F#=Frost((X*1.)/(Display.Width*1.),(Y*1.)/(Display.Height*1.))
         C=Call Dll(2,"GetPixel",Display.hDc,X,Y)
         R=RGBB(C):R=R+((255-R)*F#):If R>255 then R=255
         G=RGBG(C):G=G+((255-G)*F#):If G>255 then G=255
         B=RGBR(C):B=B+((255-B)*F#):If B>255 then B=255
         Dot X,Y,RGB(R,G,B)
      Next
   Next
   Unlock Pixels : Sync
   Crystalize() : Sync
   Message() : Sync
`   Ink 0,0 : Text 1,1,Str$( Display.Width)+" "+Str$(Display.Height)+" "+Str$(Display.Depth)
`   Ink RGB(255,255,255),0 : Text 0,0,Str$( Display.Width)+" "+Str$(Display.Height)+" "+Str$(Display.Depth)
   Call dll 1,"ReleaseDC",0,Display.hDc
   Delete dll 2
   Delete dll 1
   Enable Escapekey
   Enable SystemKeys
   Show Window
EndFunction

Function Frost(X#,Y#)
   X# = (X#-.5)*100.0 : Y# = (Y#-.5)*100.0
   Angle# = ATANFULL(X#,Y#) ` 0 - 360
   M#=Sqrt((50^2)*2)
   Lenth# = Sqrt((X#*X#)+(Y#*Y#)):if Lenth#>100.0 then Lenth#=100.0
   F#=(Sin(90.0*(Lenth#/M#))*.8)+(Rnd(20)/100.0)
   If F#>1.0 then F#=1.0
 EndFunction F#

Function Crystalize()
   For I=1 to 200
      Randomize Timer()
      A = RND(7)*15        ` Angles 0 to 90 in 15 degree steps
      L = RND(75)+ 125     ` Length of Crystal 125 to 200
      W = 5+Rnd(15)        ` Width of Crystal 5 to 20
      `Get Start position For Crystal
      NewChrystal:
      X1 = 10+Rnd(Display.Width-20) :X2=X1+(Cos(A)*L)
      Y1 = 10+Rnd(Display.Height-20):Y2=Y1+(Sin(A)*L)
      Ch=0
      `Check End Position is within Screen and rotate 45 if not
      While (X2<=10) or (X2=>Display.Width-20) or (Y2<=10) Or (Y2=>Display.Height-20)
         A=WrapValue(A+45)
         X2=X1+(Cos(A)*L) :Y2=Y1+(Sin(A)*L)
         inc ch : if ch >8 then goto NewChrystal
      EndWhile
      `Calculate Offset steps
      XD=Abs(X1-X2): YD=Abs(Y1-Y2)
      XO=Int(Cos(A)*2):XO=Norm(XO): OX=Int(Cos(A-90)*2):OX=Norm(OX)
      YO=Int(Sin(A)*2):YO=Norm(YO): OY=Int(Sin(A-90)*2):OY=Norm(OY)
      `Find Longest Axis and step through each pixel
      IF XD>YD then L=XD else L=YD
      For J=0 to L  `Perform Length
      For OW=0 to W ` Perform Width
         `Get Start Pixel color
         PX=X1+int(XD*(J*1.0)/(L*1.0))+(OX*OW)
         PY=Y1+int(YD*(J*1.0)/(L*1.0))+(OY*OW)
         PC=Point(PX,PY)
         `Get Offset Pixel color
         QX=X1+XO
         QY=Y1+YO
         QC=Point(QX,QY)
         `Get Original Pixel color
         OC=Call Dll(2,"GetPixel",Display.hDc,PX,PY)
         `Calculate new color
         R=(((RGBR(PC)*1.50)+(RGBR(QC)*0.45)+(RGBB(OC)*0.05))/2)
         G=(((RGBG(PC)*1.50)+(RGBG(QC)*0.45)+(RGBG(OC)*0.05))/2)
         B=(((RGBB(PC)*1.50)+(RGBB(QC)*0.45)+(RGBR(OC)*0.05))/2)
         `Update Image
         Dot PX,PY,RGB(R,G,B)
      Next
      Next
   Next
EndFunction
Function Norm(I)
   If I>0 then I= 1
   If I<0 then I=-1
EndFunction I

Function Message()
   Perform Checklist For Fonts
   Size=Text Size():Set Text Size 72 : Set Text to Bold
   T$="Merry Christmas." : BW=Text Width(T$) : BH=Text Height(T$)*1.1
   Create Bitmap 1,BW,BH : Set Current Bitmap 1
   Text 0,0,T$ : OH=BH*.5
   For b=0 to 3 : Blur bitmap 1,3 : next
   For X=0 to BW
      PX = (Display.Width*.5)+(X-(BW*.5))
      O=(Display.Height*.25)-(Sin(360.0*(X/(BW*1.)))*OH)
      For Y=0 to BH
         PY=Y+O
         Set Current Bitmap 1
         MC=Point(X,Y)
         If MC<>RGB(0,0,0)
            Set Current Bitmap 0
            OC=Call Dll(2,"GetPixel",Display.hDc,PX,PY)
            PC=Point(PX,PY)
            P2# =(RGBB(MC)/255.0)*.4 : P1#=1.0 - P2#
            `
            R=(RGBR(PC)*P1#)+(RGBB(OC)*P2#)
            G=(RGBG(PC)*P1#)+(RGBG(OC)*P2#)
            B=(RGBB(PC)*P1#)+(RGBR(OC)*P2#)
            Dot PX,PY,RGB(R,G,B)
         EndIf
      Next
   Next
   Set Current Bitmap 0 :   Delete Bitmap 1
   Set Text Size Size : Set Text To Normal
EndFunction

Sync On
Sync Rate 20
Autocam off
Move Camera -300
Type oRot
x as float
y as float
z as float
Endtype
Make Object Sphere 1,5,3,3
Color Object 1,RGB(0,0,29)
Set Reflection Shading On 1
Lock Vertexdata For Limb 1,0
Set Vertexdata Position 0,0,2.5,0
Set Vertexdata Position 1,0,2.5,0
Set Vertexdata Position 2,0,2.5,0
Set Vertexdata Position 3,0,2.5,0
Set Vertexdata Position 4,-1,7.25,2.16506361961
Set Vertexdata Position 5,1.875,1.24999988079,-1.08253192902
Set Vertexdata Position 6,-1.87500011921,1.24999988079,-1.08253157139
Set Vertexdata Position 7,-1.99999964237,2.25,2.16506361961
Set Vertexdata Position 8,0,-1.25000011921,2.1650633812
Set Vertexdata Position 9,1.875,-1.25000011921,-1.08253192902
Set Vertexdata Position 10,-1.875,-3.25,-1.08253145218
Set Vertexdata Position 11,-3.78551732183,-1.25000011921,2.1650633812
Set Vertexdata Position 12,0,-2.5,2.18556948539
Set Vertexdata Position 13,1.89275866092,-2.5,-1.09278481375
Set Vertexdata Position 14,-1.89275866092,-2.5,-1.09278452953
Set Vertexdata Position 15,-3.82137084563,-2.5,2.18556948539
Unlock Vertexdata
Ghost Object On 1
Set object Cull 1,0
ZRotate Object 1,180
Fix Object Pivot 1 
ObjAmount=1000
Global dx as float
Global dy as float
Global dz as float
Dim Rot(ObjAmount) as oRot
Rot(1).x=Rnd(360)
Rot(1).y=Rnd(360)
Rot(1).z=Rnd(360)
For x=2 to ObjAmount
 Instance Object x,1
 Rot(x).x=Rnd(2000)
 Rot(x).y=Rnd(2000)
 Rot(x).z=Rnd(2000)
 If x>50 and x<300
  Move Object x,-(x-48)
 Endif
 If x>=300
  Position object x,Object Position X(1),Object Position Y(1),Object Position Z(1)
  Move Object x,20
  Move Object Down x,20
 Endif
Next x
Make Object Sphere ObjAmount+1,900
Set Object Cull ObjAmount+1,0
Color Object ObjAmount+1,RGB(0,0,256)
Set Alpha Mapping On ObjAmount+1,10
Backdrop off
Tim=Timer()+5000
Action=1
Do
Inc Yrot,1
Text 0,0,str$(Screen Fps())
If Action=2
 if speed<(.5*(ObjAmount-250)) then inc Speed,1
Endif
If Action=5
 inc Speed,1
Endif
For x=1 to ObjAmount
If Action=5
 Position Object x,Cos(Object Position X(x)+Object Angle X(x)+Yrot),Cos(Object Position Y(x)+Object Angle Y(x)+YRot),Cos(Object Position Z(x)+Object Angle Z(x)+YRot)
 If x>250
  Move Object x,-Speed
 Endif
 If Timer()>Tim then Action=1:Tim=Timer()+5000
Endif
If Action=4
 Rotate Object x,0,0,0
 Point Object x,0,0,0
 Move Object x,5
 If Timer()>Tim then Speed=0:Action=5:Tim=Timer()+12000
Endif
If Action=3
 Move Object x,-10
 Rotate Camera rnd(5),rnd(5),rnd(5)
 If Timer()>Tim Then Action=4:Tim=Timer()+35000
Endif
If Action=2
 Position Object x,Cos(Object Position X(x)+Object Angle X(x)+Yrot),Cos(Object Position Y(x)+Object Angle Y(x)+YRot),Cos(Object Position Z(x)+Object Angle Z(x)+YRot)
 If x>250
  inc i,1
  speedo=.5*i-speed
  if speedo>0 then Move Object x,speedo
 Endif
If Object Collision(1,ObjAmount-30) then Action=3:Tim=Timer()+13000
Endif
If Action=1
 Position Object x,Cos(Object Position X(x)+Object Angle X(x)+Yrot),Cos(Object Position Y(x)+Object Angle Y(x)+YRot),Cos(Object Position Z(x)+Object Angle Z(x)+YRot)
 If x>250
  inc i,1
  Move Object x,.5*i
 Endif
 If Timer()>Tim then Speed=0:Action=2
Endif
 Rotate Object x,Rot(x).x+YRot,Rot(x).y+YRot,Rot(x).z+YRot
Next x
i=0
Fastsync
Loop

Sync On
Sync Rate 0
Autocam off
Move Camera -300
Type oRot
x as float
y as float
z as float
Endtype
Make Object Plain 1,5,5
Ghost Object On 1
ObjAmount=600
Global dx as float
Global dy as float
Global dz as float
Dim Rot(ObjAmount) as oRot
Rot(1).x=Rnd(360)
Rot(1).y=Rnd(360)
Rot(1).z=Rnd(360)
For x=2 to ObjAmount
 Instance Object x,1
 Rot(x).x=Rnd(2000)
 Rot(x).y=Rnd(2000)
 Rot(x).z=Rnd(2000)
 If x>50 and x<300
  Move Object x,-(x-48)
 Endif
 If x>=300
  Position object x,Object Position X(1),Object Position Y(1),Object Position Z(1)
  Move Object x,20
  Move Object Down x,20
 Endif
Next x
Make Object Sphere ObjAmount+1,900
Set Object Cull ObjAmount+1,0
Color Object ObjAmount+1,RGB(0,0,256)
Set Alpha Mapping On ObjAmount+1,10
Backdrop off
Tim=Timer()+5000
Action=1
Do
Inc Yrot,1
Text 0,0,str$(Screen Fps())
If Action=2
 if speed<(.5*(ObjAmount-250)) then inc Speed,1
Endif
If Action=5
 inc Speed,1
Endif
For x=1 to ObjAmount
If Action=5
 Position Object x,Cos(Object Position X(x)+Object Angle X(x)+Yrot),Cos(Object Position Y(x)+Object Angle Y(x)+YRot),Cos(Object Position Z(x)+Object Angle Z(x)+YRot)
 If x>250
  Move Object x,-Speed
 Endif
 If Timer()>Tim then Action=1:Tim=Timer()+5000
Endif
If Action=4
 Rotate Object x,0,0,0
 Point Object x,0,0,0
 Move Object x,5
 If Timer()>Tim then Speed=0:Action=5:Tim=Timer()+12000
Endif
If Action=3
 Move Object x,-10
 Rotate Camera rnd(5),rnd(5),rnd(5)
 If Timer()>Tim Then Action=4:Tim=Timer()+35000
Endif
If Action=2
 Position Object x,Cos(Object Position X(x)+Object Angle X(x)+Yrot),Cos(Object Position Y(x)+Object Angle Y(x)+YRot),Cos(Object Position Z(x)+Object Angle Z(x)+YRot)
 If x>250
  inc i,1
  speedo=.5*i-speed
  if speedo>0 then Move Object x,speedo
 Endif
If Object Collision(1,ObjAmount-30) then Action=3:Tim=Timer()+13000
Endif
If Action=1
 Position Object x,Cos(Object Position X(x)+Object Angle X(x)+Yrot),Cos(Object Position Y(x)+Object Angle Y(x)+YRot),Cos(Object Position Z(x)+Object Angle Z(x)+YRot)
 If x>250
  inc i,1
  Move Object x,.5*i
 Endif
 If Timer()>Tim then Speed=0:Action=2
Endif
 Rotate Object x,Rot(x).x+YRot,Rot(x).y+YRot,Rot(x).z+YRot
Next x
i=0
Fastsync
Loop