frmmvade.frm

八脚蟹》射击游戏源码

VERSION 5.00
Begin VB.Form frmMVaders 
   Appearance      =   0  'Flat
   BackColor       =   &H00000000&
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "MVaders - A Visual Basic game by Mark Meany 1997,"
   ClientHeight    =   6780
   ClientLeft      =   570
   ClientTop       =   1770
   ClientWidth     =   9885
   ClipControls    =   0   'False
   BeginProperty Font 
      Name            =   "Courier New"
      Size            =   8.25
      Charset         =   0
      Weight          =   400
      Underline       =   0   'False
      Italic          =   0   'False
      Strikethrough   =   0   'False
   EndProperty
   ForeColor       =   &H0000FFFF&
   Icon            =   "FRMMVADE.frx":0000
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6780
   ScaleWidth      =   9885
   Begin VB.Timer tmrDemoLoop 
      Interval        =   50
      Left            =   1860
      Top             =   5340
   End
   Begin VB.Timer tmrGameLoop 
      Enabled         =   0   'False
      Interval        =   40
      Left            =   1380
      Top             =   5340
   End
   Begin VB.PictureBox picSpr 
      Appearance      =   0  'Flat
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H00000000&
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H0000FFFF&
      Height          =   495
      Left            =   60
      ScaleHeight     =   465
      ScaleWidth      =   1185
      TabIndex        =   0
      Top             =   5280
      Width           =   1215
   End
   Begin VB.Label lblStatus 
      Appearance      =   0  'Flat
      BackColor       =   &H80000005&
      BackStyle       =   0  'Transparent
      BeginProperty Font 
         Name            =   "Courier New"
         Size            =   7.5
         Charset         =   0
         Weight          =   400
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      ForeColor       =   &H00FFFFFF&
      Height          =   315
      Left            =   480
      TabIndex        =   1
      Top             =   180
      Width           =   6435
   End
   Begin VB.Menu mnuFile 
      Caption         =   "&File"
      Begin VB.Menu mnuFileNew 
         Caption         =   "&New Game"
      End
      Begin VB.Menu mnuFileLoad 
         Caption         =   "&Load Game"
      End
      Begin VB.Menu mnuFileSep 
         Caption         =   "-"
      End
      Begin VB.Menu mnuFileExit 
         Caption         =   "E&xit"
      End
   End
   Begin VB.Menu mnuGame 
      Caption         =   "&Game"
      Begin VB.Menu mnuGameOptions 
         Caption         =   "&Options"
      End
   End
   Begin VB.Menu mnuHelp 
      Caption         =   "&Help"
      Begin VB.Menu mnuHelpAbout 
         Caption         =   "&About"
      End
   End
End
Attribute VB_Name = "frmMVaders"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Dim miTX As Integer
Dim miTy As Integer

Private Sub Form_Activate()

Dim iW As Integer

'Make sure form is big enough

'Center the form
CenterForm Me

'Center the play area in the form
miTX = ((Me.ScaleWidth / Screen.TwipsPerPixelX) - GAME_WIDTH) \ 2
miTy = ((Me.ScaleHeight / Screen.TwipsPerPixelY) - GAME_HEIGHT) \ 2

'Position the score label accordingly
iW = GAME_WIDTH * Screen.TwipsPerPixelX
lblStatus.Move (frmMVaders.Width - iW) \ 2, miTy * Screen.TwipsPerPixelY - lblStatus.Height, iW

End Sub

Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)

'Act on keys we need to monitor
Select Case KeyCode

Case KEY_CUR_LEFT   'Moving left
    giKeyStatus = giKeyStatus Or KEY_CUR_LEFT_FLAG

Case KEY_CUR_RIGHT  'Moving right
    giKeyStatus = giKeyStatus Or KEY_CUR_RIGHT_FLAG

Case KEY_FIRE       'Firing
    giKeyStatus = giKeyStatus Or KEY_FIRE_FLAG

Case KEY_PAUSE      'Pausing the game

Case KEY_ABORT

Case KEY_QUIT       'Quitting the game
    tmrGameLoop.Enabled = False
    frmMVaders.Hide

End Select
End Sub

Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)

Select Case KeyCode

Case KEY_CUR_LEFT   'Moving left
    giKeyStatus = giKeyStatus And (Not KEY_CUR_LEFT_FLAG)

Case KEY_CUR_RIGHT  'Moving right
    giKeyStatus = giKeyStatus And (Not KEY_CUR_RIGHT_FLAG)

Case KEY_FIRE       'Firing
    giKeyStatus = giKeyStatus And (Not KEY_FIRE_FLAG)

End Select

End Sub

Private Sub mnuFileExit_Click()

'Unload us so we shut down gracefully
Unload frmMVaders

End Sub

Private Sub mnuFileLoad_Click()

Dim i As Integer

'Allow player to load a new game only if no game in progress
If tmrGameLoop.Enabled = False Then
    frmFileSel.Show vbModal
End If

End Sub

Private Sub mnuFileNew_Click()

'Allow player to stsart a new game only if no game in progress
If tmrGameLoop.Enabled = False Then
    giKeyStatus = giKeyStatus Or KEY_FIRE_FLAG
