Science Forums 2

[TheBigDog]

And the code...

Imports System
Imports System.IO

Public Class Form1

    'First I have to create the environment.
    'The Earth and the Moon

    'The environment is populated with objects
    'Each object has properties of ...
    'Mass, location, radius, direction, velocity

    'Certain objects will have additional attributes of...
    'Stage, fuel, thrust, thrust direction

    'The object is to launch a rocket from earth and soft land it on the moon
    'This will be done by adjusting the attributes as time passes
    'to adjust the objects relitive to one another
    Dim Bodies() As Body
    Dim AnyBodies As Boolean = False
    Dim Time As Long

    Sub Begin()

        'Create the "Heavenly bodies"

        Dim sw As StreamWriter

        'Check if the default file exists...
        'Create it if needed...
        If File.Exists(LogDirectory.Text & "DefaultBodies.lms") = False Then
            sw = File.AppendText(LogDirectory.Text & "DefaultBodies.lms")
            For a As Integer = 1 To 3
                sw.WriteLine( _
                    Choose(a, "Earth", "Moon", "Alice") & "," & _
                    Choose(a, 0, 0, 0) & "," & _
                    Choose(a, 0, 378000000, 42164140.100123964) & "," & _
                    Choose(a, 0, 0, 0) & "," & _
                    Choose(a, 6378100, 1738100, 1) & "," & _
                    Choose(a, 5.9736 * (10 ^ 24), 0.07349 * (10 ^ 24), 1000) & "," & _
                    Choose(a, 0, 1023, 3074.6611759779084) & "," & _
                    Choose(a, 0, 0, 0) & "," & _
                    Choose(a, 0, 0, 0) & ",")
            Next
            sw.Close()
        End If

        AnyBodies = False

        LoadFile(LogDirectory.Text & "DefaultBodies.lms")

        Timer1.Tag = "Second,Body,Mass,Radius,x,y,z,xv,yv,zv" & vbCrLf
        LogPosition(0)

    End Sub

    Function Parse(ByVal Line As String, ByVal Place As Integer, ByVal Delimiter As String) As String

        Dim a As Integer = 0

        Do Until a = Place
            Line = Mid$(Line, Line.IndexOf(Delimiter) + 2, Line.Length - Line.IndexOf(Delimiter))
            a += 1
        Loop

        Return Mid$(Line, 1, Line.IndexOf(Delimiter))

    End Function
    Sub LoadFile(ByVal FullPath As String)

        Dim sr As StreamReader
        sr = File.OpenText(FullPath)

        AnyBodies = False
        Dim Line As String
        Do Until sr.EndOfStream = True
            Line = sr.ReadLine
            CreateBody(Parse(Line, 0, ","))
            With Bodies(Bodies.Length - 1)
                .x = Parse(Line, 1, ",")
                .y = Parse(Line, 2, ",")
                .z = Parse(Line, 3, ",")
                .r = Parse(Line, 4, ",")
                .m = Parse(Line, 5, ",")
                .xv = Parse(Line, 6, ",")
                .yv = Parse(Line, 7, ",")
                .zv = Parse(Line, 8, ",")
            End With
            For b As Integer = 0 To 8
                Bodies(Bodies.Length - 1).Value(b).Text = SetValue(Bodies(Bodies.Length - 1), b + 1)
                Bodies(Bodies.Length - 1).Alternate(b).Text = SetValue(Bodies(Bodies.Length - 1), b + 1)
            Next
        Loop
        sr.Close()
    End Sub
    Function SetValue(ByVal Body As Body, ByVal Part As Integer) As String

        Return Choose(Part, Body.x, Body.y, Body.z, Body.r, Body.m, Body.xv, Body.yv, Body.zv, Body.v)

    End Function

    Function SetField(ByVal Body As Body, ByVal Part As Integer) As String

        Return Choose(Part, "X:", "Y:", "Z:", "Radius:", "Mass:", "xVelocity:", "yVelocity:", "zVelocity", "aVelocity")

    End Function

    Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load

        LogDirectory.Text = System.Environment.CurrentDirectory
        Begin()

    End Sub

    Function gForce(ByVal body1 As Body, ByVal body2 As Body) As Double

        Return (body1.m * body2.m) / (((body1.x - body2.x) ^ 2) + ((body1.y - body2.y) ^ 2) + ((body1.z - body2.z) ^ 2)) * (6.67428 * (10 ^ (-11)))

    End Function

    Function aForce(ByVal body1 As Body, ByVal body2 As Body, ByVal axis As String) As Double

        Dim f, x, y, z As Double

        x = (body1.x - body2.x)
        y = (body1.y - body2.y)
        z = (body1.z - body2.z)
        f = Math.Sqrt((x ^ 2) + (y ^ 2) + (z ^ 2))

        Select Case axis

            Case "x"
                aForce = (gForce(body1, body2) * x / f)

            Case "y"
                aForce = (gForce(body1, body2) * y / f)

            Case "z"
                aForce = (gForce(body1, body2) * z / f)

            Case Else
                aForce = 0

        End Select

        Return aForce

    End Function

    Sub DeltaV()

        On Error GoTo Err

        For Each target As Body In Bodies
            For Each influence As Body In Bodies
                If target.Name <> influence.Name _
                    And target.Tag = 0 _
                    And influence.Tag = 0 Then
                    target.xv -= aForce(target, influence, "x") / target.m
                    target.yv -= aForce(target, influence, "y") / target.m
                    target.zv -= aForce(target, influence, "z") / target.m
                End If
            Next
            For a As Integer = 0 To 8
                target.Value(a).Text = SetValue(target, a + 1)
            Next
        Next

        Exit Sub

