mvaders.bas

八脚蟹》射击游戏源码

Attribute VB_Name = "MVADERS1"
Option Explicit

'Game Play Area Dimensions
Global Const GAME_WIDTH = 500
Global Const GAME_HEIGHT = 400

'Game modes
Global Const DEMO_MODE = 0
Global Const PLAYING_MODE = 1
Global Const PAUSED_MODE = 2

Global Const vbModal = 1

'Used to make a string read only
Global Const WM_USER = &H400
Global Const EM_SETREADONLY = (WM_USER + 31)

'Define how many sprites are in use
Global Const MAX_SPRITES_USED = 65

'Sprite IDs for Sprite Engine
Global Const PLAYER_ID = 0
Global Const FIRST_PLAYER_BULLET_ID = 1
Global Const LAST_PLAYER_BULLET_ID = 9
Global Const FIRST_INVADER_BULLET_ID = 10
Global Const LAST_INVADER_BULLET_ID = 14
Global Const BONUS_SHIP_ID = 15
Global Const FIRST_EXPLOSION_ID = 16
Global Const LAST_EXPLOSION_ID = 25
Global Const FIRST_POWER_UP_ID = 26
Global Const LAST_POWER_UP_ID = 30
Global Const FIRST_BARRIER_ID = 31
Global Const LAST_BARRIER_ID = 33
Global Const FIRST_INVADER_ID = 34
Global Const LAST_INVADER_ID = 63
Global Const SHIELD_ID = 64

'Custom sprite IDs used in game
Global Const INIT_PLAYER_ID = 1
Global Const INIT_PLAYER_BULLET_UP_ID = 2
Global Const INIT_PLAYER_BULLET_LEFT_ID = 3
Global Const INIT_PLAYER_BULLET_RIGHT_ID = 4
Global Const INIT_INVADER_BULLET_ID = 5
Global Const INIT_BONUS_SHIP_ID = 6
Global Const INIT_EXPLOSION_ID = 7
Global Const INIT_POWER_UP_ID = 8
Global Const INIT_BARRIER_ID = 9
Global Const INIT_FIRST_INVADER_ID = 10
Global Const INIT_LAST_INVADER_ID = 57
Global Const INIT_SHIELD_ID = 58

'Fire power, controlled by power-ups
Global Const FIRE_SINGLE = 1
Global Const FIRE_DOUBLE = 2
Global Const FIRE_TRIPLE = 3

'Flags for monitoring movement keys
Global Const KEY_CUR_LEFT_FLAG = 1
Global Const KEY_CUR_RIGHT_FLAG = 2
Global Const KEY_FIRE_FLAG = 4

'KeyCode values for important keys
Global Const KEY_CUR_LEFT = 37
Global Const KEY_CUR_RIGHT = 39
Global Const KEY_FIRE = 32
Global Const KEY_ABORT = 65
Global Const KEY_PAUSE = 80
Global Const KEY_QUIT = 81

'Invader attributes user type
Type Invader
    iId As Integer          'Defines gfx to use
    iX As Integer           'Starting X ordinate
    iY As Integer           'Starting Y ordinate
    iTx As Integer          'Id to transform into
    iHits As Integer        'Number of hits to kill
    iPowerUp As Integer     'Power-up flag
End Type

'User type to store first & last Invader pointers for each level
Type LevelDef
    iFirst As Integer       'Index of first Invader
    iLast As Integer        'Index of last Invader
End Type

'User type that describes what frames to use for a particular sprite
Type FrameDef
    iFirst As Integer       'Index of first frame
    iLast As Integer        'Index of last frame
End Type

'Game preferences user type
Type Prefs
    iTimer As Integer       'Timer value that controls game loop
    iIGap As Integer        'Invaders separation
    iISpeed As Integer      'Invaders initial speed
    iIBSpeed As Integer     'Invaders bullet speed
    fIBFreq As Single       'Invaders bullet frequency
    iIDrop As Integer       'Invaders drop rate
    iPSpeed As Integer      'Players speed
    iPBSpeed As Integer     'Players bullet speed
End Type

'User type for holding high scores
Type FameEntry
    iScore As Integer
    sName As String * 35
End Type

