Buchempfehlung
Windows System Programming
Windows System Programming
Das Kompendium liefert viele interessante Informationen zur Windows-Programmierung auf Englisch. [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!

Code-Beispiel

Code-Beispiele » Grafik und Fonts

sich regulierendes Partikelsystem

Lizenz:Erster Autor:Letzte Bearbeitung:
k. A.Mitgliedschildron 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 Mitgliedschildron angelegt.
  • Die aktuellste Version wurde am 11.12.2010 von Mitgliedschildron gespeichert.
  Bearbeiten Bearbeiten  

  Versionen Versionen