Physik-Simulation
Zum Code
Das hier ist mal eine komplexere Simulation, dabei werden nur elektronische Kräfte und die Gravitationskräfte beachtet, letztere standardmäßig nur zwischen den einzelnen Objekten. Auf Wunsch kann man die Erdgravitation (Erdoberfläche) anschalten. Auch alle Kräfte können als Kraftlinien eingezeichnet werden.

Zwei Modi sind möglich: Realtime und normale Berechnungen. Beim Realtime-Modus wird die Zeit von der letzten Simulation an gemessen. Beim normalen Modus beträgt die Zeit immer "dt" siehe die entsprechende Textbox. Um das ganze zu beschleunigen, gibt "n" (andere Textbox) an, wie oft dargestellt werden soll. Bei n=50 wird z.B. jede 50. Berechnung dargestellt.

Beide Berechnungen sind jedoch nicht exakt, egal wie klein die Zeitspanne zwischen den Berechnungen ist, es gibt immer Fehler. Diese sieht man vor allem in der Kreisbahn von Objekten -> dafür gibt es die Option "Cheat", wodurch die Formel s=1/2*a*t^2 angepasst wird zu s=1*a*t^2. Dadurch werden gerade Beschleunigen zu groß berechnet, jedoch klappt die Kreisbahn wieder.

Ganz rechts wird die Bahn der Objekte aufgezeichnet, in der Titelleiste steht die momentane Frameleistung.

Die meisten Buttons fügen Objekte in den Worldspace ein, manche mit negativen Ladungen, manche mit positiven, manchmal Fixsterne, je nachdem. Gerechnet wird immer in den korrekten physikalischen Masseinheiten, also Meter, Newton etc. Zudem sind einige unfertige Spielereien dabei, wie z.B. der Versuch, Kraftfelder einzeichnen zu lassen.

Viel Spaß damit, spielt einfach mal ein wenig rum und wenn ihr es hinkriegt, Kraftfelder einzuzeichnen, mailt mir :D

History
26.12.2002 Online gestellt

Autor: Dominik Auras <Dominik_auf_vbinside.de> 

Code aus Module1.bas
Option Explicit
Public Declare Function QueryPerformanceCounter Lib "kernel32" _
    (lpPerformanceCount As LARGE_INTEGER) As Long
Public Declare Function QueryPerformanceFrequency Lib "kernel32" _
    (lpFrequency As LARGE_INTEGER) As Long
Public Type LARGE_INTEGER
  lowpart As Long
  highpart As Long
End Type
Public Worldspace() As Objekt
Public Const g As Double = -9.80665
Public Const Gravitationskonstante As Double = 6.672 * 10 ^ -11
Public Const Pi = 3.14159265358979
Public Const EFeldkonstante As Double = 8.85419 * 10 ^ -12
Public Const Elementarladung As Double = -1.6021773 * 10 ^ -19
Public Const Verlustfaktor As Double = 1.01
Public PixelPerMeter As Double
Public Freq As LARGE_INTEGER
Public last As LARGE_INTEGER
Public Declare Function IntersectRect Lib "user32" (lpDestRect As _
    RECT, lpSrc1Rect As RECT, lpSrc2Rect As RECT) As Long
Public Type RECT
  Left As Long
  Top As Long
  Right As Long
  Bottom As Long
End Type
'Hier fügen wir alle Kräfte, die auf das Objekt wirken, der _
    Collection Kräfte hinzu