Err:

        MsgBox(Err.Description, MsgBoxStyle.OkOnly)

    End Sub

    Sub MoveObjects()

        For Each target As Body In Bodies
            If target.Tag = 0 Then
                target.x += target.xv
                target.y += target.yv
                target.z += target.zv
            End If
        Next

    End Sub

    Private Sub Button1_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button1.Click

        Select Case Timer1.Enabled
            Case True
                Timer1.Enabled = False
                WriteLog()
            Case False
                If Time = 0 Then
                    If File.Exists(LogDirectory.Text & "" & LogFilename.Text & ".txt") = True Then
                        If MsgBox("Log file already exists.  Do you wish to overwrite it?", MsgBoxStyle.YesNo) = vbYes Then
                            File.Delete(LogDirectory.Text & "" & LogFilename.Text & ".txt")
                            Timer1.Tag = "Second,Body,Mass,Radius,x,y,z,xv,yv,zv" & vbCrLf
                            LogPosition(0)
                        Else
                            Exit Sub
                        End If
                    End If
                End If
                Timer1.Enabled = True
        End Select

    End Sub

    Private Sub Timer1_Tick(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Timer1.Tick

        DeltaV()
        MoveObjects()
        Time += 1
        If Time / Interval.Value = Int(Time / Interval.Value) Then LogPosition(Time)

        Me.Text = Format(Int(Time / 86400), "0") & " days " & Format(CType(Date.FromOADate(Time / 86400), Date), "HH:mm:ss") & "  " & Time

    End Sub

    Sub Writelog()

        Dim sw As StreamWriter
        sw = File.AppendText(LogDirectory.Text & "" & LogFilename.Text & ".txt")
        sw.WriteLine(Timer1.Tag)
        Timer1.Tag = ""
        sw.Close()

    End Sub

    Sub LogPosition(ByVal Time As Long)

        For Each target As Body In Bodies
            Timer1.Tag = Timer1.Tag & ( _
                Time & "," & _
                target.Name & "," & _
                target.m & "," & _
                target.r & "," & _
                target.x & "," & _
                target.y & "," & _
                target.z & "," & _
                target.xv & "," _
                & target.yv & _
                "," & target.zv & vbCrLf)
        Next

    End Sub

    Private Sub Button2_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button2.Click

        Button3_Click(sender, e)
        Time = 0
        Me.Text = Format(Int(Time / 86400), "0") & " days " & Format(CType(Date.FromOADate(Time / 86400), Date), "HH:mm:ss") & "  " & Time

    End Sub

    Sub CreateBody(ByVal Name As String)

        Dim a As Integer
        If AnyBodies = False Then
            ReDim Bodies(0)
            a = 0
            AnyBodies = True
        Else
            a = Bodies.Length
            ReDim Preserve Bodies(a)
        End If
        Dim NewBody As New Body
        Bodies(a) = NewBody
        Me.Controls.Add(Bodies(a))
        With Bodies(a)
            .Parent = Panel1
            .Name = Name
            .Text = .Name
            .Left = 0
            If a = 0 Then
                .Top = 0
            Else
                .Top = Bodies(a - 1).Top + Bodies(a - 1).Height + 0
            End If
            .Visible = True
            .AutoSize = True
        End With

        For b As Integer = 0 To 8
            Dim NewField As New Parts
            Bodies(a).Field(b) = NewField
            Me.Controls.Add(Bodies(a).Field(b))
            With Bodies(a).Field(b)
                .Parent = Bodies(a)
                .Left = 4
                .Top = 14 + (b * 20)
                .Text = SetField(Bodies(a), b + 1)
                .Visible = True
                .Height = 18
                .Width = 80
            End With

            Dim NewValue As New Parts
            Bodies(a).Value(b) = NewValue
            Me.Controls.Add(Bodies(a).Value(b))
            With Bodies(a).Value(b)
                .Parent = Bodies(a)
                .Left = Bodies(a).Field(b).Left + Bodies(a).Field(b).Width
                .Top = Bodies(a).Field(b).Top
                '.Text = SetValue(Bodies(a), b + 1)
                .Visible = True
                .Height = Bodies(a).Field(b).Height
                .Width = 100
            End With

            Dim NewAlternate As New Alternates
            Bodies(a).Alternate(b) = NewAlternate
            Me.Controls.Add(Bodies(a).Alternate(b))
            With Bodies(a).Alternate(b)
                .Parent = Bodies(a)
                .Left = Bodies(a).Value(b).Left + Bodies(a).Value(b).Width
                .Top = Bodies(a).Value(b).Top - 3
                '.Text = SetValue(Bodies(a), b + 1)
                .Visible = True
                .Height = Bodies(a).Value(b).Height
                .Width = 100
            End With
        Next

    End Sub
    Private Sub Button6_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button6.Click

        Dim NewName As String = InputBox("Name of new Heavenly Body:")
        If NewName = "" Then
            Exit Sub
        ElseIf NewName.IndexOf(",") <> -1 Then
            MsgBox("Cannot have a comma in a name.")
            Exit Sub
        End If

        CreateBody(NewName)

    End Sub

    Private Sub Button3_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button3.Click

        Dim Scan(Bodies.Length, 11) As String
        Dim Scans As Integer = -1
        For Each target As Body In Bodies
            Scans += 1
            target.Tag = 0
            For a As Integer = 0 To 8
                If Trim(target.Alternate(a).Text) = "" Then
                    Scan(Scans, a) = ""
                    target.Tag += 1
                Else
                    Scan(Scans, a) = target.Alternate(a).Text
                End If
            Next
            Scan(Scans, 9) = target.Name
            Scan(Scans, 10) = target.Tag
        Next

        For Each target As Body In Bodies
            target.Dispose()
        Next
        AnyBodies = False

        For Create As Integer = 0 To Scans
            If Scan(Create, 10) < 9 Then
                CreateBody(Scan(Create, 9))
                With Bodies(Bodies.Length - 1)
                    .x = Num(Scan(Create, 0))
                    .y = Num(Scan(Create, 1))
                    .z = Num(Scan(Create, 2))
                    .r = Num(Scan(Create, 3))
                    .m = Num(Scan(Create, 4))
                    .xv = Num(Scan(Create, 5))
                    .yv = Num(Scan(Create, 6))
                    .zv = Num(Scan(Create, 7))
                    .Tag = Num(Scan(Create, 10))

                    For a As Integer = 0 To 8
                        .Value(a).Text = SetValue(Bodies(Bodies.Length - 1), a + 1)
                        .Alternate(a).Text = Scan(Create, a)
                    Next

                    If .Tag > 0 Then
                        .BackColor = Color.LightSalmon
                    End If

                End With
            End If
        Next

    End Sub

    Function Num(ByVal Input As String) As Double

        If Trim(Input) = "" Then
            Return 0
        Else
            Return Input
        End If

    End Function

    Private Sub Button4_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button4.Click

        If Save1.ShowDialog() <> DialogResult.OK Then
            Exit Sub ' if you don't want to save it bail out now
        Else
            If File.Exists(Save1.FileName) Then File.Delete(Save1.FileName) ' If an existing file delete it
            Dim sw As StreamWriter ' open a writer
            sw = File.AppendText(Save1.FileName) ' prepare to write
            For Each target As Body In Bodies
                sw.WriteLine( _
                    target.Name & "," & _
                    target.x & "," & _
                    target.y & "," & _
                    target.z & "," & _
                    target.r & "," & _
                    target.m & "," & _
                    target.xv & "," & _
                    target.yv & "," & _
                    target.zv & ",")
            Next
            sw.Close() ' close the writer
        End If

    End Sub

    Private Sub Button5_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles Button5.Click

        If Open1.ShowDialog <> DialogResult.OK Then Exit Sub ' If not OKK to he dialog bail
        For Each target As Body In Bodies
            target.Dispose()
        Next
        AnyBodies = False
        LoadFile(Open1.FileName)

    End Sub
End Class

Public Class Body

    Inherits GroupBox

    Public x As Double
    Public y As Double
    Public z As Double
    Public m As Double
    Public r As Double
    Public xv As Double
    Public yv As Double
    Public zv As Double
    Public Field(8) As Parts
    Public Value(8) As Parts
    Public Alternate(8) As Alternates

    Function v() As Double

        Return Math.Sqrt((xv ^ 2) + (yv ^ 2) + (zv ^ 2))

    End Function

End Class

Public Class Parts

    Inherits Label

End Class

Public Class Alternates

    Inherits TextBox

End Class