New Years Eve 2020 - Firework Particle Animation - Source Code

[kevin]

New Years Eve 2020 -  Firework   Particle   Animation - Source Code

 

Music: https://bensound.com

PlayBASIC Code: [Select]

; PROJECT : New Years eve Anim 2020 Edition
; AUTHOR  : 
; CREATED : 31/12/2019
; EDITED  : 31/12/2019
; ---------------------------------------------------------------------
         
             destpath$="C:\_NYE-ANIMATION-2020\"


 openscreen 1280,720,32,1


#include "savebitmap"
#include "blitimage"

//Variables
GLOBAL Speed#
GLOBAL parax#
GLOBAL paray#
GLOBAL paraz#
GLOBAL Angle1#
GLOBAL Angle2#

GLOBAL switch = 0
GLOBAL NbFeu = 600
GLOBAL Temps = 0


//Types

TYPE FeuArtifice
   SpriteIndex
   x#
     y#
     z#
     vy#
     xd#
     yd#
     zd#
     size#
ENDTYPE

DIM Pouf AS FeuArtifice LIST

Dim ImageUsageCounters($ffff)


ParticleImage=MakeBall()

Screen=NewFXIMage(GetScreenWidth(),GetScreenHeight())



Global Screen_Width    = GetScreenWidth()
Global Screen_Height   = GetScreenHeight()




// Boucle principale
REPEAT
   RendertoIMage Screen


;   for pass=1 to 2
      IF Temps   = 0
         parax# = RNDrange(-150,150)
          paray# = RNDRange(-120,60)
          paraz# = RNDRange( 150,400)
   
         IF swith = 0
            Temps = rndrange(10,60)
         ENDIF

         ; pick a colour for this batch      
         ThisRGB=RNDRGB()
         THisImage=PreColourIMage(ParticleImage,ThisRGB)
         
         FOR i = 1 TO NbFeu
               NewFeu(parax#,paray#,paraz#,ThisImage,THisRGB)
         NEXT

      ENDIF
   
      t=timer()
         FOR EACH Pouf()
            if AfficheFeu()=0
                  KillParticle()
            endif
         NEXT
         tt1#+=(timer()-t)
      Temps--


;   next


      t=timer()
         ;DRAWALLSPRITES   
         TEST_MultiPass(Screen,Sprites_DRaw_mode,6)
      tt2#+=(timer()-t)


   rendertoscreen



      if 1=1

         MaxFramesInDemo=60*50
         if CurrentSaveFrame<MaxFramesInDemo
            Render_Logos(Screen,CurrentSaveFrame,MaxFramesInDemo)
            
            if folderexist(DestPath$)
               file$=destpath$+"Frame"+Digits$(CurrentSaveFrame,6)+".bmp"
               ;SaveBitmap file$,Screen
               CurrentSaveFrame++
            endif
         else
               end
         endif
      
      endif
      

   BlitImageAlphaPostMultColour(Screen,0,0,$F0D8D8)
;   BlitImageAlpha50Colour(Screen,0,0,$010101)

   setcursor 0,0
;
   SYNC
   
UNTIL ESCKEY() = 1



   end
   



Psub KillParticle()

      ThisSprite=Pouf.SpriteIndex
      if ThisSprite

            ThisImage=GetSpriteImage(THisSprite)


Login required to view complete source code