Space shooter demo

This was a *terrible* little game I made up out of boredom. It uses my starfield module for the background, and some picture boxes for the graphics... this is probably the worst way to do it...but it works...just.

Download the exe and form templates here

This goes on Form1
Dim Speed As Integer
Dim Score As Integer
Dim Lives As Integer
Dim Firepower As Integer

Private Sub Form_Load()
  'Set starfield variables
  NumberOfStars = 50
  Levels = 5
  'Initialise game variables
  Speed = 2
  Score = 0
  Lives = 3
  Firepower = 100
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, x As Single, y As Single)
  'When the mousebutton is down
  'If you have firepower left then show the laser
  If Firepower > 0 Then Line1.Visible = True
End Sub

Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
  'When you move the mouse
  'Move the middle of your ship to the mouse Y value
  Picture1.Top = y - Picture1.Height / 2
  'Move the laser to the middle if your ship
  With Line1
    .Y1 = Picture1.Top + 8
    .Y2 = .Y1
  End With
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, x As Single, y As Single)
  'When you stop pressing the mouse button
  'Hide the laser
  Line1.Visible = False
End Sub

Private Sub Form_Resize()
  'When the form maximisies
  'Draw starfield
  InitialiseStarField Form1
  'Position on-form components
  With Line1
    .X1 = Picture1.Left + Picture1.Width
    .X2 = Form1.ScaleWidth
  End With
  With Label3
    .Left = Form1.ScaleWidth - .Width
    .Top = Form1.ScaleHeight - .Height
  End With
  With Label2
    .Left = Label3.Left - .Width
    .Top = Form1.ScaleHeight - .Height
  End With
  With Label1
    .Left = Label2.Left - .Width
    .Top = Form1.ScaleHeight - .Height
  End With
  Picture2.Left = Form1.ScaleWidth
End Sub

Private Sub Timer1_Timer()
  'Update the star field
  KillStars Form1
  MoveStars Form1, "Left", 1
  DrawStars Form1
  'Hide the laser if you have run out of firepower
  If Firepower < 0 Then Line1.Visible = False
End Sub

Private Sub Timer2_Timer()
  'See if you have shot the enemy
  ShotCheck
  'Move the enemy
  MoveEnemy
  'See if the enemy has hit you
  CollisionCheck
  'If the laser is firing then
  If Line1.Visible = True Then
    'Take away 1 Firepower point
    Firepower = Firepower - 1
    'Update the Firepower display
    Label3 = "Firepower: " & Firepower
    'If you have run out of firepower then
    If Firepower = 0 Then
      'Display "Game Over" screen
      Load Form2
      Form2.Label2 = "Out of Firepower."
      Form2.Label5 = "Score: " & Score
    End If
  End If
End Sub
Private Sub MoveEnemy()
  'Move the enemy ship left (Speed) units
  Picture2.Left = Picture2.Left - Speed
  'If the enemy is off the screen then
  If Picture2.Left + Picture2.Width < 0 Then
    'Place the enemy off the screen at the other side
    'so it will come around again in a different position
    With Picture2
      .Left = Form1.ScaleWidth + Rnd * 50
      .Top = Rnd * Form1.ScaleHeight - .Width / 2
    End With
  End If
End Sub
Private Sub ShotCheck()
  'If the laser is firing then
  If Line1.Visible = True Then
    'If the laser Y value is within the enemy's Y range then
    If Line1.Y2 > Picture2.Top And Line1.Y2 < Picture2.Top + Picture2.Height Then
      'Move the enemy back to beyond the edge of the screen
      'and at a different height
      With Picture2
        .Left = Form1.ScaleWidth + Rnd * 50
        .Top = Rnd * Form1.ScaleHeight - .Height / 2
      End With
      'Increase the score depending on the speed of the ship
      Score = Score + Speed
      'Increase the speed for the next ship
      Speed = Speed + 1
      'Update score display
      Label1 = "Score: " & Score
      'Give 10 extra Firepower points
      Firepower = Firepower + 10
      'Update Firepower display
      Label3 = "Firepower: " & Firepower
    End If
  End If
End Sub

Private Sub CollisionCheck()
  'If the enemy is further left than your ship's right edge then
  If Picture2.Left < Picture1.Left + Picture1.Width Then
    'If your ship's bottom is lower than the enemy's top,
    'and your ship's top is higher than the enemy's bottom then lose a life
    If Picture1.Top + Picture1.Height > Picture2.Top And Picture1.Top < Picture2.Top + Picture2.Height Then Lose
  End If
