asteroids.vb

Public Class frmAsteriods

    Const numenemies As Integer = 5
    Public AsteroidList As New List(Of Asteroid)
    Public BulletList As New List(Of Asteroid)

    Public ship As New Asteroid
    Public p1 As New Point
    Public p2 As New Point

    Dim degrees As Integer
    Dim radians As Single

    Const PI As Long = 3.141579
    Const DEGREE_SKIP As Integer = 15
    Const GUN_LENGTH As Integer = 80
    Const THRUST_SKIP As Integer = 5
    Const THRUST_MAX As Long = 100
    Const MAX_BULLETS As Integer = 8

    Const asteriodRadius As Integer = 20
    Const bulletRadius As Integer = 5
    Const meRadius As Integer = 50
    Const MAX_SPEED As Integer = 20
    Const bulletSpeedMult As Integer = 30

    Dim foundbullet As Boolean
    Dim numbullets As Integer

    Dim pressingkeyleft As Boolean
    Dim pressingkeyright As Boolean
    Dim pressingkeyup As Boolean
    Dim pressingkeydown As Boolean

    Dim thrust As Integer
    Dim score As Long

    Public Function distance(x1 As Integer, y1 As Integer, x2 As Integer, y2 As Integer) As Single
        Return Math.Sqrt(((x2 - x1) ^ 2) + ((y2 - y1) ^ 2))
    End Function

    Private Sub Form1_Load(sender As Object, e As EventArgs) Handles MyBase.Load

        degrees = 0
        score = 0
        Dim r As Rectangle
        Dim i As Integer
        Dim a As Asteroid

        'Load up the images of the enemy
        For i = 1 To numenemies
            a = New Asteroid
            r = New Rectangle
            r.Y = Int(Rnd() * Me.Height)
            r.X = Int(Rnd() * Me.Width)
            r.Height = asteriodRadius * 2
            r.Width = asteriodRadius * 2
            a.rect = r
            a.speedX = generateSpeed(MAX_SPEED)
            a.speedY = generateSpeed(MAX_SPEED)
            a.visible = True
            AsteroidList.Add(a)
        Next i

        'Load the player's ship
        r = New Rectangle
        r.Y = Me.Height / 2
        r.X = Me.Width / 2
        r.Height = meRadius * 2
        r.Width = meRadius * 2
        ship.rect = r
        ship.visible = True

    End Sub

    Public Function generateSpeed(max As Integer) As Integer
        Dim n As Integer

        n = (Rnd() * max) - (max / 2)
        If Math.Abs(n) < max / 4 Then
            If n < 0 Then
                n = n - (max / 4)
            Else
                n = n + (max / 4)
            End If
        End If
        Return n

    End Function

    Private Sub tmrDropThrust_Tick(sender As Object, e As EventArgs) Handles tmrDropThrust.Tick
        thrust = thrust - 5
        If thrust <= 0 Then
            thrust = 0
        End If

    End Sub

    Private Sub frmAsteriods_KeyUp(sender As Object, e As KeyEventArgs) Handles Me.KeyUp
        If e.KeyCode = 39 Then
            pressingkeyright = False
        ElseIf e.KeyCode = 37 Then
            pressingkeyleft = False
        ElseIf e.KeyCode = 32 Then
            'fire = False
            Call fireBullet()
        ElseIf e.KeyCode = 38 Then
            pressingkeyup = False
        ElseIf e.KeyCode = 40 Then
            pressingkeydown = False
        End If

    End Sub

    Private Sub frmAsteriods_KeyDown(sender As Object, e As KeyEventArgs) Handles Me.KeyDown
        If e.KeyCode = 39 Then
            pressingkeyright = True
        ElseIf e.KeyCode = 37 Then
            pressingkeyleft = True
        ElseIf e.KeyCode = 32 Then
            'fire = True
        ElseIf e.KeyCode = 38 Then
            pressingkeyup = True
        ElseIf e.KeyCode = 40 Then
            pressingkeydown = True
        End If

    End Sub

    Private Sub frmAsteriods_Paint(sender As Object, e As PaintEventArgs) Handles Me.Paint
        Dim myPen As Pen
        myPen = New Pen(Drawing.Color.White, 1)
        Dim myGraphics As Graphics
        myGraphics = Me.CreateGraphics

        'draw asteroids
        For Each a In AsteroidList
            If a.visible = True Then
                myGraphics.DrawEllipse(myPen, a.rect)
            End If
        Next

        'draw bullets
        For Each b In BulletList
            If b.visible = True Then
                myGraphics.DrawEllipse(myPen, b.rect)
            End If
        Next


        'draw ship
        myGraphics.DrawEllipse(myPen, ship.rect)
        myGraphics.DrawLine(myPen, p1, p2)

    End Sub

    Private Sub tmrMoveEnemy_Tick(sender As Object, e As EventArgs) Handles tmrMoveEnemy.Tick

        Dim a As Asteroid

        'move each asteriod
        For Each a In AsteroidList

            'move the asteriod
            a.rect.X = a.rect.X + a.speedX
            a.rect.Y = a.rect.Y + a.speedY

            'check if it went off the screen (4 ways)
            'if it did, then reset it on the other side of the screen
            'off the left side?
            'off the right side?
            'off the top?
            'off the bottom?
            If a.rect.X < 0 Then
                a.rect.X = Me.Width
            ElseIf a.rect.X > Me.Width Then
                a.rect.X = 0
            ElseIf a.rect.Y < 0 Then
                a.rect.Y = Me.Height
            ElseIf a.rect.Y > Me.Height Then
                a.rect.Y = 0
            End If

        Next

        Me.Refresh()
        'Me.Invalidate()

    End Sub

    Private Sub tmrKeyPress_Tick(sender As Object, e As EventArgs) Handles tmrKeyPress.Tick

        If pressingkeyright = True Then
            degrees = degrees + DEGREE_SKIP
        ElseIf pressingkeyleft = True Then
            degrees = degrees - DEGREE_SKIP
        ElseIf pressingkeyup = True Then
            thrust = thrust + THRUST_SKIP
            If thrust > THRUST_MAX Then
                thrust = THRUST_MAX
            End If
        ElseIf pressingkeydown = True Then
            thrust = thrust - THRUST_SKIP * 2
            If thrust < 0 Then
                thrust = 0
            End If
        End If

        'If degrees >= 360 Then
        '    degrees = degrees Mod 360
        'ElseIf degrees < 0 Then
        '    degrees = 360 + degrees
        'End If


        radians = degrees * (PI / 180)
        'lblDegrees.Caption = degrees & " degrees"

        'NOTE:
        'Point (X1,Y1) never moves.  It is fixed at (3000,3000)
        'Point (X2,Y2) is the 2nd endpoint.
        'This one will get moved, to make the line appear to rotate

        'To determine X2, start with the X1 value,
        ' and ADD a certain amount based on the DEGREES  (using COS)
        p2.X = p1.X + (Math.Cos(radians) * GUN_LENGTH)
        'Line1.x2 = Line1.x1 + (Math.Cos(radians) * GUN_LENGTH)


        'To determine Y2, start with the Y1 value,
        'and add a certain amount based on the DEGREES  (using SIN)
        '
        'NOTE!! You need to subtract the sin adjustment b/c it's not a true x/y plane.
        'B/c in VB6, the Y gets higher when you go DOWN the screen
        p2.Y = p1.Y - (Math.Sin(radians) * GUN_LENGTH)
        'Line1.y2 = Line1.y1 - (Math.Sin(radians) * GUN_LENGTH)

        'move the ship
        ship.rect.Y = ship.rect.Y + thrust * Math.Cos(radians + (PI / 2))
        ship.rect.X = ship.rect.X + thrust * Math.Sin(radians + (PI / 2))
        p1.X = ship.rect.X + meRadius
        p1.Y = ship.rect.Y + meRadius

        'check if it went off the screen (4 ways)
        'if it did, then reset it on the other side of the screen
        'off the left side?
        If ship.rect.X < 0 Then
            ship.rect.X = Me.Width
            'off the right side?
        ElseIf ship.rect.X > Me.Width Then
            ship.rect.X = 0
            'off the top?
        ElseIf ship.rect.Y < 0 Then
            ship.rect.Y = Me.Height
            'off the bottom?
        ElseIf ship.rect.Y > Me.Height Then
            ship.rect.Y = 0
        End If


    End Sub
    Public Sub fireBullet()

        Dim r As Rectangle
        Dim b As Asteroid

        foundbullet = False
        For Each b In BulletList
            If b.visible = False Then
                b.visible = True
                b.rect.Y = p2.Y
                b.rect.X = p2.X
                b.speedX = bulletSpeedMult * Math.Sin(radians + (PI / 2))
                b.speedY = bulletSpeedMult * Math.Cos(radians + (PI / 2))
                foundbullet = True
                Exit For
            End If
        Next

        'if there are no bullets available, then load a new one (up to 3)
        If numbullets < MAX_BULLETS And foundbullet = False Then
            b = New Asteroid
            r = New Rectangle
            r.Y = p2.Y
            r.X = p2.X
            r.Height = bulletRadius * 2
            r.Width = bulletRadius * 2
            b.rect = r
            b.speedX = bulletSpeedMult * Math.Sin(radians + (PI / 2))
            b.speedY = bulletSpeedMult * Math.Cos(radians + (PI / 2))
            b.visible = True
            BulletList.Add(b)
            numbullets = numbullets + 1
        End If


    End Sub


    Private Sub tmrmovebullet_Tick(sender As Object, e As EventArgs) Handles tmrmovebullet.Tick
        For Each b In BulletList
            If b.visible = True Then
                b.rect.X = b.rect.X + b.speedX
                b.rect.Y = b.rect.Y + b.speedY
            End If

            'if the bullet is off the screen, then hide it
            If OffScreen(b.rect) Then
                b.visible = False
            End If
        Next

    End Sub


    Public Function OffScreen(r As Rectangle) As Boolean

        If r.X < 0 Or r.X > Me.Width Or r.Y < 0 Or r.Y > Me.Height Then
            Return True
        Else
            Return False
        End If

    End Function

    Public Sub resetScreen()

        For Each a In AsteroidList
            a.visible = True
            a.rect.Y = Int(Rnd() * Me.Height)
            a.rect.X = Int(Rnd() * Me.Width)
        Next
        ship.visible = True

    End Sub

    Private Sub tmrDetectHit_Tick(sender As Object, e As EventArgs) Handles tmrDetectHit.Tick
        Dim acx As Integer
        Dim acy As Integer
        Dim bcx As Integer
        Dim bcy As Integer
        Dim d As Single

        For Each a In AsteroidList
            acx = a.rect.X + asteriodRadius
            acy = a.rect.Y + asteriodRadius

            'check EACH bullet (x), against hitting EACH rock (y)
            For Each b In BulletList
                bcx = b.rect.X + bulletRadius
                bcy = b.rect.Y + bulletRadius
                d = distance(acx, acy, bcx, bcy)

                If (d < asteriodRadius + bulletRadius) And a.visible = True And b.visible = True Then
                    a.visible = False
                    b.visible = False
                    score = score + 1
                    lblScore.Text = score
                End If
            Next

            'is it hitting me?
            bcx = ship.rect.X + meRadius
            bcy = ship.rect.Y + meRadius
            d = distance(acx, acy, bcx, bcy)

            If (d < asteriodRadius + meRadius) And a.visible = True And ship.visible = True Then
                ship.visible = False
                MsgBox("DEAD")
                score = 0
                lblScore.Text = score
                thrust = 0
                Call resetScreen()
                pressingkeyright = False
                pressingkeyleft = False
                pressingkeydown = False
                pressingkeyup = False
            End If

        Next
    End Sub

    Public Function levelOver() As Boolean

        'if there are ANY visible asteriods,
        'then the level is NOT over

        For Each a In AsteroidList
            If a.visible = True Then
                Return False
            End If
        Next
        Return True

    End Function

    Private Sub tmrCheckNewLevel_Tick(sender As Object, e As EventArgs) Handles tmrCheckNewLevel.Tick
        If levelOver() = True Then
            Call resetScreen()
        End If

    End Sub

End Class