'Global Variables
Global gtInvader() As Invader       'Customised sprite defenitions
Global gtLevel() As LevelDef        'Indecies into gtInvader of 1st and last sprite for each level
Global gtSprites(58) As FrameDef    'Defines available sprites
Global giNumLevels As Integer       'Total number of levels in current game
Global giCurLevel As Integer        'Current level being played
Global giKeyStatus As Integer       'Holds movement key flags
Global giHighScore As Integer       'Highest score to date
Global gsWho As String * 20         'Name of person with highest score
Global giScore As Integer           'Current score
Global gtFame(10) As FameEntry      'Best 10 high scores
Global giLives As Integer           'Lives remaining
Global giNumInvaders As Integer     'Number of invaders to kill on current level
Global giKilled As Integer          'Number killed so far on current level
Global giExtraLife As Integer       'Countdown to extra life
Global giFirePower As Integer       '1=single shot, 2=double, 3=tripple
Global giFireRate As Integer        'Delay between firing, 5 or 10 frames
Global giDelay As Integer           'Used to pause at end of game
Global giShield As Integer          'Cant shoot when set, buts counts down
Global giBonusTmr As Integer        'Countdown for bonus ship
Global GamePrefs As Prefs           'Game preferences

'flag values for wFlags parameter of sndPlaySound()
Global Const SND_SYNC = &H0                 '  play synchronously (default)
Global Const SND_ASYNC = &H1                '  play asynchronously
Global Const SND_NODEFAULT = &H2            '  don't use default sound
Global Const SND_MEMORY = &H4               '  lpszSoundName points to a memory file
Global Const SND_LOOP = &H8                 '  loop the sound until next sndPlaySound
Global Const SND_NOSTOP = &H10              '  don't stop any currently playing sound

'API declarations
Declare Function SendMessage Lib "User" (ByVal hWnd As Integer, ByVal wMsg As Integer, ByVal wParam As Integer, ByVal lParam As Any) As Long
'Declare Function sndPlaySound Lib "MMSYSTEM" (ByVal lpszSoundName As String, ByVal uFlags As Integer) As Integer

'=========================================================
'==AutoDoc==
'Purpose
'Entry
'Exit
'Comments

Sub CenterForm(Frm As Form)
'==AutoDoc==
'Purpose    Center a form on the screen, best called from
'           the Form_Load() event handler.
'Entry      Frm - the form to center
'Comments   One of Marks routines!
'           In Form_Load: CenterForm Me

Frm.Move (Screen.Width - Frm.Width) \ 2, (Screen.Height - Frm.Height) \ 2

End Sub

Sub CheckScore()
'==AutoDoc==
'Purpose    Checks if a players high score should
'           be added to the hall of fame. Saves
'           scores to disk if so.
'Entry      None
'Exit       None
'Comments

Dim i As Integer
Dim j As Integer
Dim iTmp As Integer
Dim iPos As Integer
Dim iFNum As Integer
Dim sFName As Integer
Dim sName As String * 35

For i = 1 To 10
    'If score beats on of the highest, store it
    If giScore > gtFame(i).iScore Then
        'Shuffle other scores down one
        For j = 10 To (i + 1) Step -1
            gtFame(j) = gtFame(j - 1)
        Next j
        gtFame(i).iScore = giScore
        gtFame(i).sName = ""
        'Fetch players name
        Load frmHighScore
        frmHighScore.lblXFer = Format$(i, "")
        frmHighScore.Show vbModal
        'Fetch & store the players name
        gtFame(i).sName = frmHighScore.lblXFer
        'Remove high score window
        Unload frmHighScore
        'Save the new hall o fame;)
        SaveFame
        'Update top score if suitable
        If giScore > giHighScore Then
            giHighScore = giScore
            gsWho = gtFame(i).sName
        End If
        'Dont check any more
        Exit For
    End If
Next i
End Sub

Sub FatalError(ByVal sMsg As String)
'==AutoDoc==
'Purpose    Display a common error message
'Entry      sMsg - Reason game failed to load

MsgBox "MVaders has failed to load because:" & Chr$(10) & sMsg

End Sub

Sub gInitSprites()
'==AutoDoc==
'Purpose    Define all sprites available in the game
'Entry      None
'Exit       None
'Comments   Builds the array that holds the first & last
'           frame in each sprites animation sequence,
'           my Frame Editor utility was used to get the
'           info required.