End Sub
Public Sub Lose()
  'Take away 1 life
  Lives = Lives - 1
  'Update Lives display
  Label2 = "Lives: " & Lives
  'Put the enemy back off the edge of the screen
  With Picture2
    .Left = Form1.ScaleWidth + Rnd * 50
    .Top = Form1.ScaleHeight - .Height / 2
  End With
  'If you have no more lives then
  If Lives < 0 Then
    'Display "Game Over" screen
    Load Form2
    Form2.Label2 = "Dead."
    Form2.Label5 = "Score: " & Score
  End If
End Sub

This goes on Form2


'Declare the function used to keep the window on top
Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long

Private Sub Form_Load()
  'Keep window on top (used raw values cos it was less hassle)
  SetWindowPos Me.hwnd, -1, 0, 0, 0, 0, &H2 Or &H1
  'Show the form
  Me.Show
End Sub

Private Sub Label3_Click()
  'When you click the Play Again 'button'
  'Reload Form1
  Unload Form1
  Load Form1
  Form1.Show
  'Close this form
  Unload Me
End Sub

Private Sub Label4_Click()
  'When you click the Exit 'button'
  'Unload both forms
  Unload Form1
  Unload Me
  'End the program
  End
End Sub


This is the stars module

'Dynamic array to hold stars
Dim Stars() As Single
'Public variables so they can be set from outside the module
Public NumberOfStars As Integer
Public Levels As Integer

'Initialises the star field on the object passed
Public Sub InitialiseStarField(TargetObject As Object)
  'Redimention stars array to have 3 (0-2) values for each star
  ReDim Stars(NumberOfStars, 2)

  'Set graphic attributes for the target object
  With TargetObject
    .BackColor = vbBlack
    .ForeColor = vbWhite
    .AutoRedraw = True
  End With

  'Populate stars array with stars
  For n = 0 To NumberOfStars
    'For every star in the array
    Randomize
    'Stars(n,0) is the parallax level of the star (0 - Levels)
    'Set random level
    Stars(n, 0) = (Rnd * Levels)
    Randomize
    'Stars(n,1) is the X coordinate
    'Set to a random position inside the form (0 - Width of form)
    Stars(n, 1) = (Rnd * Form1.ScaleWidth)
    Randomize
    'Stars(n,2) is the Y coordinate
    'Set to a random position inside the form (0 - Height of form)
    Stars(n, 2) = (Rnd * Form1.ScaleHeight)
  Next n
  'Draw the star field
  DrawStars TargetObject
End Sub

'Moves stars. Is passed TargetObject for wrapping measurement.
Public Sub MoveStars(TargetObject As Object, Direction As String, Amount As Integer)
  'Find out what direction to move the stars
  Select Case Direction
    Case "Right"
      'For each star
      For n = 0 To NumberOfStars
        'Star X coord = Star X coord + (Parallax level * Amount)
        'Results in higher parallax level moving more, therefore appearing closer
        Stars(n, 1) = Stars(n, 1) + Stars(n, 0) * Amount
        'If the X coord is more than the object width then wrap the star around to the other side of the object
        If Stars(n, 1) > TargetObject.ScaleWidth Then Stars(n, 1) = 0
      Next n
    Case "Left"
      'Same as Right, but the other way round
      For n = 1 To NumberOfStars
        Stars(n, 1) = Stars(n, 1) - Stars(n, 0) * Amount
        If Stars(n, 1) < 0 Then Stars(n, 1) = TargetObject.ScaleWidth
      Next n
    Case "Up"
      'Same as Left/Right but with Y and object height
      For n = 1 To NumberOfStars
        Stars(n, 2) = Stars(n, 2) - Stars(n, 0) * Amount
        If Stars(n, 2) < 0 Then Stars(n, 2) = TargetObject.ScaleHeight
      Next n
    Case "Down"
      For n = 1 To NumberOfStars
        Stars(n, 2) = Stars(n, 2) + Stars(n, 0) * Amount
        If Stars(n, 2) > TargetObject.ScaleHeight Then Stars(n, 2) = 0
      Next n
  End Select
End Sub
Public Sub KillStars(TargetObject As Object)
  For n = 1 To NumberOfStars
    'For each star, draw it black, so it disappears
    'Must be called before MoveStars
    TargetObject.PSet (Stars(n, 1), Stars(n, 2)), vbBlack
  Next n
End Sub
Public Sub DrawStars(TargetObject As Object)
  For n = 1 To NumberOfStars
    'For each star, draw it white, so it appears.
    TargetObject.PSet (Stars(n, 1), Stars(n, 2)), vbWhite
  Next n
End Sub