Code-Beispiel

sich regulierendes Partikelsystem

Lizenz:	Erster Autor:	Letzte Bearbeitung:
k. A.	schildron	11.12.2010
Dies ist ein Beispiel eines einfachen, sich selbst regulierenden, Partikelsystems. Jedes Partikel existiert nur so lange, wie es benötigt wird.
Die Partikel werden als weiße Punkte dargestellt. Ein mögliches Anwendungsgebiet ist z.B. die Computerspiele-Programmierung.
'------------------------------------------

'Demo für ein einfaches, sich regulierendes, Partikelsystem

'------------------------------------------

'(c) 2010 Schildron

'------------------------------------------



Randomize Timer ''"Zufall" initialisieren

Cls



Dim As Integer ParticleQuantity, NewParticle    ''Hier Partikelanzahl speichern

Dim As Integer MousePosX, MousePosY, MouseKeyState  ''Mausdaten

Dim As String KeyState                                      ''Tastaturdaten

Dim As Integer ParticleKilledCounter = 0                ''Variable zum Zählen der erloschenen Partikel



'--------------------------

'Type für Partikel erstellen

'--------------------------

Type StandardParticle

    PosX As Single

    PosY As Single

    VelX As Single

    VelY As Single

    life As Integer

    'size As Integer            'Für Beispiel nicht benötigt

    'colorRed As Integer        'Für Beispiel nicht benötigt

    'colorGreen As Integer  'Für Beispiel nicht benötigt

    'colorBlue As Integer   'Für Beispiel nicht benötigt

End Type



Dim Shared As StandardParticle SingleParticle(0 To ParticleQuantity)



Screen 19



Do

    cls     'Fenster leeren. Auskommentieren um Sternenlinie zu zeichnen

    '--------------------------

    'Maus prüfen, bei linker Maustaste +10 Partikel freisetzen

    '--------------------------

    KeyState = InKey                                                'Tastaturstatus abfragen

    GetMouse (MousePosX, MousePosY, , MouseKeyState)    'Mausstatus abfragen

    If MouseKeyState = 1 Then

        NewParticle = 30                                            'Zahl der neu erstellten Partikel (pro Frame)

        ParticleQuantity = ParticleQuantity + NewParticle       'Gesamtmenge von den Partikel errechnen

        ReDim Preserve SingleParticle(1 To ParticleQuantity)    'Array für neue Partikel vergrößern

        For ParticleCounter As Integer = (ParticleQuantity - (NewParticle - 1)) To ParticleQuantity

            With SingleParticle(ParticleCounter)

                '---------------------

                'neuen Partikel Informationen geben

                '---------------------

                .PosX = MousePosX

                .PosY = MousePosY

                .life = 75*Rnd

                .VelX = ((Rnd*2)-1)/0.90

                .VelY = ((Rnd*2)-1)/0.90

            End With

        Next ParticleCounter

    EndIf



    '--------------------------

    'Schleife zur Neuberechnung der Partikelposition

    '--------------------------

    ParticleKilledCounter = 0

    For ParticleCounter As Integer = 1 To ParticleQuantity

        With SingleParticle(ParticleCounter)

            '---------------------

            'Wenn noch Leben vorhanden, Partikel weiterbewegen

            '---------------------

            If .life > 0 Then

                .PosX += .VelX

                .PosY += .VelY

                .VelX *= 1.001

                .VelY *= 1.001

                .life -= 1

            Else

                '---------------------

                'Wenn Leben <= 0 dann noch lebende Partikel vorreihen

                '---------------------

                .PosX = SingleParticle(ParticleQuantity-ParticleKilledCounter).PosX

                .PosY = SingleParticle(ParticleQuantity-ParticleKilledCounter).PosY

                .life = SingleParticle(ParticleQuantity-ParticleKilledCounter).life

                .VelX = SingleParticle(ParticleQuantity-ParticleKilledCounter).VelX

                .VelY = SingleParticle(ParticleQuantity-ParticleKilledCounter).VelY

                ParticleKilledCounter += 1      'Anzahl gelöschter Partikel zählen

            EndIf

            '--------------------------

            'Punkte zeichnen

            '--------------------------

            PSet (.PosX, .PosY), 15



        End With

    Next ParticleCounter



    ParticleQuantity -= ParticleKilledCounter       'Gelöschte Partikel von Gesamtmenge abziehen

    ReDim Preserve SingleParticle(0 To ParticleQuantity)    'Array auf neue Partikelmenge verkeinern

    WindowTitle "Partikelzahl: " & Str(ParticleQuantity)    'Aktuelle Partikelanzahl im Fenster anzeigen

    Sleep 1



Loop Until Keystate = Chr(27)



End
Zusätzliche Informationen und Funktionen
Das Code-Beispiel wurde am 10.12.2010 von schildron angelegt.
Die aktuellste Version wurde am 11.12.2010 von schildron gespeichert.
Bearbeiten
Versionen