Dim i As Integer
Dim iInvader As Integer

gtSprites(INIT_PLAYER_ID).iFirst = 0
gtSprites(INIT_PLAYER_ID).iLast = 1
gtSprites(INIT_PLAYER_BULLET_LEFT_ID).iFirst = 104
gtSprites(INIT_PLAYER_BULLET_LEFT_ID).iLast = 105
gtSprites(INIT_PLAYER_BULLET_UP_ID).iFirst = 102
gtSprites(INIT_PLAYER_BULLET_UP_ID).iLast = 103
gtSprites(INIT_PLAYER_BULLET_RIGHT_ID).iFirst = 106
gtSprites(INIT_PLAYER_BULLET_RIGHT_ID).iLast = 107
gtSprites(INIT_INVADER_BULLET_ID).iFirst = 110
gtSprites(INIT_INVADER_BULLET_ID).iLast = 111
gtSprites(INIT_BONUS_SHIP_ID).iFirst = 2
gtSprites(INIT_BONUS_SHIP_ID).iLast = 5
gtSprites(INIT_EXPLOSION_ID).iFirst = 117
gtSprites(INIT_EXPLOSION_ID).iLast = 121
gtSprites(INIT_POWER_UP_ID).iFirst = 108
gtSprites(INIT_POWER_UP_ID).iLast = 109
gtSprites(INIT_BARRIER_ID).iFirst = 112
gtSprites(INIT_BARRIER_ID).iLast = 116
gtSprites(INIT_SHIELD_ID).iFirst = 122
gtSprites(INIT_SHIELD_ID).iLast = 123

'Build all the invaders
i = 0
For iInvader = INIT_FIRST_INVADER_ID To INIT_LAST_INVADER_ID
    gtSprites(iInvader).iFirst = 6 + (i * 2)
    gtSprites(iInvader).iLast = 7 + (i * 2)
    i = i + 1
Next iInvader

End Sub

Sub gNewGame()
'==AutoDoc==
'Purpose    Initialise everything for a new game
'Entry      None
'Exit       None
'Comments

Dim i As Integer

giCurLevel = 1
giScore = 0
giLives = 3
giExtraLife = 500
giFirePower = FIRE_SINGLE
giFireRate = 8

'Clear the game DC
SprClearPlayDC

'Build the first level
i = iInitLevel(giCurLevel)

End Sub

Function gsExtractFileName(ByVal vsFullName As String) As String
'==AutoDoc==
'Purpose    Returns the name of a file from a full
'           filename that includes the path and all!
'Entry      vsFullName - Full pathname of the file
'Exit       The name of the file
'Comments   One of Marks routines!
'           Assumption: Only ':' and '\' are used
'           to separate components of the filename
'           If there is no path included with the
'           filename or some bogus string is sent
'           then the entire string is returned.

Dim i As Integer
Dim iLen As Integer
Dim sFName As String
Dim sChar As String * 1

'Get length of string supplied
iLen = Len(vsFullName)

'Step backwards until a separator is hit, building
'the name of the file as we go
For i = iLen To 1 Step -1
    sChar = Mid$(vsFullName, i, 1)
    If sChar = "\" Or sChar = ":" Then Exit For
    'Add character to beginning of filename
    sFName = sChar & sFName
Next i

'Return what was extracted
gsExtractFileName = sFName

End Function

Function iGetSprite(ByVal iId As Integer, ByVal iInitId As Integer, ByVal iActivate As Integer, ByVal iX As Integer, ByVal iY As Integer) As Integer
'==AutoDoc==
'Purpose    Allocate & position a sprite
'Entry      iId - Index of the sprite to allocate
'           iInitId - Index into gtSprites() for the
'                     sprite, used to get frame details
'           iActivate - True if the sprite is to be activated
'           iX - X pixel coordinate of TopLeft
'           iY - Y pixel coordinat of TopLeft
'Exit       True if sprite allocated & activated

Dim i As Integer
Dim tSpr As SprNewSprite

'Allocate the sprite
tSpr.iId = iId
tSpr.iFirstFrame = gtSprites(iInitId).iFirst
tSpr.iLastFrame = gtSprites(iInitId).iLast
tSpr.iAnimFlag = True
tSpr.iAnimRate = 2
i = iSprAllocateSprite(tSpr)