Public Sub KräfteBerechnen()
  Dim Objekt As Objekt, Kraftvektor As Kraftvektor, objOther As Objekt
  Dim r As Double, m1 As Double, m2 As Double, f As Double
  Dim X1 As Double, X2 As Double, Y1 As Double, Y2 As Double, _
      alpha As Double
  Dim Fx As Double, Fy As Double, q1 As Double, q2 As Double
    
  Dim i As Long, n As Long
    
    For i = 1 To UBound(Worldspace)
      Objekt = Worldspace(i)
      
      Kraftvektor.x = 0
      Kraftvektor.y = Objekt.Masse * g
      If Form1.Check1.Value = vbChecked Then
        AddVektor Kraftvektor, Objekt
      End If
      
      For n = 1 To UBound(Worldspace)
        objOther = Worldspace(n)
        
        If n <> i Then
          X1 = Objekt.Position.x
          Y1 = Objekt.Position.y
          X2 = objOther.Position.x
          Y2 = objOther.Position.y
          m1 = Objekt.Masse
          m2 = objOther.Masse
          q1 = Objekt.Ladung
          q2 = objOther.Ladung
          
          r = ((X2 - X1) ^ 2 + (Y2 - Y1) ^ 2) ^ 0.5
          If r = 0 Then
            Goto weiter
          End If
          
          f = (Gravitationskonstante * m1 * m2) / r ^ 2
          alpha = Atann(X2 - X1, Y2 - Y1)
          
          Fx = Cos(alpha) * f
          Fy = Sin(alpha) * f
          
          Kraftvektor.x = Fx
          Kraftvektor.y = Fy
          AddVektor Kraftvektor, Objekt
          
          f = -(q1 * q2) / (4 * Pi * EFeldkonstante * r ^ 2)
          
          Fx = Cos(alpha) * f
          Fy = Sin(alpha) * f
          
          Kraftvektor.x = Fx
          Kraftvektor.y = Fy
          If Form1.Check2.Value = vbChecked Then
            AddVektor Kraftvektor, Objekt
          End If
        End If
weiter:
      Next n
      
      Worldspace(i) = Objekt
    Next i
End Sub
'Wir berechnen zuerst aus allen Kräften eine resultierende Kraft, daraus
'dann die Beschleunigung, und letztendlich die zurückgelegte Strecke
'seit dem letzten Aufruf. Beim ersten Aufruf kann es zu falschen Werten
'kommen
Public Sub ObjekteBewegen()
  Dim Objekt As Objekt, Kraftvektor As Kraftvektor, cur As _
      LARGE_INTEGER, t As Double
  Dim Copy As Kraftvektor, cur2 As Double, d As Long, k As Long
    
  Dim i As Long, n As Long
    
  Static h
    
    h = h + 1
    
    d = Val(Form1.Text1.Text)
    If d <= 0 Then
      d = 500
    End If
    
    k = 0.5
    If Form1.Check4.Value = vbChecked Then
      k = 1
    End If
    
    QueryPerformanceCounter cur
    t = Int(((CDouble(cur) - CDouble(last)) / CDouble(Freq)) * _
        100000000000#) / 100000000000#
    's
    If h Mod d = 0 Then
      Form1.Caption = 1 / t & " fps"
    End If
    If Form1.Check5.Value <> vbChecked Then
      t = Val(Form1.Text2.Text)
    End If
    If t <= 0 Then
      t = 1 / 10000
    End If
    QueryPerformanceCounter last
    
    If t = 0 Then
      Exit Sub
    End If
    
    For i = 1 To UBound(Worldspace)
      Objekt = Worldspace(i)
      
      Objekt.ResultierendeKraft.x = 0
      Objekt.ResultierendeKraft.y = 0
      
      If Form1.Check3.Value = vbChecked Then
        ReDim Objekt.DisplayVektoren(0)
      End If
      
      For n = 1 To UBound(Objekt.Kräfte)
        Kraftvektor = Objekt.Kräfte(n)
        
        Objekt.ResultierendeKraft.x = Objekt.ResultierendeKraft.x _
            + Kraftvektor.x
        'N
        Objekt.ResultierendeKraft.y = Objekt.ResultierendeKraft.y _
            + Kraftvektor.y
        
        If Form1.Check3.Value = vbChecked Then
          AddDVektor Kraftvektor, Objekt
        End If
      Next n
      
      ReDim Objekt.Kräfte(0)
      
      Objekt.Beschleunigung.x = Objekt.ResultierendeKraft.x / _
          Objekt.Masse
      'm/s^2
      Objekt.Beschleunigung.y = Objekt.ResultierendeKraft.y / _
          Objekt.Masse
      
      Objekt.Bewegung.x = Objekt.Geschwindigkeit.x * t + k * _
          Objekt.Beschleunigung.x * t * t
      Objekt.Bewegung.y = Objekt.Geschwindigkeit.y * t + k * _
          Objekt.Beschleunigung.y * t * t
      
      Objekt.Geschwindigkeit.x = Objekt.Geschwindigkeit.x + _
          Objekt.Beschleunigung.x * t
      Objekt.Geschwindigkeit.y = Objekt.Geschwindigkeit.y + _
          Objekt.Beschleunigung.y * t
      
      If Not Objekt.Fixed Then
        Objekt.Position.x = Objekt.Position.x + Objekt.Bewegung.x
        Objekt.Position.y = Objekt.Position.y + Objekt.Bewegung.y
      End If
      
      Worldspace(i) = Objekt
    Next i
End Sub
'Es muss noch überprüft werden, ob die Objekte irgendwie kollidieren
'gegebenfalls zurücksetzen, Kräfte addieren oder so
Public Sub KollisionenErkennen()
'Für jedes Objekt muss überprüft werden, ob es eventuell die Koordinaten
'eines anderen kreuzt, dann sollte eine genauer pixelweise _
    Kontrolle geschehen
'um auch bei nicht-rechteckigen Objekte genaue Erkennung zu behalten
'Bei 10 Objekten sind wir aber schon bei 100 Tests (10 äußere, 10 _
    innere, ok 9 innere)
