'General Declaration Area
Dim PlanetDir As Integer
Dim A As Integer
Dim B As Integer
Dim C As Integer
Dim D As Integer
Dim E As Integer
Dim F As Integer
Dim G As Integer
Dim H As Integer
Dim I As Integer
Dim J As Integer
Dim K As Integer
Dim L As Integer
Dim M As Integer
Dim N As Integer
Dim O As Integer
Dim P As Integer
Dim Q As Integer
Dim minenumber As Integer
Dim lives As Integer
Dim Downspeed As Integer
Dim sidespeed As Integer
Dim Score As Integer
Dim misslenumber As Integer
Dim DifficultyLevel As Integer
Dim minesdir As Integer
Private Sub PictField_load()
'Set Pictfield as the focus.
PictField.SetFocus
End Sub
Private Sub CmdMine_Click()
'Check if the maximum limit of mines on the field has been reached. If so, then ignore user pushing the button.
If minenumber < 10 Then
'Place the mine on the map slightly ahead of the ship.
mine(minenumber).Visible = True
mine(minenumber).Move (Picship.Left + Picship.Width / 2), (Picship.Top - 500 + Int(Rnd * 300))
'Add to current amount of mines on the field.
minenumber = minenumber + 1
'Show user that he has less mines now.
lblmines.Caption = lblmines.Caption - 1
End If
End Sub
'Move the Ship to the left with the Command Button.
Private Sub CmdMoveleft_Click()
For A = 1 To 10
Picship.Move Picship.Left - 10, Picship.Top
Next A
End Sub
'Move the Ship to the right with the Command Button.
Private Sub CmdMoveright_Click()
For B = 1 To 10
Picship.Move Picship.Left + 10, Picship.Top
Next B
End Sub
'Restock your ammo supply. Resetting the counters.
Private Sub cmdrestockammo_Click()
lblscore.Text = lblscore.Text - 1000
misslenumber = 0
lblammoleft.Caption = 100 - misslenumber
End Sub
Private Sub cmdspecial_Click()
If specialsleft.Caption >= 1 Then
'Subtract one from the count
specialsleft.Caption = specialsleft.Caption - 1
'Move and make the laser visible and set it to strechable, then shrink it.
speciallaser.Visible = True
speciallaser.Stretch = True
speciallaser.Height = 100
'Make the laser appear in the center of the ship.
speciallaser.Move (Picship.Left + speciallaser.Width - (Picship.Width / 2)), (Picship.Top - speciallaser.Height + 50)
End If
End Sub
'Move the ship to the left or the right with the keyboard.
Private Sub Pictfield_keydown(Keycode As Integer, Shift As Integer)
Select Case Keycode
Case vbKeyRight
For B = 1 To 10
Picship.Move Picship.Left + 10, Picship.Top
Next B
'If the ship goes off the right of the screen, move it back to the otherside.
If Picship.Left + 1 > PictField.ScaleWidth Then
Picship.Move 0, 6360
End If
Case vbKeyLeft
For A = 1 To 10
Picship.Move Picship.Left - 10, Picship.Top
Next A
'If the ship goes off the left of the screen, move it to the otherside..
If Picship.Left < 0 Then
Picship.Move Picship.Left + PictField.ScaleWidth, 6360
End If
'Move a missle to the center of the ship,make it visible, fire it and Deplete its ammo count.
Case vbKeyUp
If misslenumber = 100 Then
MsgBox "Game Over you are out of ammo!", vbOKOnly, "UhOh!"
End
misslenumber = 0
Score = 0
End If
picfire(misslenumber).Move (Picship.Left + Picship.Width / 2), (Picship.Top + Picship.Height / 2)
picfire(misslenumber).Visible = True
misslenumber = misslenumber + 1
lblammoleft.Caption = lblammoleft.Caption - 1
lblscore.Text = lblscore.Text + 10
End Select
End Sub
Private Sub cmdexitgame_Click()
'End the Program
End
End Sub
Private Sub Form_Load()
'Load pic of planet
Picplanet.Picture = LoadPicture(App.Path & "\planet.gif")
speciallaser.Picture = LoadPicture(App.Path & "\special2.gif")
'Generate Random Numbers
Randomize
'Load Picture of the Planet and set its position. then begin its motion.
Picplanet.Move 0, 6840
timerplanet.Enabled = True
PlanetDir = 1
'Load Picture of the Ship and set position.
Picship.Move 2640, 6360
'Load Pictures of the laser and set the position and make them invisible
For C = 0 To 99
picfire(C).Move 0, 0
picfire(C).Visible = False
picfire(C).Picture = LoadPicture(App.Path & "\laser.gif")
Next C
misslenumber = 0
'Move the asteroid pictures and make them invisible.
For G = 0 To 24
PicAst(G).Move 0, 0
PicAst(G).Visible = False
Next G
'Set Starting lives as 3
lives = 3
'Move laser attack image.
speciallaser.Move 0, 0
speciallaser.Visible = False
'Load the mines and make them invisible
For O = 0 To 9
mine(O).Move 0, 0
mine(O).Visible = False
mine(O).Picture = LoadPicture(App.Path & "\mine.gif")
Next O
'Set Starting value for the mines
minenumber = 0
'Set Starting Direction for the mines
minesdir = 1
End Sub
Private Sub timerast_Timer()
'Move the asteroids down in a random fashion
For K = 0 To 24
If PicAst(K).Visible = True Then
PicAst(K).Move PicAst(K).Left + Int(Rnd * 50 - 25), PicAst(K).Top + (Int(Rnd * 50) + (DifficultyLevel * 2))
'Detect If asteroid has hit the planet, if the planet is hit, subtract one life and move all the asteroids back to start default position.
If (PicAst(K).Left + PicAst(K).Width) > Picplanet.Left Then
If PicAst(K).Left < (Picplanet.Left + Picplanet.Width) Then
If (PicAst(K).Top + PicAst(K).Height) > Picplanet.Top Then
If PicAst(K).Top < (Picplanet.Top + Picplanet.Height) Then
Beep
lives = lives - 1
'Check if there are no lives remaining, if that is the case, inform the player of his score and end the program.
If lives = 0 Then
MsgBox "Game over, your score is" & Str(lblscore.Text), vbOKOnly, "The Planet is destroyed."
End
End If
For L = 0 To 24
PicAst(L).Move 0, 0
PicAst(L).Visible = False
Next L
lbllives.Caption = lbllives.Caption - 1
End If
End If
End If
End If
End If
Next K
End Sub
Private Sub timerlaser_Timer()
If speciallaser.Visible = True Then
'Begin to move and stretch the laser
speciallaser.Top = speciallaser.Top - 100
speciallaser.Height = speciallaser.Height + 75
speciallaser.Width = speciallaser.Width + 50
speciallaser.Left = speciallaser.Left - 25
'Check for collision detection on the asteroids
For N = 0 To 24
If (speciallaser.Left + speciallaser.Width) > PicAst(N).Left Then
If speciallaser.Left < (PicAst(N).Left + PicAst(N).Width) Then
If (speciallaser.Top + speciallaser.Height) > PicAst(N).Top Then
If speciallaser.Top < (PicAst(N).Top + PicAst(N).Height) Then
'Move the asteroid back to hiding.
PicAst(N).Move 0, 0
PicAst(N).Visible = False
'Update the score
lblscore.Text = lblscore.Text + (DifficultyLevel * 100)
End If
End If
End If
End If
Next N
'Remove the laser after it becomes big enough
If speciallaser.Height > PictField.Height Then
speciallaser.Visible = False
speciallaser.Height = 100
speciallaser.Move 0, 0
speciallaser.Width = 150
End If
End If
End Sub
Private Sub timermines_Timer()
'Move the mines to the left and the right bouncing off the edges.
For P = 0 To 9
If mine(P).Visible = True Then
mine(P).Move mine(P).Left + minesdir * PictField.ScaleWidth / 100, mine(P).Top
If (mine(P).Left + mine(P).Width) > PictField.ScaleWidth Then
mine(P).Left = PictField.ScaleWidth - mine(P).Width
minesdir = -1
ElseIf mine(P).Left < 0 Then
mine(P).Left = 0
minesdir = 1
End If
'Detect Collisions
For Q = 0 To 24
If (mine(P).Left + mine(P).Width) > PicAst(Q).Left Then
If mine(P).Left < (PicAst(Q).Left + PicAst(Q).Width) Then
If (mine(P).Top + mine(P).Height) > PicAst(Q).Top Then
If mine(P).Top < (PicAst(Q).Top + PicAst(Q).Height) Then
'If collision is detected, move away both images and adjust score.
mine(P).Move 0, 0
mine(P).Visible = False
PicAst(Q).Move 0, 0
PicAst(Q).Visible = False
lblscore.Text = lblscore.Text + (DifficultyLevel * 1)
End If
End If
End If
End If
Next Q
End If
Next P
End Sub
'Moves the missles and checks for collisions, also removes missles that go off screen by resetting them to default position.
Private Sub timermissle_Timer()
For E = 0 To 99 Step 1
If picfire(E).Visible = True Then
For F = 0 To 100 Step 1
picfire(E).Top = picfire(E).Top - 1
For M = 0 To 24
If (picfire(E).Left + picfire(E).Width) > PicAst(M).Left Then
If picfire(E).Left < (PicAst(M).Left + PicAst(M).Width) Then
If (picfire(E).Top + picfire(E).Height) > PicAst(M).Top Then
If picfire(E).Top < (PicAst(M).Top + PicAst(M).Height) Then
picfire(E).Move 0, 0
picfire(E).Visible = False
PicAst(M).Move 0, 0
PicAst(M).Visible = False
lblscore.Text = lblscore.Text + (DifficultyLevel * 1)
End If
End If
End If
End If
Next M
If picfire(E).Top < PictField.Top Then
picfire(E).Move 0, 0
picfire(E).Visible = False
End If
Next F
End If
Next E
End Sub
Private Sub timerplanet_Timer()
'Ensure that Pictfield is always the focus
PictField.SetFocus
'Move the planet along the bottom left and right of the screen bouncing off the edges.
Picplanet.Move Picplanet.Left + PlanetDir * PictField.ScaleWidth / 100, Picplanet.Top
If (Picplanet.Left + Picplanet.Width) > PictField.ScaleWidth Then
Picplanet.Left = PictField.ScaleWidth - Picplanet.Width
PlanetDir = -1
ElseIf Picplanet.Left < 0 Then
Picplanet.Left = 0
PlanetDir = 1
End If
End Sub
Private Sub TimerSeconds_Timer()
'Count up to 60 seconds, once 60 seconds has gone by, increase the difficulty level.
lbltimegone1.Caption = lbltimegone1.Caption + 1
J = J + 1
If J = 60 Then
DifficultyLevel = DifficultyLevel + 1
specialsleft.Caption = specialsleft.Caption + 1
minenumber = 0
lblmines.Caption = 10
Beep
End If
End Sub
Private Sub timerspawn_Timer()
DifficultyLevel = 1
'Move to asteroids to their starting positions, time based on current difficultylevel.
timerspawn.Interval = 1000 / DifficultyLevel
PicAst(H).Move Int(Rnd * PictField.ScaleWidth + 1), 5
PicAst(H).Visible = True
H = H + 1
'Make the Cycle Continious
If H + 1 > 24 Then
H = 0
PicAst(H).Move 0, 0
PicAst(H).Visible = False
End If
End Sub