'Activate the sprite
If (i And iActivate) Then SprActivateSprite iId, iX, iY

'Return success
iGetSprite = i

End Function

Function iInitLevel(ByVal iLevel As Integer) As Integer
'==AutoDoc==
'Purpose    Build all sprites for a specified level
'Entry      iLevel - The level to build
'Exit       True if all sprite resources allocated
'Comments   Uses data held in gtLevel() and gtInvader() to
'           Allocate the Invaders sprites. Always
'           Allocates player, bullets, bonus ship,
'           explosions and power-ups!

Dim i As Integer
Dim j As Integer
Dim iRetVal As Integer
Dim iSprite As Integer
Dim iNumInvaders As Integer
Dim iStart As Integer
Dim iStep As Integer
Dim tSpr As SprNewSprite

'Start by freeing all sprites currently in use
SprFreeAllSprites

'Default success
iRetVal = True

'Allocate and activate the players ship
iRetVal = iRetVal And iGetSprite(PLAYER_ID, INIT_PLAYER_ID, True, 0, GAME_HEIGHT - 20)

'Allocate and activate the shield
iRetVal = iRetVal And iGetSprite(SHIELD_ID, INIT_SHIELD_ID, True, 0, GAME_HEIGHT - 20)

'Allocate the Players bullets
For i = FIRST_PLAYER_BULLET_ID To LAST_PLAYER_BULLET_ID
    If iRetVal Then iRetVal = iRetVal And iGetSprite(i, INIT_PLAYER_BULLET_UP_ID, False, 0, 0)
Next i

'Allocate the Invaders bullets
For i = FIRST_INVADER_BULLET_ID To LAST_INVADER_BULLET_ID
    If iRetVal Then iRetVal = iRetVal And iGetSprite(i, INIT_INVADER_BULLET_ID, False, 0, 0)
Next i

'Allocate the bonus ship
If iRetVal Then iRetVal = iRetVal And iGetSprite(BONUS_SHIP_ID, INIT_BONUS_SHIP_ID, False, 0, 0)

'Allocate the explosions
For i = FIRST_EXPLOSION_ID To LAST_EXPLOSION_ID
    If iRetVal Then iRetVal = iRetVal And iGetSprite(i, INIT_EXPLOSION_ID, False, 0, 0)
    gtSpr(i).iAnimRate = 1
Next i

'Allocate the power-ups
For i = FIRST_POWER_UP_ID To LAST_POWER_UP_ID
    If iRetVal Then iRetVal = iRetVal And iGetSprite(i, INIT_POWER_UP_ID, False, 0, 0)
Next i

'Allocate and activate the barriers, not auto-animated!
iStep = GAME_WIDTH \ 3
iStart = (iStep - 60) \ 2
For i = FIRST_BARRIER_ID To LAST_BARRIER_ID
    If iRetVal Then iRetVal = iRetVal And iGetSprite(i, INIT_BARRIER_ID, True, iStart, GAME_HEIGHT - 70)
    gtSpr(i).iAnimAuto = False
    iStart = iStart + iStep
Next i

'Allocate and activate the Invaders sprites
iSprite = gtLevel(iLevel).iFirst
giNumInvaders = gtLevel(iLevel).iLast - gtLevel(iLevel).iFirst + 1
For i = FIRST_INVADER_ID To (FIRST_INVADER_ID + giNumInvaders - 1)
    If iRetVal Then iRetVal = iRetVal And iGetSprite(i, gtInvader(iSprite).iId, True, gtInvader(iSprite).iX, gtInvader(iSprite).iY)
    
    'Configure special flags for this invader
    If iRetVal Then
        gtSpr(i).iUsr1 = gtInvader(iSprite).iHits
        gtSpr(i).iUsr2 = gtInvader(iSprite).iTx
        gtSpr(i).iUsr3 = gtInvader(iSprite).iPowerUp
    Else
    End If
    iSprite = iSprite + 1
Next i

'If any errors occurred, free ALL sprite resources
If Not iRetVal Then SprFreeAllSprites

'Reset level dependant variables
giKilled = 0
giShield = 2000 \ frmMVaders.tmrGameLoop.Interval
giKeyStatus = 0