'wie macht man das schneller/einfacher?
    
  Dim Objekt As Objekt, Bottom As Double, Right As Double, Left As _
      Double, Top As Double
  Dim objOther As Objekt, b2 As Double, r2 As Double, l2 As _
      Double, t2 As Double
  Dim rect1 As RECT, rect2 As RECT, rdest As RECT, ret As Long
    
  Dim i As Long, n As Long
    
    For i = 1 To UBound(Worldspace)
      Objekt = Worldspace(i)
      
      Bottom = Objekt.Position.y - Objekt.Grösse.height / 2
      Top = Objekt.Position.y + Objekt.Grösse.height / 2
      Left = Objekt.Position.x - Objekt.Grösse.width / 2
      Right = Objekt.Position.x + Objekt.Grösse.width / 2
      
      If Left < 0 Then
        Objekt.Position.x = Objekt.Grösse.width / 2
        Objekt.Geschwindigkeit.x = -Objekt.Geschwindigkeit.x / _
            Verlustfaktor
        
        If Abs(Objekt.Geschwindigkeit.x) > _
            Form1.Picture1.ScaleWidth / PixelPerMeter / 1.3 Then
          Objekt.Geschwindigkeit.x = Objekt.Geschwindigkeit.x / 10
        End If
      End If
      
      If Right > Form1.Picture1.ScaleWidth / PixelPerMeter Then
        Objekt.Position.x = Form1.Picture1.ScaleWidth / _
            PixelPerMeter - Objekt.Grösse.width / 2
        Objekt.Geschwindigkeit.x = -Objekt.Geschwindigkeit.x / _
            Verlustfaktor
        
        If Abs(Objekt.Geschwindigkeit.x) > _
            Form1.Picture1.ScaleWidth / PixelPerMeter / 1.3 Then
          Objekt.Geschwindigkeit.x = Objekt.Geschwindigkeit.x / 10
        End If
      End If
      
      If Bottom < 0 Then
        Objekt.Position.y = Objekt.Grösse.height / 2
        Objekt.Geschwindigkeit.y = -Objekt.Geschwindigkeit.y / _
            Verlustfaktor
        
        If Abs(Objekt.Geschwindigkeit.y) > _
            Form1.Picture1.ScaleHeight / PixelPerMeter / 1.3 Then
          Objekt.Geschwindigkeit.y = Objekt.Geschwindigkeit.y / 10
        End If
      End If
      
      If Top > Form1.Picture1.ScaleHeight / PixelPerMeter Then
        Objekt.Position.y = Form1.Picture1.ScaleHeight / _
            PixelPerMeter - Objekt.Grösse.height / 2
        Objekt.Geschwindigkeit.y = -Objekt.Geschwindigkeit.y / _
            Verlustfaktor
        Objekt.Geschwindigkeit.x = Objekt.Geschwindigkeit.x / _
            Verlustfaktor
        
        If Abs(Objekt.Geschwindigkeit.x) > _
            Form1.Picture1.ScaleWidth / PixelPerMeter / 1.3 Then
          Objekt.Geschwindigkeit.x = Objekt.Geschwindigkeit.x / 10
        End If
        If Abs(Objekt.Geschwindigkeit.y) > _
            Form1.Picture1.ScaleHeight / PixelPerMeter / 1.3 Then
          Objekt.Geschwindigkeit.y = Objekt.Geschwindigkeit.y / 10
        End If
      End If
      
      Objekt.Crashed = False
      For n = 1 To UBound(Worldspace)
        objOther = Worldspace(n)
        
        If n <> i Then
          b2 = objOther.Position.y - objOther.Grösse.height / 2
          t2 = objOther.Position.y + objOther.Grösse.height / 2
          l2 = objOther.Position.x - objOther.Grösse.width / 2
          r2 = objOther.Position.x + objOther.Grösse.width / 2
          
          rect1.Left = Left * PixelPerMeter: rect1.Right = Right * _
              PixelPerMeter
          rect1.Top = Bottom * PixelPerMeter: rect1.Bottom = Top * _
              PixelPerMeter
          rect2.Left = l2 * PixelPerMeter: rect2.Right = r2 * _
              PixelPerMeter
          rect2.Top = b2 * PixelPerMeter: rect2.Bottom = t2 * _
              PixelPerMeter
          
          ret = IntersectRect(rdest, rect1, rect2)
          
          If ret Then
            Objekt.Crashed = True
          End If
        End If
      Next n
      
      Worldspace(i) = Objekt
    Next i
