射击游戏

开发平台：

Visual Basic

FormBW.frm：源码内容

Kind As Integer 'Image List Index Number
Bul_Kind As Integer 'Bullet Kind
Frame As Integer 'Image Index
BullType As Integer 'Bullets Shot
PosX As Integer 'Current X Coordinate
PosY As Integer 'Current Y Coordinate
DestX As Integer 'Destination X Coordiante
DestY As Integer 'Destination Y Coordiante
Span As Integer 'For Event counter
Patt As Integer 'Movement Pattern
Spd As Integer 'Move Speed
Life As Integer 'Hit Points
Max_Life As Integer 'For BOSS's Life Bar Calculation
Score As Integer 'Worth of Points
Has_Bonus As Boolean 'Whether Ship has BoNUS =)
Firing_Patt As Integer 'Firing Pattern
Boss As Boolean 'Whether it's a boss or not
End Type
Dim EBull(200) As EBullet
Dim EShip(40) As EnemyShip '38,39,40 for BOSS
Private Sub Form_GotFocus() 'Returns Focus to picboxes
'If the player accidentally clicked the mouse on the form,
'focus is returned to the current layer, so that keydown events
'are still acknowledged.
If MenuMode_Enabled = True Then
Menu_Layer.SetFocus
End If
If RemapMode_Enabled = True Then
Remap_Layer.SetFocus
End If
If GameMode_Enabled = True Then
Game_Layer.SetFocus
End If
If PlayMode_Enabled = True Then
Play_Layer.SetFocus
End If
If PauseMode_Enabled = True Then
Pause_Layer.SetFocus
End If
End Sub
Private Sub Form_Load()
'This sub basically set's the layers, menus, labels, bars,
'to their correct position. Dun mess this part.
Dim i As Integer
Wait_label2.Visible = True
Wait_label2.Top = 4320
Wait_label2.Left = 2520
FormBW.BackColor = &H80000012
FormBW.Width = 5010 'Set Form Size
FormBW.Height = 6990 '
Menu_Layer.Width = 4920 '
Menu_Layer.Height = 6490 '
Menu_Layer.Left = 0 '
Menu_Layer.Top = 0 '
Remap_Layer.Width = 4920 '
Remap_Layer.Height = 6490 '
Remap_Layer.Left = 0 '
Remap_Layer.Top = 0 '
Game_Layer.Width = 4920 '
Game_Layer.Height = 6490 '
Game_Layer.Left = 0 '
Game_Layer.Top = 0 '
Play_Layer.Width = 6375 '
Play_Layer.Height = 8655 '
Play_Layer.Left = -720 '
Play_Layer.Top = -1440 '
Pause_Layer.Width = 2895 '
Pause_Layer.Height = 2055 '
Pause_Layer.Left = 1080 '
Pause_Layer.Top = 2040 '
'Set the speed optimization
tmMenu.Interval = FormOptimize.Sldr_ms.Value
tmOneFrame.Interval = FormOptimize.Sldr_ms.Value
tmIntro.Interval = FormOptimize.Sldr_ms.Value * 10
tmMenu.Interval = FormOptimize.Sldr_ms.Value
If FormOptimize.Opt_Detail(0).Value = True Then Detail_Level = 50
If FormOptimize.Opt_Detail(1).Value = True Then Detail_Level = 400
If FormOptimize.Opt_Detail(2).Value = True Then Detail_Level = 1000
'Sets the currently enabled mode to MENU
MenuMode_Enabled = True
GameMode_Enabled = False
RemapMode_Enabled = False
PlayMode_Enabled = False
PauseMode_Enabled = False
For i = 0 To 5 'Initialize ship's Configuration
SHP(i) = 0
Call LoadWbox(i, 0)
Next i
Call Load_Keys
Call Load_Sounds
Call Load_Graphics
Call Wait(1, 1) 'Call main menu
Call Load_Intro
End Sub
Private Sub MainMenu() '>>>MAIN MENU<<<
Dim i As Integer
'Aligns all the cursor to recognize the options available
'on the main menu. there are 3 items (start, options, quit),
'so the array begins with 0 and end with 2.
'The third number is the cursor's current position,
'which is default on 'Start Game' (0)
'There are six coloured cursors, so the last 2 number
'represents the start index(0) and end index(5)
'also related to tracking sub later.
Call Set_Curr(0, 2, 0, 0, 5)
'Positions the menu in the correct places.
For i = Curr_Start To Curr_End 'Align menus
menu(i).Left = 1370
menu(i).Top = 4840 + (i * 400)
Next i
Call Align_Curr
Wait_Label.Visible = False
tmMenu.Enabled = True
Call PLAY(2) 'Load BGM
End Sub
Private Sub RemapMenu() '>>>REMAP MENU<<<
WaitForRemap = False
'Same as above, 10 options available (9-18)
'Default on 9
'Another six coloured cursor (6-11)
Call Set_Curr(9, 18, 9, 6, 11)
Call Align_Curr
Call Load_Keys
End Sub
Private Sub GameMenu() '>>>GAME MENU<<<
'Left and right selection not available
'Default only recognize up and down
MenuSelectLR = False
Call Set_Curr(19, 26, 19, 12, 17)
Call Align_Curr
'Aligns weapon display boxes
Weapon_Box.Width = 2255
Weapon_Box.Height = 2175
Weapon_Box.Left = 2480
Weapon_Box.Top = 3375
Weapon_Box.BorderStyle = 0
End Sub
Private Sub PlayMenu() '>>>PLAY MENU<<<
'This is a large sub here. Basically when a new game starts,
'all the bars and HUDs needs to be realigned.
'The following codes basically sets their top, left, width, height...
Dim i As Integer
Const LH = 255 'Label Height
Const LW = 615 'Label Width
'A new game ...
If GameStarted = False Then
Elasped = 0
TotFPS = 0
BossBar.Top = 1080
Stats_Bar.Top = 7920
Stats_Bar.Left = 720
Stats_Bar.Height = 975
Stats_Bar.Width = 4935
Stats_Bar.Visible = False
Stt_SHD_Lbl.Top = 0
Stt_SHD_Lbl.Left = 0
Stt_SHD_Lbl.Height = LH
Stt_SHD_Lbl.Width = 495
Stt_SHD_Lbl.BackColor = &H0&
Stt_SHD_Lbl.ForeColor = &HFF00&
Stt_SPE_Lbl.Top = 240
Stt_SPE_Lbl.Left = 0
Stt_SPE_Lbl.Height = LH
Stt_SPE_Lbl.Width = 495
Stt_SPE_Lbl.BackColor = &H0&
Stt_SPE_Lbl.ForeColor = &HFF00&
Stt_LVL_MG.Top = 0
Stt_LVL_MG.Left = 2880
Stt_LVL_MG.Height = LH
Stt_LVL_MG.Width = 855
Stt_LVL_SG.Top = 240
Stt_LVL_SG.Left = 2880
Stt_LVL_SG.Height = LH
Stt_LVL_SG.Width = 855
Stt_MGUN_F.Top = 0
Stt_MGUN_F.Left = 3720
Stt_MGUN_F.Height = LH
Stt_MGUN_F.Width = LW
Stt_SGUN_F.Top = 240
Stt_SGUN_F.Left = 3720
Stt_SGUN_F.Height = LH
Stt_SGUN_F.Width = LW
Stt_ENG_F.Top = 0
Stt_ENG_F.Left = 4320
Stt_ENG_F.Height = LH
Stt_ENG_F.Width = LW
Stt_PWR_F.Top = 240
Stt_PWR_F.Left = 4320
Stt_PWR_F.Height = LH
Stt_PWR_F.Width = LW
Stt_MGUN_R.Top = 0
Stt_MGUN_R.Left = 3720
Stt_MGUN_R.Height = LH
Stt_MGUN_R.Width = LW
Stt_SGUN_R.Top = 240
Stt_SGUN_R.Left = 3720
Stt_SGUN_R.Height = LH
Stt_SGUN_R.Width = LW
Stt_ENG_R.Top = 0
Stt_ENG_R.Left = 4320
Stt_ENG_R.Height = LH
Stt_ENG_R.Width = LW
Stt_PWR_R.Top = 240
Stt_PWR_R.Left = 4320
Stt_PWR_R.Height = LH
Stt_PWR_R.Width = LW
BAR_SHD_C.Top = 30
BAR_SHD_C.Left = 540
BAR_SHD_C.Height = 75
BAR_SHD_C.Width = 2175
BAR_SHD_R.Top = 90
BAR_SHD_R.Left = 540
BAR_SHD_R.Height = 75
BAR_SHD_R.Width = 2175
BAR_SPE_C.Top = 270
BAR_SPE_C.Left = 540
BAR_SPE_C.Height = 75
BAR_SPE_C.Width = 2175
BAR_SPE_R.Top = 330
BAR_SPE_R.Left = 540
BAR_SPE_R.Height = 75
BAR_SPE_R.Width = 2175
For i = 1 To 4
Bufferbox(i).Top = 2880 + ((i - 1) * 360)
Bufferbox(i).Left = 1080
Bufferbox(i).Width = 15
BufferText(i).Caption = ""
Next i
Bufferbox(0).Top = Bufferbox(1).Top
Bufferbox(0).Left = Bufferbox(1).Left
Bufferbox(0).Width = Bufferbox(1).Width
BufferText(0).Caption = BufferText(1).Caption
Bufferbox(6).Top = 1080
Bufferbox(6).Left = 3840
Bufferbox(5).Top = 1080
Bufferbox(5).Left = 840
BufferText(6).Caption = "000000"
Buffer_Count = 0
Lock_All = True
Lock_Engine = False
Lock_Generator = False
Lock_MainGun = False
Lock_SideGun = False
ShipX = 2720
ShipY = 8440
Ship_Dir = 0
For i = 0 To 3
Ship_Moving(i) = False 'All directions null
Next i
For i = 0 To 300
Bull(i).Used = False 'Initialized bullets to unused
Next i
For i = 0 To 200
EBull(i).Used = False 'Initialize bullets to unused
Next i
MG_Lvl = 1
SG_Lvl = 1
SHD_Avail = True
SPE_Avail = True
Select Case (SHP(2)) 'Setting Special
Case 0:
SPE_Width = 435
BAR_SPE_C.Width = 435
BAR_SPE_R.Width = 435
Case 1:
SPE_Width = 870
BAR_SPE_C.Width = 870
BAR_SPE_R.Width = 870
Case 2:
SPE_Width = 1305
BAR_SPE_C.Width = 1305
BAR_SPE_R.Width = 1305
Case 3:
SPE_Width = 1740
BAR_SPE_C.Width = 1740
BAR_SPE_R.Width = 1740
Case 4:
SPE_Width = 2175
BAR_SPE_C.Width = 2175
BAR_SPE_R.Width = 2175
End Select
Select Case (SHP(3)) 'Setting Shields
Case 0:
SHD_Width = 435
BAR_SHD_C.Width = 435
BAR_SHD_R.Width = 435
SHD_Charge_Base = 7
Case 1:
SHD_Width = 870
BAR_SHD_C.Width = 870
BAR_SHD_R.Width = 870
SHD_Charge_Base = 6
Case 2:
SHD_Width = 1305
BAR_SHD_C.Width = 1305
BAR_SHD_R.Width = 1305
SHD_Charge_Base = 5
Case 3:
SHD_Width = 1740
BAR_SHD_C.Width = 1740
BAR_SHD_R.Width = 1740
SHD_Charge_Base = 4
Case 4:
SHD_Width = 2175
BAR_SHD_C.Width = 2175
BAR_SHD_R.Width = 2175
SHD_Charge_Base = 3
End Select
Repair_Speed = 2 'BASE VALUE
SHD_Charging = False
SPE_Charging = False
'Sets the speed of the ship based on the engines chosen
Select Case (SHP(5)) 'ENGINE - Affects Repair
Case 0:
Ship_Speed = 80
Repair_Speed = Repair_Speed + 10
Case 1:
Ship_Speed = 100
Repair_Speed = Repair_Speed + 8
Case 2:
Ship_Speed = 130
Repair_Speed = Repair_Speed + 6
Case 3:
Ship_Speed = 160
Repair_Speed = Repair_Speed + 4
End Select
For i = 1 To 40
EShip(i).Used = False
Next i
Stt_LVL_MG.Caption = "MG 1.0"
Stt_LVL_SG.Caption = "SG 1.0"
'This is for initialization of the stars in the background
For i = 0 To Detail_Level 'For stars
Star(i).PosX = (Rnd * 4920 + 720)
Star(i).PosY = (Rnd * 6480 + 1440)
Star(i).Spd = (Rnd * 40 + 10)
Star(i).Color = (Rnd * 2 + 1)
Next i
For i = 0 To 2
PowerUp(i).Used = False
Next i
'This are all (mostly) the variables that will be used
'during playing mode. Description is above in the
'declaration section
Play_Layer.BackColor = &H0&
MG_Lvl = 1
SG_Lvl = 1
Bull_Delay = 0
Bull_Delay2 = 0
Ship_Firing = False
GameStarted = True
GameScore = 0
SHIELD_ON_OFF = 0
ShakeIT = 0
Wait_label2.Visible = False
Moving_StatsBar = 0
Moving_SpecialBar = 0
Moving_BossBar = 0
Special_Running = False
Special_Delay = 0
GEC = 0
KillCount = 0
KilledBoss = False
Giga_Count = 0
'Resets all stage counters to 0
For i = 0 To 4
C_GEC(i) = 0
Next i
'Load explosion sounds into media players
For i = 0 To 3
MPS(i).Open (App.Path & "soundsplode.wav")
Next i
'Load explosion sounds into media players
For i = 4 To 7
MPS(i).Open (App.Path & "soundbplode.wav")
Next i
End If
TotFPS = 0
Elasped = 0
tmOneFrame.Enabled = True 'Officially Starts the Game!
tmOneSecond = True 'This is for FPS counting
End Sub
Private Sub PauseMenu() '>>>PAUSE MENU<<<
Dim i As Integer
Call Set_Curr(27, 29, 27, 18, 23)
Call Align_Curr
'HALTS the ship during pause
For i = 0 To 3
Ship_Moving(i) = False
Next i
'Halts firing too.
Ship_Firing = False
End Sub
Private Sub Set_Curr(C_Start As Integer, C_End As Integer, C_Pos As Integer, C_From As Integer, C_To As Integer)
'This basically tells the tmMenu_Timer what
'are the menus that will be used in the current layer.
'Explained above during the first call of Set_Curr
Curr_Start = C_Start
Curr_End = C_End
Curr_Pos = C_Pos
Curr_From = C_From
Curr_To = C_To
End Sub
Private Sub Align_Curr() 'Aligns Cursor
'Aligns the cursors to the option selection boxes
Dim i As Integer
For i = Curr_From To Curr_To
Curr(i).Left = menu(Curr_Start).Left
Curr(i).Width = menu(Curr_Start).Width
Next i
'Call the cursor to move to the top selection box
Call TrackMenu(menu(Curr_Start).Top, Curr_From, Curr_From) 'Track to 1st item
'Changes color of the text
Call Change_Text(Curr_Start) 'Change color of 1st item
End Sub
Private Sub I_Box_GotFocus(Index As Integer)
Menu_Layer.SetFocus
End Sub
Private Sub Bufferbox_GotFocus(Index As Integer)
Play_Layer.SetFocus
End Sub
Private Sub Stats_Bar_GotFocus()
Play_Layer.SetFocus
End Sub
Private Sub tmMenu_Timer() 'Highlight Selected Menu
'REFERENCE: For a more theoritical tutorial on tracking,
' refer to my submission titled 'Sprite Tracking' on
' Planet Source Code
Dim i As Integer
For i = Curr_From To Curr_To
Curr(i).Top = Curr(i).Top - Bal(i)
If i = Curr_From Then
Call TrackMenu(menu(Curr_Pos).Top, i, Curr_From)
Else
Call TrackMenu(Curr(i - 1).Top, i, Curr_From)
End If
Next i
End Sub
Private Sub TrackMenu(Dest As Single, i As Integer, Init As Integer)
'REFERENCE: For a more theoritical tutorial on tracking,
' refer to my submission titled 'Sprite Tracking' on
' Planet Source Code
Const SP = 1 'Move Speed
Const TK = 1 'Track Speed
If i = Init Then
Bal(i) = (Curr(i).Top - Dest) / SP
Else:
Bal(i) = (Curr(i).Top - Dest) / TK
End If
End Sub
Private Sub Change_Text(Choice As Integer) 'Change Highlighted Text Color
'This is a simple sub that changes the colour of the text
'when it is the currently selected
Dim i As Integer
Dim x As Integer
For i = Curr_Start To Curr_End
If i = Choice Then
If i = 19 Or i = 20 Then 'Start/Abort Color
menu(i).ForeColor = &HFFFF&
Else:
menu(i).ForeColor = &HFF00&
End If
If i >= 19 And i <= 26 Then
For x = 21 To 26 'Wbox Color
If x = i Then
WBox(x - 21).ForeColor = &HFFFF80
Else:
WBox(x - 21).ForeColor = &HC0C0FF
End If
Next x
End If
Else:
menu(i).ForeColor = &HFFFFFF
End If
Next i
End Sub
Private Sub Menu_Layer_KeyDown(Key As Integer, Shift As Integer)
'Detects the keypresses that the user made in the Menu Layer
If MenuMode_Enabled = True And Wait_Label.Visible = False Then
Select Case (Key)
Case 27: 'ESC
Call Quit
Case 38: 'Menu KEYS
Curr_Pos = Curr_Pos - 1 'UP BUTTON
If Curr_Pos < Curr_Start Then Curr_Pos = Curr_End
Call PLAY(1) 'Play the 'beep' sound =)
Case 40:
Curr_Pos = Curr_Pos + 1 'DOWN BUTTON
If Curr_Pos > Curr_End Then Curr_Pos = Curr_Start
Call PLAY(1)
Case 13:
Select Case (Curr_Pos)
Case 0: 'START
Call Show_Hide(3, 1, 0.01, 3)
Case 1: 'REMAP
Call Show_Hide(2, 1, 0.01, 2)
Case 2: 'QUIT
Call Quit
End Select
Call PLAY(1)
End Select
Call Change_Text(Curr_Pos)
End If
If Key = 115 And Shift = 2 Then Call Quit '(Alt + F4)
End Sub
Private Sub Remap_Layer_KeyDown(Key As Integer, Shift As Integer)
'Detects the keypresses that the user made in the Option Layer
If WaitForRemap = True Then 'See if it is waiting for user to enter a new remap button
Call LoadList(Key, (Curr_Pos - 6)) 'Load the Keyboard button Name
KYB(Curr_Pos - 9) = Key 'Sets the saved button position to memory
Call PLAY(1)
WaitForRemap = False 'Program no longer waiting for user to enter a new keyboard button for remap
Else:
If RemapMode_Enabled = True Then
Select Case (Key)
Case 27: 'ESC
Call PLAY(1)
Call Show_Hide(1, 2, 0.01, 1)
Case 38: 'Menu KEYS
Curr_Pos = Curr_Pos - 1 'UP
If Curr_Pos < Curr_Start Then Curr_Pos = Curr_End
Call PLAY(1)
Case 40:
Curr_Pos = Curr_Pos + 1 'DOWN
If Curr_Pos > Curr_End Then Curr_Pos = Curr_Start
Call PLAY(1)
'VOLUME CONTROLS
Case 39: 'INCREASE
If Curr_Pos = 15 Then 'RIGHT
Vol(0) = Vol(0) + 1
If Vol(0) > 100 Then
Vol(0) = 100
End If
LabelSE.Caption = Str(Vol(0))
Call PLAY(1)
End If
If Curr_Pos = 16 Then 'LEFT
Vol(1) = Vol(1) + 1
If Vol(1) > 100 Then
Vol(1) = 100
End If
LabelBGM.Caption = Str(Vol(1))
End If
Call Set_Volumes
Case 37: 'DECREASE
If Curr_Pos = 15 Then
Vol(0) = Vol(0) - 1
If Vol(0) < 0 Then
Vol(0) = 0
End If
LabelSE.Caption = Str(Vol(0))
Call PLAY(1)
End If
If Curr_Pos = 16 Then
Vol(1) = Vol(1) - 1
If Vol(1) < 0 Then
Vol(1) = 0
End If
LabelBGM.Caption = Str(Vol(1))
End If
Call Set_Volumes
'Remap new keyboard buttons
Case 13: 'ENTER KEY
Select Case (Curr_Pos)
Case 9: 'REMAP UP
Call Remap_Keys
Case 10: 'REMAP DOWN
Call Remap_Keys
Case 11: 'REMAP LEFT
Call Remap_Keys
Case 12: 'REMAP RIGHT
Call Remap_Keys
Case 13: 'REMAP FIRE
Call Remap_Keys
Case 14: 'REMAP SPECIAL
Call Remap_Keys
Case 17: 'ACCEPT
Call Show_Hide(1, 2, 0.1, 1)
Call Save_Keys 'Saved new keys
Case 18: 'CANCEL
Call Show_Hide(1, 2, 0.1, 1)
Call Load_Keys ' Restore default keys
End Select
Call PLAY(1)
End Select
Call Change_Text(Curr_Pos)
End If
End If
If Key = 115 And Shift = 2 Then Call Quit '(Alt + F4)
End Sub
Private Sub Remap_Keys()
'Sets the program to wait for the user to key in a button
WaitForRemap = True
menu(Curr_Pos - 6).Caption = "Press a Key"
End Sub
Private Sub Game_Layer_KeyDown(Key As Integer, Shift As Integer)
'This is for ship configuration before u start the game
If GameMode_Enabled = True Then
Select Case (Key)
Case 27: 'ESC
Call Show_Hide(1, 3, 0.1, 1)
Call PLAY(1)
Case 38: 'Menu KEYS
Curr_Pos = Curr_Pos - 1 'SCROLL through options
If Curr_Pos < Curr_Start Then Curr_Pos = Curr_End
If Curr_Pos >= 21 And Curr_Pos <= 26 Then
MenuSelectLR = True 'Selected menu can scroll left and right
Else:
MenuSelectLR = False 'Selected menu is dormant
End If
Call PLAY(1)
Case 40:
Curr_Pos = Curr_Pos + 1 'SCROLL through options
If Curr_Pos > Curr_End Then Curr_Pos = Curr_Start
If Curr_Pos >= 21 And Curr_Pos <= 26 Then
MenuSelectLR = True
Else:
MenuSelectLR = False
End If
Call PLAY(1)
Case 39: 'INCREASE WEAPON
If MenuSelectLR = True Then
If Curr_Pos >= 21 And Curr_Pos <= 26 Then
'Scrolls through the ship's configurations
SHP(Curr_Pos - 21) = SHP(Curr_Pos - 21) + 1
Select Case (Curr_Pos - 21)
Case 0:
If SHP(0) > 4 Then SHP(0) = 0 'After last option, returns to first option
Case 1:
If SHP(1) > 3 Then SHP(1) = 0
Case 2:
If SHP(2) > 4 Then SHP(2) = 0
Case 3:
If SHP(3) > 4 Then SHP(3) = 0
Case 4:
If SHP(4) > 2 Then SHP(4) = 0
Case 5:
If SHP(5) > 3 Then SHP(5) = 0
End Select
'Put the name of the item selected in the wbox text
Call LoadWbox(Curr_Pos - 21, SHP(Curr_Pos - 21))
End If
Call PLAY(3)
End If
Case 37: 'DECREASE WEAPON
If MenuSelectLR = True Then
'Same as above...
If Curr_Pos >= 21 And Curr_Pos <= 26 Then
SHP(Curr_Pos - 21) = SHP(Curr_Pos - 21) - 1
Select Case (Curr_Pos - 21)
Case 0:
If SHP(0) < 0 Then SHP(0) = 4
Case 1:
If SHP(1) < 0 Then SHP(1) = 3
Case 2:
If SHP(2) < 0 Then SHP(2) = 4
Case 3:
If SHP(3) < 0 Then SHP(3) = 4
Case 4:
If SHP(4) < 0 Then SHP(4) = 2
Case 5:
If SHP(5) < 0 Then SHP(5) = 3
End Select
Call LoadWbox(Curr_Pos - 21, SHP(Curr_Pos - 21))
End If
Call PLAY(3)
End If
Case 13:
Select Case (Curr_Pos)
Case 19: 'START MISSION
Call PLAY(1)
MP2.Mute = True
Play_Layer.Cls
Wait_label2.Visible = True
Call Show_Hide(4, 3, 0.3, 4) '>goto play menu
Case 20: 'ABORT
Call PLAY(1)
Call Show_Hide(1, 3, 0.1, 1) '>goto main menu
End Select
Call PLAY(1)
End Select
Call Change_Text(Curr_Pos)
End If
If Key = 115 And Shift = 2 Then Call Quit '(Alt + F4)
End Sub
Private Sub Play_Layer_KeyDown(Key As Integer, Shift As Integer)
'These buttons follows the buttons customly remapped by the player.
If PlayMode_Enabled = True Then
Select Case (Key)
Case 27: 'ESC
Call Show_Hide(5, 4, 0.01, 5) 'Shows the PAUSE Menu
Call PLAY(1)
End Select
If OVERIDE = False Then 'Lost control of ship
If Lock_All = False Then
Select Case (Key)
'Ship moving in a certain direction is true
Case KYB(0): 'UP
If Lock_Engine = False Then Ship_Moving(1) = True
Case KYB(1): 'DOWN
If Lock_Engine = False Then Ship_Moving(3) = True
Case KYB(2): 'LEFT
If Lock_Engine = False Then Ship_Moving(0) = True
Case KYB(3): 'RIGHT
If Lock_Engine = False Then Ship_Moving(2) = True
Case KYB(4): 'FIRE
Ship_Firing = True
Case KYB(5): 'SPECIAL
Call Use_Special(SHP(2))
End Select
End If
End If
End If
End Sub
Private Sub Play_Layer_KeyUp(Key As Integer, Shift As Integer)
'The ship stops performing that action if button is depressed
If OVERIDE = False Then
Select Case (Key)
Case KYB(0): 'UP
Ship_Moving(1) = False
Case KYB(1): 'DOWN
Ship_Moving(3) = False
Case KYB(2): 'LEFT
Ship_Moving(0) = False
Case KYB(3): 'RIGHT
Ship_Moving(2) = False
Case KYB(4): 'FIRE
Ship_Firing = False
End Select
End If
End Sub
Private Sub Pause_Layer_KeyDown(Key As Integer, Shift As Integer)
If PauseMode_Enabled = True Then
Select Case (Key)
Case 27: 'ESC
Call Show_Hide(4, 5, 0.01, 4)
Case 38: 'Menu KEYS
Curr_Pos = Curr_Pos - 1
If Curr_Pos < Curr_Start Then Curr_Pos = Curr_End
Call PLAY(1)
Case 40:
Curr_Pos = Curr_Pos + 1
If Curr_Pos > Curr_End Then Curr_Pos = Curr_Start
Call PLAY(1)
Case 13:
Select Case (Curr_Pos)
Case 27: 'RESUME
Call Show_Hide(4, 5, 0.1, 4)
Case 28: 'ABORT
GameStarted = False
Call Show_Hide(1, 5, 0.2, 1)
Case 29: 'QUIT
Call Quit
End Select
End Select
Call Change_Text(Curr_Pos)
End If
If Key = 115 And Shift = 2 Then Call Quit '(Alt + F4)
End Sub
Private Sub Quit() 'END PROGRAM
tmMenu.Enabled = False 'Kill Timers
tmDelay.Enabled = False
tmOneFrame.Enabled = False
tmOneSecond = False
tmIntro.Enabled = False
Set FormBW = Nothing 'Kill Variables
Unload Me 'Kill Form
End 'Kill Program
End Sub
Private Sub Show_Hide(Show As Integer, Hide As Integer, Del_A As Single, Del_E As Integer)
'This sub performs 3 function, in the parameter list,
'the 1st number represents which Layer to show,
'the 2nd number represents which Layer to hide,
'the 3rd is the time to delay an event if there's an event after the show/hide is done.
'the 4th is the event number, each event bearing different outcome
Dim i As Integer
Select Case (Show) 'Shows and enables the selected Layer
Case 1:
MenuMode_Enabled = True
For i = 0 To 5
Curr(i).Top = 120
Next i
Menu_Layer.Visible = True
Menu_Layer.SetFocus
Case 2:
RemapMode_Enabled = True
Remap_Layer.Visible = True
Remap_Layer.SetFocus
Case 3:
GameMode_Enabled = True
Game_Layer.Visible = True
Game_Layer.SetFocus
Case 4:
PlayMode_Enabled = True
Play_Layer.Visible = True
Play_Layer.Enabled = True
Play_Layer.SetFocus
tmMenu.Enabled = False
Case 5:
PauseMode_Enabled = True
Pause_Layer.Visible = True
Pause_Layer.SetFocus
End Select
Select Case (Hide) 'Hides and disable the selected Layer
Case 1:
MenuMode_Enabled = False
Menu_Layer.Visible = False
Case 2:
RemapMode_Enabled = False
Remap_Layer.Visible = False
Case 3:
GameMode_Enabled = False
Game_Layer.Visible = False
Case 4:
PlayMode_Enabled = False
Play_Layer.Enabled = False
tmOneFrame.Enabled = False
tmOneSecond = False
tmMenu.Enabled = True
Case 5:
PauseMode_Enabled = False
Pause_Layer.Visible = False
End Select
Call Wait(Del_A, Del_E) 'Call an event to happen
End Sub
Private Sub Load_Sounds()
'Sounds loaded that will not be changed anymore after loaded
MP1.Open (App.Path & "soundmenu.wav")
MP3.Open (App.Path & "soundconfig.wav")
MP4.Open (App.Path & "soundpowerup.wav")
Call Set_Volumes
End Sub
Private Sub PLAY(i As Integer)
'This sub performs nothing more that calling the
'media player with the loaded sound to play their files
If FormOptimize.Chk_Mute.Value = 1 Then Exit Sub
Static Curr_Player As Integer
On Error Resume Next
Select Case (i)
Case 1: 'Menu Beep
MP1.PLAY
Case 2: 'Intro BG
MP2.Mute = False
MP2.Open (App.Path & "soundbgmenu.mid")
Case 3: 'Config Ship
MP3.PLAY
Case 4:
MP2.Stop
MP2.Mute = False
MP2.Open (App.Path & "soundbgplay.mid")
Case 5:
MP5.Open (App.Path & "soundwarning.wav")
Case 6:
MP5.Open (App.Path & "soundstartup.wav")
Case 7:
MP4.PLAY
Case 99:
MP2.PLAY
Case Else:
Curr_Player = Curr_Player + 1
If Curr_Player > 3 Then Curr_Player = 0
Select Case (i)
Case 100:
MPS(Curr_Player).PLAY
Case 101:
MPS(Curr_Player + 4).PLAY
End Select
End Select
End Sub
Private Sub Set_Volumes()
'Set the volume levels of the media players
Dim i As Integer
MP1.Volume = (1 - (Vol(0) / 100)) * -3100
MP2.Volume = (1 - (Vol(1) / 100)) * -3100
MP3.Volume = (1 - (Vol(0) / 100)) * -3100
MP5.Volume = (1 - (Vol(1) / 100)) * -3100
For i = 0 To 7
MPS(i).Volume = (1 - (Vol(0) / 100)) * -3100
Next i
End Sub
Private Sub Save_Keys()
'If the user selects Accept in the options layer, the
'keys are saved into a file.
Dim File1
File1 = FreeFile
Dim Filename As String
Filename = App.Path & "" & "custom.cfg"
Open (Filename) For Output As File1
Write #File1, KYB(0)
Write #File1, KYB(1)
Write #File1, KYB(2)
Write #File1, KYB(3)
Write #File1, KYB(4)
Write #File1, KYB(5)
Write #File1, Vol(0)
Write #File1, Vol(1)
Close File1
End Sub
Private Sub Load_Keys()
'When the game loads of the user select cancel from the options layer, then the default keys are loaded
Dim i As Integer
Dim File1
File1 = FreeFile
Dim Filename As String
Filename = App.Path & "" & "custom.cfg"
Open (Filename) For Input As File1
Input #File1, KYB(0)
Input #File1, KYB(1)
Input #File1, KYB(2)
Input #File1, KYB(3)
Input #File1, KYB(4)
Input #File1, KYB(5)
Input #File1, Vol(0)
Input #File1, Vol(1)
Close File1
For i = 0 To 5
Call LoadList(KYB(i), (i + 3))
LabelSE.Caption = Str(Vol(0))
LabelBGM.Caption = Str(Vol(1))
Next i
End Sub
Private Sub Load_Graphics()
Menu_Layer.Picture = LoadPicture(App.Path & "graphicmenubg.gif")
Remap_Layer.Picture = LoadPicture(App.Path & "graphicmenubg.gif")
Game_Layer.Picture = LoadPicture(App.Path & "graphicmenubg.gif")
End Sub
Private Sub Wait(MiliSecs As Single, Event_No As Integer) 'Wait Function
'This sub delays the computer for a number of seconds and
'calls an even to happen.
tmDelay.Interval = MiliSecs * 1000
tmDelay.Enabled = True
Delay_Counter = 0
Delay_Occasion = Event_No
End Sub
Private Sub Load_Intro()
'This sub just moves the titles around during the title screen startup.
Dim i As Integer
Intro_Counter = 0
tmIntro.Enabled = True
For i = 0 To 2
Title(i).ForeColor = RGB(5, 5, 5)
Next i
Title(3).Top = 3000
Title(3).Left = 960
I_Box(0).Top = 0
I_Box(0).Left = 960
I_Box(2).Top = 3000
I_Box(2).Left = 480
I_Box(1).Top = 1200
I_Box(1).Left = 3840
I_Box(3).Top = 1220
I_Box(3).Left = -4460
I_Box(4).Top = 2600
I_Box(4).Left = 5140
R_Color = 5
G_Color = 5
B_Color = 5
End Sub
Private Sub tmIntro_Timer() 'INTRODUCTION
'As the title screen loads...
Dim i As Integer
Intro_Counter = Intro_Counter + 1
'... title words are being moved around ...
If Intro_Counter < 68 Then
I_Box(0).Top = I_Box(0).Top + 18
I_Box(2).Top = I_Box(2).Top - 18
End If
'... more title words are being moved around ...
If Intro_Counter > 60 And Intro_Counter <= 100 Then
I_Box(3).Left = I_Box(3).Left + 120
I_Box(4).Left = I_Box(4).Left - 120
End If
'... and their text if fading black to white ...
R_Color = R_Color + 5
G_Color = G_Color + 5
B_Color = B_Color + 5
For i = 0 To 2
Title(i).ForeColor = RGB(R_Color, G_Color, B_Color)
Next i
'... until they all are nicely set, then timer is killed.
If Intro_Counter = 100 Then
Title(3).Visible = True
Title(4).Visible = True
tmIntro.Enabled = False
End If
End Sub
Private Sub tmDelay_Timer() 'Delay Counter + Occasions
Dim i As Integer
'Pauses the game for a short period and make a call to intialize
'a layer's variables and settings
Delay_Counter = Delay_Counter + 1
If Delay_Counter = 2 Then
tmDelay.Enabled = False
Select Case (Delay_Occasion)
Case 1:
Call MainMenu
Case 2:
Call RemapMenu
Case 3:
Call GameMenu
Case 4:
Call PlayMenu
Case 5:
Call PauseMenu
End Select
Delay_Counter = 0
End If
End Sub
Private Sub LoadWbox(Weapon_Slot As Integer, Weapon_Name As Integer)
'As you scroll around the ship's configurations, this sub
'changes the text of the weapons selected.
Select Case (Weapon_Slot)
Case 0:
Select Case (Weapon_Name) 'MAIN GUN
Case 0:
WBox(Weapon_Slot).Caption = "Vulcan-X"
Case 1:
WBox(Weapon_Slot).Caption = "Light Beam"
Case 2:
WBox(Weapon_Slot).Caption = "Particle Burst"
Case 3:
WBox(Weapon_Slot).Caption = "Plasma Wave"
Case 4:
WBox(Weapon_Slot).Caption = "Vulcan Blue"
End Select
Case 1: 'SIDE GUN
Select Case (Weapon_Name)
Case 0:
WBox(Weapon_Slot).Caption = "Micro Missiles"
Case 1:
WBox(Weapon_Slot).Caption = "Pulse Ring"
Case 2:
WBox(Weapon_Slot).Caption = "Crescent Blades"
Case 3:
WBox(Weapon_Slot).Caption = "Creep Mine"
End Select
Case 2: 'SPECIAL
Select Case (Weapon_Name)
Case 0:
WBox(Weapon_Slot).Caption = "Inferno Disc"
Case 1:
WBox(Weapon_Slot).Caption = "Matrix Globe"
Case 2:
WBox(Weapon_Slot).Caption = "Giga Storm"
Case 3:
WBox(Weapon_Slot).Caption = "Proximity Burn"
Case 4:
WBox(Weapon_Slot).Caption = "Armageddon"
End Select
Case 3: 'SHIELD
Select Case (Weapon_Name)
Case 0:
WBox(Weapon_Slot).Caption = "Matrix SHD MK I"
Case 1:
WBox(Weapon_Slot).Caption = "Matrix SHD MK II"
Case 2:
WBox(Weapon_Slot).Caption = "Matrix SHD MK III"
Case 3:
WBox(Weapon_Slot).Caption = "Matrix SHD MK IV"
Case 4:
WBox(Weapon_Slot).Caption = "Matrix SHD MK V"
End Select
Case 4: 'GENERATOR
Select Case (Weapon_Name)
Case 0:
WBox(Weapon_Slot).Caption = "Dual-Core Charger"
Case 1:
WBox(Weapon_Slot).Caption = "Fusion Charger"
Case 2:
WBox(Weapon_Slot).Caption = "Matrix Charger"
End Select
Case 5: 'ENGINE
Select Case (Weapon_Name)
Case 0:
WBox(Weapon_Slot).Caption = "4 Cylinders"
Case 1:
WBox(Weapon_Slot).Caption = "6 Cylinders"
Case 2:
WBox(Weapon_Slot).Caption = "8 Cylinders"
Case 3:
WBox(Weapon_Slot).Caption = "12 Cylinders"
End Select
End Select
End Sub
Private Sub LoadList(Key As Integer, Label As Integer)
'Similar to above, as a new Keyboard button is being remapped,
'it will be displayed to the user the selected button
Select Case (Key)
Case 8:
menu(Label).Caption = "Backspace"
Case 13:
menu(Label).Caption = "Enter"
Case 16:
menu(Label).Caption = "Shift"
Case 17:
menu(Label).Caption = "Ctrl"
Case 18:
menu(Label).Caption = "Alt"
Case 19:
menu(Label).Caption = "Pause"
Case 20:
menu(Label).Caption = "Caps Lock"
Case 32:
menu(Label).Caption = "Spacebar"
Case 33:
menu(Label).Caption = "Page Up"
Case 34:
menu(Label).Caption = "Page Down"
Case 35:
menu(Label).Caption = "End"
Case 36:
menu(Label).Caption = "Home"
Case 37:
menu(Label).Caption = "Left"
Case 38:
menu(Label).Caption = "Up"
Case 39:
menu(Label).Caption = "Right"
Case 40:
menu(Label).Caption = "Down"
Case 45:
menu(Label).Caption = "Insert"
Case 46:
menu(Label).Caption = "Delete"
Case 48:
menu(Label).Caption = "0"
Case 49:
menu(Label).Caption = "1"
Case 50:
menu(Label).Caption = "2"
Case 51:
menu(Label).Caption = "3"
Case 52:
menu(Label).Caption = "4"
Case 53:
menu(Label).Caption = "5"
Case 54:
menu(Label).Caption = "6"
Case 55:
menu(Label).Caption = "7"
Case 56:
menu(Label).Caption = "8"
Case 57:
menu(Label).Caption = "9"
Case 65:
menu(Label).Caption = "A"
Case 66:
menu(Label).Caption = "B"
Case 67:
menu(Label).Caption = "C"
Case 68:
menu(Label).Caption = "D"
Case 69:
menu(Label).Caption = "E"
Case 70:
menu(Label).Caption = "F"
Case 71:
menu(Label).Caption = "G"
Case 72:
menu(Label).Caption = "H"
Case 73:
menu(Label).Caption = "I"
Case 74:
menu(Label).Caption = "J"
Case 75:
menu(Label).Caption = "K"
Case 76:
menu(Label).Caption = "L"
Case 77:
menu(Label).Caption = "M"
Case 78:
menu(Label).Caption = "N"
Case 79:
menu(Label).Caption = "O"
Case 80:
menu(Label).Caption = "P"
Case 81:
menu(Label).Caption = "Q"
Case 82:
menu(Label).Caption = "R"
Case 83:
menu(Label).Caption = "S"
Case 84:
menu(Label).Caption = "T"
Case 85:
menu(Label).Caption = "U"
Case 86:
menu(Label).Caption = "V"
Case 87:
menu(Label).Caption = "W"
Case 88:
menu(Label).Caption = "X"
Case 89:
menu(Label).Caption = "Y"
Case 90:
menu(Label).Caption = "Z"
Case 96:
menu(Label).Caption = "Numpad 0"
Case 97:
menu(Label).Caption = "Numpad 1"
Case 98:
menu(Label).Caption = "Numpad 2"
Case 99:
menu(Label).Caption = "Numpad 3"
Case 100:
menu(Label).Caption = "Numpad 4"
Case 101:
menu(Label).Caption = "Numpad 5"
Case 102:
menu(Label).Caption = "Numpad 6"
Case 103:
menu(Label).Caption = "Numpad 7"
Case 104:
menu(Label).Caption = "Numpad 8"
Case 105:
menu(Label).Caption = "Numpad 9"
Case 106:
menu(Label).Caption = "Numpad *"
Case 107:
menu(Label).Caption = "Numpad +"
Case 109:
menu(Label).Caption = "Numpad -"
Case 110:
menu(Label).Caption = "Numpad ."
Case 111:
menu(Label).Caption = "Numpad /"
Case 112:
menu(Label).Caption = "F1"
Case 113:
menu(Label).Caption = "F2"
Case 114:
menu(Label).Caption = "F3"
Case 115:
menu(Label).Caption = "F4"
Case 116:
menu(Label).Caption = "F5"
Case 117:
menu(Label).Caption = "F6"
Case 118:
menu(Label).Caption = "F7"
Case 119:
menu(Label).Caption = "F8"
Case 120:
menu(Label).Caption = "F9"
Case 121:
menu(Label).Caption = "F10"
Case 144:
menu(Label).Caption = "Num Lock"
Case 145:
menu(Label).Caption = "Scroll Lock"
Case 186:
menu(Label).Caption = ";"
Case 187:
menu(Label).Caption = "-"
Case 188:
menu(Label).Caption = ","
Case 189:
menu(Label).Caption = "="
Case 190:
menu(Label).Caption = "."
Case 191:
menu(Label).Caption = "/"
Case 192:
menu(Label).Caption = "`"
Case 219:
menu(Label).Caption = "["
Case 220:
menu(Label).Caption = ""
Case 221:
menu(Label).Caption = "]"
Case 222:
menu(Label).Caption = "'"
Case Else:
menu(Label).Caption = "Undefined"
End Select
End Sub
Private Sub EXPLODE(x As Integer, y As Integer, Style As Integer)
'This sub creates an explosion at a fixed point, determines
'how many frames are there in the explosion sequence,
'and set's the explosions X-offset and Y-offset to make
'their explosion point more correct
Dim i As Integer
For i = 0 To 40 'Locates an unsed explosion object and create a new explosion
If Explo(i).Used = False Then
Explo(i).Used = True
Explo(i).Kind = Style
Explo(i).PosX = x 'Axis coordinates for explosion point
Explo(i).PosY = y
Explo(i).Current_Frame = 1 'Sets to first frame of imagelist
Select Case (Style)
Case 1:
Explo(i).Last_Frame = 16 'Determine how many frame in an explosion
Explo(i).PosX = Explo(i).PosX - 1065 / 2 'X Offset
Explo(i).PosY = Explo(i).PosY - 1500 / 2 'Y Offset
Case 2:
Explo(i).Last_Frame = 30
Explo(i).PosX = Explo(i).PosX - 3840 / 2 'X Offset
Explo(i).PosY = Explo(i).PosY - 2880 / 2 'Y Offset
Case 3:
Explo(i).Last_Frame = 22
Explo(i).PosX = Explo(i).PosX - 3840 / 2 'X Offset
Explo(i).PosY = Explo(i).PosY - 2880 / 2 'Y Offset
Case 17:
Explo(i).Last_Frame = 5
Explo(i).PosX = Explo(i).PosX - 840 / 2 'X Offset
Explo(i).PosY = Explo(i).PosY - 880 / 2 'Y Offset
Case 13:
Explo(i).Last_Frame = 5
Explo(i).PosX = Explo(i).PosX - 200 / 2 'X Offset
Explo(i).PosY = Explo(i).PosY - 200 / 2 'Y Offset
End Select
Exit For
End If
Next i
End Sub
Private Sub Use_Special(Kind As Integer)
'When a player uses a Special ...
Dim i As Integer
Dim x As Integer
'Bar reaches zero, chargin starts again
If SPE_Charging = False Then
BAR_SPE_R.Width = 0
End If
If SPE_Avail = True Then
Moving_SpecialBar = True 'Moves the special weapon textbar to appear briefly
BufferText(7).Caption = UCase(WBox(2).Caption)
BAR_SPE_C.Width = 0
Stt_SPE_Lbl.BackColor = &HC0&
Stt_SPE_Lbl.ForeColor = &HFFFFFF
SPE_Avail = False
Special_Running = True
Moving_SpecialBar = 2
Select Case (Kind)
Case 0: 'Inferno Disc
For i = 290 To 300
'Creates a bullet
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 1
Bull(i).Dire = 8
Bull(i).Span = 0
Bull(i).Dama = 50
Bull(i).PosX = ShipX - 90
Bull(i).PosY = ShipY - 0
Exit For
End If
Next i
Case 1: 'Matrix Globe
For i = 290 To 300
'Creates a bullet
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 1
Bull(i).Dire = 8
Bull(i).Span = 0
Bull(i).Dama = 1
Bull(i).PosX = ShipX - 90
Bull(i).PosY = ShipY - 0
Bull(i).Spd = 40
Exit For
End If
Next i
Case 2: 'Giga Storm
Giga_Count = 1
'Mass Damage
Img(27).ListImages(1).Draw Play_Layer.hDC, 1000, 2000, 1
Img(27).ListImages(1).Draw Play_Layer.hDC, 3000, 2000, 1
For i = 0 To 40
If EShip(i).Used = True Then EShip(i).Life = EShip(i).Life - 500
If EShip(i).Life < 0 Then EShip(i).Life = 0
If EShip(i).Boss = True Then Boss_Bar_Top.Width = EShip(i).Life / EShip(i).Max_Life * Boss_Bar_Bottom.Width
Call Check_EDeath(i)
Call EXPLODE(EShip(i).PosX + (Img(EShip(i).Kind).ImageWidth * 15) / 2, EShip(i).PosY + (Img(EShip(i).Kind).ImageWidth * 15) / 2, 1)
Next i
Case 3: 'Proximity Burn
For i = 290 To 300
'Create a bullet
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 0
Bull(i).Dire = 8
Bull(i).Span = 0
Bull(i).Dama = 100
Bull(i).PosX = ShipX - 3840 / 2
Bull(i).PosY = ShipY - 2880 / 2
Bull(i).Spd = 1
Exit For
End If
Next i
Case 4: 'Armageddon
For i = 2000 To 4000 Step 1000
For x = 2000 To 6000 Step 2000
Call EXPLODE(i, x, 2)
Next x
Next i
For i = 0 To 40
'Mass Damage
If EShip(i).Used = True Then EShip(i).Life = EShip(i).Life - 4000
If EShip(i).Life < 0 Then EShip(i).Life = 0
If EShip(i).Boss = True Then Boss_Bar_Top.Width = EShip(i).Life / EShip(i).Max_Life * Boss_Bar_Bottom.Width
Call Check_EDeath(i)
Call EXPLODE(EShip(i).PosX + (Img(EShip(i).Kind).ImageWidth * 15) / 2, EShip(i).PosY + (Img(EShip(i).Kind).ImageWidth * 15) / 2, 1)
Call PLAY(101)
Call PLAY(101)
Call PLAY(101)
Call PLAY(101)
Next i
End Select
End If
SPE_Charging = True
End Sub
Private Sub Send_MSG(Message As String, Color_0White_1Green_2Red_3Yellow As Integer, BColor_0Black_1Red_2Yellow As Integer)
'By calling this sub, u can send a message text to the player
'on the screen.
'Parameter list: The message to be sent, the forecolor, the backcolor
Buffering = True
BufferText(0).Caption = Message
Select Case (Color_0White_1Green_2Red_3Yellow)
Case 0: 'Friendly Units(BLUE)
BufferText(0).ForeColor = &HFFFFFF
Case 1: 'Power-ups (GREEN)
BufferText(0).ForeColor = &HFF00&
Case 2: 'Enemy Comm (RED)
BufferText(0).ForeColor = &HFF&
Case 3: 'Ship Reports (YELLOW)
BufferText(0).ForeColor = &HFFFF&
End Select
Select Case (BColor_0Black_1Red_2Yellow)
Case 1: '(RED)
BufferText(0).BackColor = &HFF&
Case 2: '(YELLOW)
BufferText(0).BackColor = &HFFFF&
Case Else: '(BLACK)
BufferText(0).BackColor = &H0&
End Select
Bufferbox(0).Width = BufferText(0).Width
End Sub
Private Sub Critical_HIT()
'When a ship is critically shot and destroyed...
Dim i As Integer
ShakeIT = 1 'Shakes the screen
'Create an explosion at the ship's coordinates
Call EXPLODE(ShipX + (Img(0).ImageWidth * 15) / 2, ShipY + (Img(0).ImageHeight * 15) / 2, 1)
Call Send_MSG("> Your Ship has been DESTROYED ", 0, 0)
Call PLAY(101)
Moving_StatsBar = 1 'Hides all the bars
Lock_All = True 'Lock all controls
OVERIDE = True 'Program overtake controls
Ship_Moving(0) = False
Ship_Moving(1) = False
Ship_Moving(2) = False
Ship_Moving(3) = False
Ship_Firing = False
ShipX = 0 'Hides the ship
ShipY = 0 'Hides the ship
Call Check_Score
GEC = -300 'Playmode enters the death sequence before going back to main menu
End Sub
Private Sub Check_Score()
Dim i As Integer
' High Score file Creation
Dim file2
file2 = FreeFile
Dim Filename As String
Filename = App.Path & "" & "HiScore.txt"
Dim Hiscore As String
'Opens the Hiscore.txt file to retrieve existing hiscore
Open (Filename) For Input As file2
For i = 1 To 3
Input #file2, Hiscore 'Loads hiscore from file
Next i
Close file2
'Extract highscore from sentence
Hiscore = Right(Hiscore, Len(Hiscore) - 13)
'Process storing of highscore if new score exceeds the old score
If GameScore > Val(Hiscore) Then 'Checks if current score is higher than the saved hiscore
Dim Temp_String As String
Open (Filename) For Output As file2 'Store all the player records into the file
Temp_String = "Send this file along with your name to: ruby@starpulse.com"
Write #file2, Temp_String
Temp_String = "View Top 10 Pilots on http://www.planet-source-code.com/vb"
Write #file2, Temp_String
Temp_String = "High Score : " & GameScore
Write #file2, Temp_String
Temp_String = "Main Gun : " & WBox(0).Caption
Write #file2, Temp_String
Temp_String = "Side Gun : " & WBox(1).Caption
Write #file2, Temp_String
Temp_String = "Special : " & WBox(2).Caption
Write #file2, Temp_String
Temp_String = "Shield : " & WBox(3).Caption
Write #file2, Temp_String
Temp_String = "Generator : " & WBox(4).Caption
Write #file2, Temp_String
Temp_String = "Engine : " & WBox(5).Caption
Write #file2, Temp_String
Temp_String = "Duration : " & GEC & " Frame(s)"
Write #file2, Temp_String
Temp_String = "Total Kill : " & KillCount & " Ship(s)"
Write #file2, Temp_String
If KilledBoss = True Then
Temp_String = "Last Boss : Destroyed"
Else:
Temp_String = "Last Boss : Failed"
End If
Write #file2, Temp_String
If Elasped = 0 Then Elasped = 1
Temp_String = "Ave. FPS : " & Trim(Str(Round(TotFPS / Elasped, 2)))
Write #file2, Temp_String
Close file2
End If
End Sub
Private Sub Major_HIT()
'Ship is hit without any shields
Dim i As Integer
Dim All_Gone As Boolean
Dim Dam_Inflicted As Boolean
'Randomly lowers the sidegun/maingun weapon level by 1
If GEC Mod 2 = 1 Then Call Alter_G(0, 0)
If GEC Mod 2 = 0 Then Call Alter_G(1, 0)
Call Send_MSG(" DANGER! ", 2, 2)
ShakeIT = 1
All_Gone = True 'All parts of the ship has been damaged
Dam_Inflicted = False
Select Case (FPS Mod 10)
Case 9: '10% Chance of Direct HIT and get destroyed
Call Critical_HIT
Case Else:
'If any of the ship's components are still intact, the all_gone is false
If Lock_MainGun = False Then
All_Gone = False
End If
If Lock_SideGun = False Then
All_Gone = False
End If
If Lock_Engine = False Then
All_Gone = False
End If
If Lock_Generator = False Then
All_Gone = False
End If
'If all of the ship's components is damaged, then ship destroyed (death).
If All_Gone = True Then
Call Critical_HIT
End If
'If any part of the ship is still intact, perform
'component failure on a random part.
i = Int(FPS) Mod 4
Do While Dam_Inflicted = False
Select Case (i)
Case 0: 'Fail Main Guns
If Lock_MainGun = False Then
Lock_MainGun = True
Stt_MGUN_R.Width = 0
Dam_Inflicted = True
End If
Case 1: 'Fail Side Guns
If Lock_SideGun = False Then
Lock_SideGun = True
Stt_SGUN_R.Width = 0
Dam_Inflicted = True
End If
Case 2: 'Fail Engines (cannot move)
If Lock_Engine = False Then
Lock_Engine = True
Stt_ENG_R.Width = 0
Dam_Inflicted = True
End If
Case 3: 'Fail generator (stops charging)
If Lock_Generator = False Then
Lock_Generator = True
Stt_PWR_R.Width = 0
Dam_Inflicted = True
End If
End Select
'If component of the ship is already destroyed,
'perform check on the component
i = i + 1
If i > 3 Then
i = 0
End If
'If ship is already destroyed...
If GEC < 0 Then Exit Do
Loop
End Select
End Sub
Private Sub Minor_HIT()
'Minor hit occur when the ship is inflicted damage
'while the shield is still intact. A bar of shiled will
'be deducted and shield charging will increase, if not already started
If SHD_Charging = False Then
BAR_SHD_R.Width = 0
End If
'If no more shields left, a major hit occurs
If SHD_Avail = False Then
Call Major_HIT
Else
'Minus one bar of shield
BAR_SHD_C.Width = BAR_SHD_C.Width - 435
SHIELD_ON_OFF = 1
If BAR_SHD_C.Width <= 15 Then
BAR_SHD_C.Width = 15
Stt_SHD_Lbl.BackColor = &HC0&
Stt_SHD_Lbl.ForeColor = &HFFFFFF
SHD_Avail = False
End If
End If
'Continue to charge shield
SHD_Charging = True
End Sub
Private Sub Alter_G(MG_SG As Integer, Plus_Minus As Integer)
'This sub alter the Maingun and Sidegun levels.
'Parameterlist : 0/1 = Maingun/Sidegun
' 0/1 = Minus/Add Level
If MG_SG = 0 Then
If Plus_Minus = 0 Then
MG_Lvl = MG_Lvl - 1
If MG_Lvl <= 1 Then MG_Lvl = 1
Else:
MG_Lvl = MG_Lvl + 1
If MG_Lvl >= 10 Then
MG_Lvl = 10
GameScore = GameScore + 2000 'Bonus points
End If
Call Send_MSG("MainGun Upgrade", 1, 0)
End If
Else:
If Plus_Minus = 0 Then
SG_Lvl = SG_Lvl - 1
If SG_Lvl <= 1 Then SG_Lvl = 1
Else:
SG_Lvl = SG_Lvl + 1
If SG_Lvl > 5 Then
SG_Lvl = 5
GameScore = GameScore + 2000 'Bonus points
Call Alter_G(0, 1) 'Surplus sideguns goes to maingun
Else:
Call Send_MSG("SideGun Upgrade", 1, 0)
End If
End If
End If
'Changes the statsbar captions
Stt_LVL_MG.Caption = "MG " & MG_Lvl & ".0"
Stt_LVL_SG.Caption = "SG " & SG_Lvl & ".0"
End Sub
Private Sub Check_EDeath(x As Integer)
'This sub checks the lifepoints of an enemy after being
'inflicted damage. If the lifepoints is 0 or lower, then
'it will be destroyed.
Dim y As Integer
Dim temp As String
If EShip(x).Life <= 0 And EShip(x).Used = True Then
EShip(x).Used = False 'Destroyed
KillCount = KillCount + 1 'Add to total kills
If EShip(x).Has_Bonus = True Then Call Create_Bonus(EShip(x).PosX + (Img(EShip(x).Kind).ImageWidth * 15) / 2, EShip(x).PosY + (Img(EShip(x).Kind).ImageWidth * 15) / 2) 'If the ship has a powerup...
Call PLAY(100)
'If the ship destroyed was a BOSS
If EShip(x).Boss = True And EShip(x).Life <= 0 Then
Call PLAY(101)
Call PLAY(101)
Call PLAY(101)
Call PLAY(101)
'Proceed to next stage
For y = 0 To 4
If C_GEC(y) = 0 Then 'Next Level GEC counter initialized
C_GEC(y) = GEC
Exit For
End If
Next y
If EShip(x).Boss = True Then
Moving_BossBar = 2 'Hides bossbar
Call EXPLODE(EShip(x).PosX + (Img(EShip(x).Kind).ImageWidth * 15) / 2, EShip(x).PosY + (Img(EShip(x).Kind).ImageHeight * 15) / 2, 2)
End If
EShip(x).Boss = False
End If
GameScore = GameScore + EShip(x).Score
temp = ""
'Adds the score to the display on screen
For y = 0 To ((6 - Len(Trim(Str(GameScore)))) - 1)
temp = temp & "0"
Next y
temp = temp & Trim(Str(GameScore))
BufferText(6).Caption = temp
Call EXPLODE(EShip(x).PosX + (Img(EShip(x).Kind).ImageWidth * 15) / 2, EShip(x).PosY + (Img(EShip(x).Kind).ImageHeight * 15) / 2, 1)
End If
End Sub
Private Sub tmOneSecond_Timer() 'Frames Per Second Indicator
'This sub is used to keep track of the player's average
'FRAME per second. It just merely shows the performance of the
'game on the player's PC
Elasped = Elasped + 1
TotFPS = TotFPS + FPS
FPS = 0
FormBW.Caption = "太空大战游戏 " ' "Black Winter II : Final Assault" & " Fps : " & Str(Round(TotFPS / Elasped, 2))
End Sub
Private Sub tmOneFrame_Timer()
'This is the Most important sub, where every single
'frame of gameplay is drawn and animated frame by frame here.
'We'll go through this bit by bit ...
Dim B_Speed As Integer 'Bullet Speed
Dim x As Integer
Dim i As Integer
Dim y As Integer
'This is to supply the information needed in the
'previous sub to calculate the frames per second
If PlayMode_Enabled = True Then
Play_Layer.Cls 'CLS + FPS
FPS = FPS + 1
GEC = GEC + 1
'If the background music is stopped, then is replayed
If GEC Mod 10 = 1 Then Call PLAY(99)
'-----------------------------------------
'DEATH
'If the ship is destroyed, the following messages will be displayed
If GEC = -380 Then Call Send_MSG(" > Command Base: Congratulations, Black Winter.", 0, 0)
If GEC = -330 Then Call Send_MSG(" MISSION COMPLETED ", 2, 2)
If GEC = -260 Then Call Send_MSG(" > Check HiScore.txt ", 0, 0)
If GEC = -220 Then Call Send_MSG(" > Compete with the BEST Pilots Worldwide!", 0, 0)
If GEC = -180 Then Call Send_MSG(" > Send your HiScore files to: ", 0, 0)
If GEC = -140 Then Call Send_MSG(" > ruby@starpulse.com ", 3, 0)
If GEC = -100 Then Call Send_MSG(" GAME OVER ", 0, 1)
If GEC = -1 Then
'Game no longer running, returns to main menu
GameStarted = False
Call Show_Hide(1, 4, 0.2, 1)
End If
'-----------------------------------------
'DRAWING A STARFIELD
'This part of the code is modified from
'Johnathan Roach's starfield codes.
'Refer to his submission Project Space Demo
'on planet source code
For i = 0 To Detail_Level
Star(i).PosY = Star(i).PosY + Star(i).Spd
If Star(i).PosY > 7920 Then
Star(i).PosY = 1440
Star(i).PosX = (Rnd * 4920 + 720)
Star(i).Spd = (Rnd * 40 + 20)
Star(i).Color = (Rnd * 2 + 1)
End If
Select Case (Star(i).Color)
Case 1:
Play_Layer.PSet (Star(i).PosX, Star(i).PosY), &HFFFFFF
Case 1:
Play_Layer.PSet (Star(i).PosX, Star(i).PosY), &HE0E0E0
Case Else:
Play_Layer.PSet (Star(i).PosX, Star(i).PosY), &HC0C0C0
End Select
Next i
'-----------------------------------------
'CREATING BULLET OBJECT
'If gun is firing, a new bullet is created
If Lock_MainGun = False And Lock_All = False And Ship_Firing = True Then
'The following codes are for weapons.
'Most of the have common variables.
'Bull_Delay is the delay between 2 bullets
' fired in succession
'B_Speed is the speed of the bullet moving
' across their X and Y corrdinates
'Bull_Type_Limit is the maximum number of
' bullets that can appear on the screen.
' Old bullets need to be 'hit' or flies
' out of the playing area before new ones can be
' created.
'As you'll notice, as the MG_Lvl (Maingun Level)
' and SG_Lvl (Sideguun Level) increases, the
' number of bullets, bull_delay, b_speed,
' bull_type_limit all changes to increase
' the weapons' efficiency.
' Certain weapons have their own custom
' variables to define their custom pattern.
' Most of these are self-explainary and can
' be understood by studying the weapon's code.
If SHP(0) = 0 Then 'VULCAN
Const Vulcan_Red_Damage = 15
If Bull_Delay = 0 Then
B_Speed = 340
If MG_Lvl >= 1 Then '----
Bull_Delay = 7
Bull_Type_Limit = 2
If MG_Lvl >= 2 Then '----
Bull_Type_Limit = 5
If MG_Lvl >= 3 Then '----
Bull_Delay = 6
Bull_Type_Limit = 19
If MG_Lvl >= 4 Then '----
If MG_Lvl >= 5 Then '----
Bull_Delay = 5
Bull_Type_Limit = 29
If MG_Lvl >= 6 Then '----
If MG_Lvl >= 7 Then '----
Bull_Type_Limit = 39
If MG_Lvl >= 8 Then '----
Bull_Delay = 4
Bull_Type_Limit = 49
If MG_Lvl >= 9 Then '----
Bull_Type_Limit = 59
If MG_Lvl >= 10 Then
Bull_Delay = 3
Bull_Type_Limit = 99
End If '-End 10
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 1
Bull(i).Dire = 8
Bull(i).Span = 0
Bull(i).Dama = Vulcan_Red_Damage
Bull(i).PosX = ShipX + -100
Bull(i).PosY = ShipY + 320
Bull(i).Spd = B_Speed
Exit For
End If
Next i
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 1
Bull(i).Dire = 8
Bull(i).Span = 0
Bull(i).Dama = Vulcan_Red_Damage
Bull(i).PosX = ShipX + 620
Bull(i).PosY = ShipY + 320
Bull(i).Spd = B_Speed
Exit For
End If
Next i
End If '-End 9
End If
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 6
Bull(i).Dire = 73
Bull(i).Span = 0
Bull(i).Dama = Vulcan_Red_Damage
Bull(i).PosX = ShipX + 100
Bull(i).PosY = ShipY + 220
Bull(i).Spd = B_Speed
Exit For
End If
Next i
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 7
Bull(i).Dire = 93
Bull(i).Span = 0
Bull(i).Dama = Vulcan_Red_Damage
Bull(i).PosX = ShipX + 420
Bull(i).PosY = ShipY + 220
Bull(i).Spd = B_Speed
Exit For
End If
Next i
End If '-End 7
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 4
Bull(i).Dire = 72
Bull(i).Span = 0
Bull(i).Dama = Vulcan_Red_Damage
Bull(i).PosX = ShipX + 50
Bull(i).PosY = ShipY + 320
Bull(i).Spd = B_Speed
Exit For
End If
Next i
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 5
Bull(i).Dire = 92
Bull(i).Span = 0
Bull(i).Dama = Vulcan_Red_Damage
Bull(i).PosX = ShipX + 470
Bull(i).PosY = ShipY + 320
Bull(i).Spd = B_Speed
Exit For
End If
Next i
End If '-End 6
End If '-End 5
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 3
Bull(i).Dire = 7
Bull(i).Span = 0
Bull(i).Dama = Vulcan_Red_Damage
Bull(i).PosX = ShipX + 50
Bull(i).PosY = ShipY + 320
Bull(i).Spd = B_Speed
Exit For
End If
Next i
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 2
Bull(i).Dire = 9
Bull(i).Span = 0
Bull(i).Dama = Vulcan_Red_Damage
Bull(i).PosX = ShipX + 470
Bull(i).PosY = ShipY + 320
Bull(i).Spd = B_Speed
Exit For
End If
Next i
End If '-End 4
End If '-End 3
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 1
Bull(i).Dire = 8
Bull(i).Span = 0
Bull(i).Dama = Vulcan_Red_Damage
Bull(i).PosX = ShipX + 400
Bull(i).PosY = ShipY + 120
Bull(i).Spd = B_Speed
Exit For
End If
Next i
End If '-End 2
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = 1
Bull(i).Dire = 8
Bull(i).Span = 0
Bull(i).Dama = Vulcan_Red_Damage
If MG_Lvl = 1 Then
Bull(i).PosX = ShipX + 260
Else:
Bull(i).PosX = ShipX + 140
End If
Bull(i).PosY = ShipY + 120
Bull(i).Spd = B_Speed
Exit For
End If
Next i
End If '-End 1
End If
End If '-END VULCAN
If SHP(0) = 1 Then 'LIGHT BEAM
Dim Laser_OffSet As Integer
Dim Laser_Style As Integer
Dim Laser_Damage As Integer
Dim Laser_PosX As Integer
If Bull_Delay = 0 Then
If MG_Lvl >= 1 Then '----
B_Speed = 650
Laser_Style = 1
Laser_OffSet = 200
Laser_Damage = 3
Bull_Delay = 1
Bull_Type_Limit = 10
If MG_Lvl >= 2 Then '----
Laser_Style = 2
Laser_Damage = 5
End If
If MG_Lvl >= 3 Then '----
Laser_Style = 3
Laser_Damage = 7
End If
If MG_Lvl >= 4 Then '----
Laser_Style = 4
Laser_Damage = 10
End If
If MG_Lvl >= 5 Then '----
Laser_Style = 5
Laser_Damage = 12
End If
If MG_Lvl >= 6 Then '----
Laser_Style = 6
Laser_Damage = 15
End If
If MG_Lvl >= 7 Then '----
Laser_Style = 7
Laser_Damage = 18
End If
If MG_Lvl >= 8 Then '----
Laser_Style = 8
Laser_Damage = 20
End If
If MG_Lvl >= 9 Then '----
Laser_Style = 9
Laser_Damage = 25
End If
If MG_Lvl >= 10 Then '----
Laser_Style = 10
Laser_Damage = 35
End If
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = Laser_Style
Bull(i).Dire = 8
Bull(i).Span = 0
Bull(i).Dama = Laser_Damage
Bull(i).PosX = ShipX + Laser_OffSet
Bull(i).PosY = ShipY + 0
Bull(i).Spd = B_Speed
Laser_PosX = Bull(i).PosX
Exit For
End If
Next i
End If '-End 1
End If
End If '-END LIGHT BEAM
If SHP(0) = 2 Then 'PARTICLE BURST
Static Random_Bound As Integer
Static Particle_StartX(150) As Integer 'Start posX of particle weapon
Static Particle_StartY(150) As Integer 'Start posY
Static Particle_EndX(150) As Integer 'Destination PosX
Static Particle_EndY(150) As Integer 'Destination PosY
Static Particle_Range As Integer 'Determine Span of particle weapons
If Bull_Delay = 0 Then
Random_Bound = 3
If MG_Lvl >= 1 Then '----
B_Speed = 0 'Not Used
Bull_Delay = 3
Bull_Type_Limit = 150
Particle_Range = 13
If MG_Lvl >= 2 Then '----
Random_Bound = 9
End If
If MG_Lvl >= 3 Then '----
Bull_Delay = 2
End If
If MG_Lvl >= 4 Then '----
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = (Rnd * Random_Bound) + 1 + (23 - Random_Bound)
Bull(i).Dire = 79
Bull(i).Span = 0
If Bull(i).Kind >= 20 Then Bull(i).Dama = 6
If Bull(i).Kind >= 16 And Bull(i).Kind <= 19 Then Bull(i).Dama = 8
If Bull(i).Kind >= 11 And Bull(i).Kind <= 15 Then Bull(i).Dama = 12
If Bull(i).Kind >= 5 And Bull(i).Kind <= 10 Then Bull(i).Dama = 16
If Bull(i).Kind >= 1 And Bull(i).Kind <= 4 Then Bull(i).Dama = 24
Bull(i).PosX = ShipX + 270
Bull(i).PosY = ShipY + 120
Bull(i).Spd = B_Speed
Particle_StartX(i) = Bull(i).PosX
Particle_StartY(i) = Bull(i).PosY
Particle_EndX(i) = Bull(i).PosX - 1500 + (Rnd * 3000)
Particle_EndY(i) = Bull(i).PosY - 6200 + (Rnd * 2000)
Exit For
End If
Next i
End If '-End 3
If MG_Lvl >= 5 Then '----
Random_Bound = 14
End If
If MG_Lvl >= 6 Then '----
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = (Rnd * Random_Bound) + 1 + (23 - Random_Bound)
Bull(i).Dire = 79
Bull(i).Span = 0
If Bull(i).Kind >= 20 Then Bull(i).Dama = 6
If Bull(i).Kind >= 16 And Bull(i).Kind <= 19 Then Bull(i).Dama = 8
If Bull(i).Kind >= 11 And Bull(i).Kind <= 15 Then Bull(i).Dama = 12
If Bull(i).Kind >= 5 And Bull(i).Kind <= 10 Then Bull(i).Dama = 16
If Bull(i).Kind >= 1 And Bull(i).Kind <= 4 Then Bull(i).Dama = 24
Bull(i).PosX = ShipX + 270
Bull(i).PosY = ShipY + 120
Bull(i).Spd = B_Speed
Particle_StartX(i) = Bull(i).PosX
Particle_StartY(i) = Bull(i).PosY
Particle_EndX(i) = Bull(i).PosX - 1500 + (Rnd * 3000)
Particle_EndY(i) = Bull(i).PosY - 6200 + (Rnd * 2000)
Exit For
End If
Next i
End If '-End 6
If MG_Lvl >= 7 Then '----
Random_Bound = 19
End If
If MG_Lvl >= 8 Then '----
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = (Rnd * Random_Bound) + 1 + (23 - Random_Bound)
Bull(i).Dire = 79
Bull(i).Span = 0
If Bull(i).Kind >= 20 Then Bull(i).Dama = 6
If Bull(i).Kind >= 16 And Bull(i).Kind <= 19 Then Bull(i).Dama = 8
If Bull(i).Kind >= 11 And Bull(i).Kind <= 15 Then Bull(i).Dama = 12
If Bull(i).Kind >= 5 And Bull(i).Kind <= 10 Then Bull(i).Dama = 16
If Bull(i).Kind >= 1 And Bull(i).Kind <= 4 Then Bull(i).Dama = 24
Bull(i).PosX = ShipX + 270
Bull(i).PosY = ShipY + 120
Bull(i).Spd = B_Speed
Particle_StartX(i) = Bull(i).PosX
Particle_StartY(i) = Bull(i).PosY
Particle_EndX(i) = Bull(i).PosX - 1500 + (Rnd * 3000)
Particle_EndY(i) = Bull(i).PosY - 6200 + (Rnd * 2000)
Exit For
End If
Next i
End If '-End 8
If MG_Lvl >= 9 Then '----
Random_Bound = 23
Bull_Delay = 1
End If
If MG_Lvl >= 10 Then '----
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = (Rnd * Random_Bound) + 1 + (23 - Random_Bound)
Bull(i).Dire = 79
Bull(i).Span = 0
If Bull(i).Kind >= 20 Then Bull(i).Dama = 6
If Bull(i).Kind >= 16 And Bull(i).Kind <= 19 Then Bull(i).Dama = 8
If Bull(i).Kind >= 11 And Bull(i).Kind <= 15 Then Bull(i).Dama = 12
If Bull(i).Kind >= 5 And Bull(i).Kind <= 10 Then Bull(i).Dama = 16
If Bull(i).Kind >= 1 And Bull(i).Kind <= 4 Then Bull(i).Dama = 24
Bull(i).PosX = ShipX + 270
Bull(i).PosY = ShipY + 120
Bull(i).Spd = B_Speed
Particle_StartX(i) = Bull(i).PosX
Particle_StartY(i) = Bull(i).PosY
Particle_EndX(i) = Bull(i).PosX - 1500 + (Rnd * 3000)
Particle_EndY(i) = Bull(i).PosY - 6200 + (Rnd * 2000)
Exit For
End If
Next i
End If '-End 10
For i = 0 To Bull_Type_Limit
If Bull(i).Used = False Then
Bull(i).Used = True
Bull(i).Kind = (Rnd * Random_Bound) + 1 + (23 - Random_Bound)
Bull(i).Dire = 79
Bull(i).Span = 0
If Bull(i).Kind >= 20 Then Bull(i).Dama = 6
If Bull(i).Kind >= 16 And Bull(i).Kind <= 19 Then Bull(i).Dama = 8
If Bull(i).Kind >= 11 And Bull(i).Kind <= 15 Then Bull(i).Dama = 12
If Bull(i).Kind >= 5 And Bull(i).Kind <= 10 Then Bull(i).Dama = 16
If Bull(i).Kind >= 1 And Bull(i).Kind <= 4 Then Bull(i).Dama = 24
Bull(i).PosX = ShipX + 270
Bull(i).PosY = ShipY + 120
Bull(i).Spd = B_Speed
Particle_StartX(i) = Bull(i).PosX
Particle_StartY(i) = Bull(i).PosY
Particle_EndX(i) = Bull(i).PosX - 1500 + (Rnd * 3000)
Particle_EndY(i) = Bull(i).PosY - 6200 + (Rnd * 2000)
Exit For
End If
Next i
End If '-End 1
End If
End If '-END PARTICLE BURST
If SHP(0) = 3 Then 'PLASMA WAVE
Dim Wave_Pattern As Integer
If Bull_Delay = 0 Then
If MG_Lvl >= 1 Then '----
B_Speed = 0 'Not Used
Bull_Delay = 6
Bull_Type_Limit = 2
Wave_Pattern = 1
If MG_Lvl >= 2 Then
Wave_Pattern = 2
End If
If MG_Lvl >= 3 Then
Wave_Pattern = 3
Bull_Delay = 5