End If

End Sub

Private Sub mnuGameOptions_Click()

'Allow player to change game options only if no game in progress
If tmrGameLoop.Enabled = False Then
    frmOptions.Show vbModal
    tmrGameLoop.Interval = GamePrefs.iTimer
End If

End Sub

Private Sub mnuHelpAbout_Click()

frmAbout.Show vbModal

End Sub

Private Sub tmrDemoLoop_Timer()

'The game is not running, so we must keep the player
'interested enough to stay here;)

Static iCountDown As Integer
Static iFrame As Integer

'Update the status bar
lblStatus = "Lives:" & Str$(giLives) & "  High Score:" & Str$(giHighScore) & "0 " & gsWho & "    Level:" & Str$(giCurLevel) & "  Score:" & Str$(giScore) & "0"

If iCountDown Then
    iCountDown = iCountDown - 1
Else
    iFrame = iFrame + 1
    If iFrame > 3 Then iFrame = 1
    iCountDown = 5 * 20 '5 seconds delay
    SprSetBackground "Splash" & Format$(iFrame, "") & ".bmp", picSpr
    SprShowPlayDC frmMVaders.hdc, miTX, miTy
    If iFrame = 1 Then ShowScores picSpr
End If

If giDelay Then
    giDelay = giDelay - 1
Else
    If giKeyStatus And KEY_FIRE_FLAG Then
        gNewGame
        tmrDemoLoop.Enabled = False
        tmrGameLoop.Enabled = True
    End If
End If

End Sub

Private Sub tmrGameLoop_Timer()

Dim h As Integer
Dim i As Integer
Dim iStart As Integer
Dim iStep As Integer
Dim j As Integer
Dim k As Integer
Dim iYMax As Integer
Dim iXMin As Integer
Dim iXMax As Integer
Dim l As Long

Dim iDebug As Integer

Static iFireDelay As Integer
Static iDx As Integer
Static iDy As Integer
Static iPaused As Integer
Static iGameOver As Integer

'Initialise iDX
If iDx = 0 Then iDx = GamePrefs.iISpeed '1

'Update the status bar
lblStatus = "Lives:" & Str$(giLives) & "  High Score:" & Str$(giHighScore) & "0 " & gsWho & "    Level:" & Str$(giCurLevel) & "  Score:" & Str$(giScore) & "0"
'Restore backgrounds
SprRestore

'Animate sprites
SprAnimAuto

'If paused, just redisplay sprites and exit
If iPaused Then
    iPaused = iPaused - 1
    
    'Check if an explosion has run its course
    For j = FIRST_EXPLOSION_ID To LAST_EXPLOSION_ID
        If gtSpr(j).iActive Then
            
            'Dec the countdown timer
            gtSpr(j).iUsr1 = gtSpr(j).iUsr1 - 1

            'If countdown expired then deactivate the sprite
            If gtSpr(j).iUsr1 = 0 Then SprDeactivateSprite j
        
        End If
    Next j

    'Draw sprites
    SprDraw

    'Update the display
    SprShowPlayDC frmMVaders.hdc, miTX, miTy

    'if pause is over and the game is over then jump to demo mode
    If iPaused = 0 And iGameOver Then
        iGameOver = False
        giDelay = 3 * 20
        tmrGameLoop.Enabled = False
        tmrDemoLoop.Enabled = True
        'Check high score
        CheckScore
        Exit Sub
    End If

    Exit Sub
End If

'Check if players bullet has hit an invader
For h = FIRST_PLAYER_BULLET_ID To LAST_PLAYER_BULLET_ID
    i = iSprCollisionRange(h, FIRST_INVADER_ID, LAST_INVADER_ID)
    If i Then
        'Adjust to actual sprite ID
        i = i - 1

        'Remove bullet
        SprDeactivateSprite h
        
        'Play an 'Oh shit you killed me' sound!
        PlayHitMe

        'Decrease hit count for this invader, kill 'em if its reached 0
        gtSpr(i).iUsr1 = gtSpr(i).iUsr1 - 1
        If gtSpr(i).iUsr1 = 0 Then

            'Handle transformers
            If gtSpr(i).iUsr2 Then
                gtSpr(i).iFirstFrame = gtSprites(gtSpr(i).iUsr2).iFirst
                gtSpr(i).iLastFrame = gtSprites(gtSpr(i).iUsr2).iLast
                gtSpr(i).iFrame = gtSpr(i).iFirstFrame
                gtSpr(i).iUsr2 = 0
                gtSpr(i).iUsr1 = 1 '1 hit to kill
            'Handle power-ups
            ElseIf gtSpr(i).iUsr3 Then
                For k = FIRST_POWER_UP_ID To LAST_POWER_UP_ID
                    If Not gtSpr(k).iActive Then
                        SprActivateSprite k, gtSpr(i).lX + (gtSpr(i).lW \ 2) - (gtSpr(j).lW \ 2), gtSpr(i).lY
                        gtSpr(k).iUsr1 = Int(Rnd * 6) + 1
                        Exit For
                    End If
                Next k
                SprDeactivateSprite i