Buchempfehlung
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
Windows-Programmierung. Das Entwicklerhandbuch zur WIN32-API
"Der" Petzold, das über 1000 Seiten starke Standardwerk zum Win32-API - besonders nützlich u. a. bei der GUI-Programmierung in FreeBASIC! [Mehr Infos...]
FreeBASIC-Chat
Es sind Benutzer im FreeBASIC-Chat online.
(Stand:  )
FreeBASIC bei Twitter
Twitter FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!

fb:porticula NoPaste

Info
Info / Hilfe
Liste
Übersicht / Liste
Neu
Datei hochladen
Suche
Quellcode suchen
Download
Dateidownload

Kleines Partikelsystem für Explosionen

Uploader:MitgliedDonStevone
Datum/Zeit:18.12.2011 19:09:43

#Define PSMaxParticles 5000
#Define PSMaxSpeed 10
#Define PSMaxLifeTime 300
#Define PSMinLifeTime 120

Type Particle
    X as Double
    Y as Double
    LX as Double
    LY as Double
    XV as Double
    YV as Double
    Active as Byte
    Col as Integer
    LifeTime as Integer
End Type

'###############################################################################
Type ParticleSystem
    ENumber as Integer
    Explosion(0 to 9) as Particle PTR

    Declare Constructor()
    Declare Destructor()
    Declare Sub NewExplosion(XPos as Integer, YPos as Integer)
    Declare Sub G()
    Declare Sub GClear()
    Declare Sub Control()
End Type

'###############################################################################
Constructor ParticleSystem()
    Dim a as Integer

    For a = 0 to 9
        Explosion(a) = Allocate(PSMaxParticles * SizeOf(Particle))
        If Explosion(a) = 0 then
            Print "[ERROR] Zero pointer exception in Constructor ParticleSystem"
        Endif
    Next a

    Randomize Timer
End Constructor

'###############################################################################
Destructor ParticleSystem()
    Dim a as Integer

    For a = 0 to 9
        Deallocate Explosion(a)
    Next a
End Destructor

'###############################################################################
Sub ParticleSystem.NewExplosion(XPos as Integer, YPos as Integer)
    Dim a as Integer
    Dim Temp as Double
    Dim TempRND as Double

    For a = 0 to PSMaxParticles - 1
        Explosion(ENumber)[a].X        = XPos
        Explosion(ENumber)[a].Y        = YPos
        Explosion(ENumber)[a].LX       = Explosion(ENumber)[a].X
        Explosion(ENumber)[a].LY       = Explosion(ENumber)[a].Y
        Temp = (RND * PSMaxSpeed) - PSMaxSpeed / 2
        If a <= PSMaxParticles / 3 * 2 then TempRND = PSMaxSpeed Else TempRND = RND * PSMaxSpeed
        Explosion(ENumber)[a].XV       = Sin(Temp) * TempRND
        Explosion(ENumber)[a].YV       = Cos(Temp) * TempRND
        Explosion(ENumber)[a].Active   = 1
        Explosion(ENumber)[a].Col      = RGB((RND * 255) + 1, (RND * 255) + 1, (RND * 255) + 1)
        Explosion(ENumber)[a].LifeTime = (RND * PSMaxLifeTime) - PSMinLifeTime
    Next a
    ENumber += 1
    If ENumber > 9 then ENumber = 0
End Sub

'###############################################################################
Sub ParticleSystem.G()
    Dim a as Integer
    Dim b as Integer

    For a = 0 to 9
        For b = 0 to PSMaxParticles - 1
            'If Explosion(a)[b].Active then PSet(Explosion(a)[b].X, Explosion(a)[b].Y), Explosion(a)[b].Col
            If Explosion(a)[b].Active then Circle(Explosion(a)[b].X, Explosion(a)[b].Y), 1, Explosion(a)[b].Col
        Next b
    Next a
End Sub

'###############################################################################
Sub ParticleSystem.Control()
    Dim a as Integer
    Dim b as Integer

    For a = 0 to 9
        For b = 0 to PSMaxParticles - 1
            If Explosion(a)[b].Active = 1 then
                Explosion(a)[b].LX = Explosion(a)[b].X
                Explosion(a)[b].LY = Explosion(a)[b].Y
                Explosion(a)[b].X += Explosion(a)[b].XV
                Explosion(a)[b].Y += Explosion(a)[b].YV
                Explosion(a)[b].LifeTime -= 1
                If Explosion(a)[b].LifeTime <= 0 then
                    Explosion(a)[b].Active = 0
                    PSet(Explosion(a)[b].LX, Explosion(a)[b].LY), &h000000
                Endif
            Endif
        Next b
    Next a
End Sub

'###############################################################################



Screenres 1024, 786, 32

Dim as ParticleSystem PS

Dim as Integer MX, MY, MB
Dim as Byte MLock

While(NOT Multikey(&h01))
    GetMouse(MX, MY,, MB)

    If MLock = 0 then
        If MB = 1 then PS.NewExplosion(MX, MY) : MLock = 1
    Endif
    If MB = 0 then MLock = 0

    PS.Control()
    ScreenLock
        CLS
        PS.G()
    ScreenUnlock

    Sleep 10
Wend

Sleep 500, 1