End Sub
Private Function CDouble(Num As LARGE_INTEGER) As Double
  Dim Low As Double, High As Double
    
    Low = Num.lowpart
    High = Num.highpart
    
    If Low < 0 Then
      Low = 4294967296# + Low + 1
    End If
    If High < 0 Then
      High = 4294967296# + High + 1
    End If
    
    CDouble = Low + High * 4294967296#
End Function
Public Function Atann(x As Double, y As Double)
  Dim alpha As Double
  Dim atan As Double
    
    If x <> 0 Then
      atan = Atn(Abs(y) / Abs(x))
    Else
      atan = 0
    End If
    
    Select Case x
      Case Is < 0
        If y = 0 Then
          alpha = Pi
        ElseIf y > 0 Then
          alpha = Pi - atan
        ElseIf y < 0 Then
          alpha = Pi + atan
        End If
      Case Is > 0
        If y = 0 Then
          alpha = 0
        ElseIf y > 0 Then
          alpha = atan
        ElseIf y < 0 Then
          alpha = -atan
        End If
      Case Is = 0
        Select Case y
          Case Is < 0
            alpha = Pi / 2
            ' 1st
          Case Is > 0
            alpha = 3 * Pi / 2
            ' 3rd
          Case Is = 0
            alpha = 0
        End Select
    End Select
    
aus_atann:
    'If alpha >= Pi Then alpha = alpha - Pi
    Atann = alpha
End Function