基于VB6.0射击游戏的实现

' SHOOTOUT.BAS
Option Explicit
' Data type required by the IntersectRect function
Type tRect
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
' Windows API rectangle functions
Declare Function IntersectRect Lib "user32" (lpDestRect As tRect, lpSrc1Rect As tRect, lpSrc2Rect As tRect) As Long
' Functions and constants used to play sounds.
Declare Function sndPlaySound Lib "winmm.dll" Alias "sndPlaySoundA" (ByVal lpszSoundName As String, ByVal uFlags As Long) As Long
' Constant used with sndPlaySound function
Global Const SND_ASYNC = &H1
'----------------------------------------------------------
' SHOOTOUT.FRM
Option Explicit
' KeyCodes for keyboard action.
Const KEY_SPACE = &H20
Const KEY_UP = &H26
Const KEY_DOWN = &H28
' Number of Twips to move player on each key or mouse event.
Const PlayerIncrement = 45
' Constants for mouse action.
Const NO_BUTTON = 0
Const LBUTTON = 1
Const RBUTTON = 2
' Boolean that indicates if mouse button has been pressed down.
Dim MouseButtonDown As Integer
' Number of bullets either player can have in use at one time.
Const NUM_BULLETS = 6
' Booleans indicating if player 0 or player 1 have just fired.
Dim GunFired(0 To 1) As Integer

' Start the game by enabling the main timer and hiding the start button.
Private Sub btnStart_Click()
Timer1.Enabled = True
btnStart.Visible = False
End Sub

' Check if the two Images intersect, using the IntersectRect API call.
Private Function Collided(imgA As Image, imgB As Image) As Integer
Dim A As tRect
Dim B As tRect
Dim ResultRect As tRect
' Copy information into tRect structure
A.Left = imgA.Left
A.Top = imgA.Top
B.Left = imgB.Left
B.Top = imgB.Top
' Calculate the right and bottoms of rectangles needed by the API call.
A.Right = A.Left + imgA.Width - 1
A.Bottom = A.Top + imgA.Height - 1
B.Right = B.Left + imgB.Width - 1
B.Bottom = B.Top + imgB.Height - 1
' IntersectRect will only return 0 (false) if the
' two rectangles do NOT intersect.
Collided = IntersectRect(ResultRect, A, B)
End Function

' Double-clicking the mouse fires Player 1's gun.
Private Sub Form_DblClick()
Dim rc As Integer
If Not Timer1.Enabled Then Exit Sub
GunFired(1) = True
rc = sndPlaySound(App.Path & "\BANG.WAV", SND_ASYNC)
End Sub

' This event handles Player 0's game action via the keyboard.
Private Sub Form_KeyDown(KeyCode As Integer, Shift As Integer)
Dim rc As Integer
Static InKeyDown As Integer
If Not Timer1.Enabled Then Exit Sub
If InKeyDown Then Exit Sub
InKeyDown = True
DoEvents
Select Case KeyCode
Case KEY_UP
imgPlayer(0).Top = imgPlayer(0).Top - PlayerIncrement
If imgPlayer(0).Top < 0 Then imgPlayer(0).Top = 0
Case KEY_SPACE
GunFired(0) = True
rc = sndPlaySound(App.Path & "\BANG.WAV", SND_ASYNC)
Case KEY_DOWN
imgPlayer(0).Top = imgPlayer(0).Top + PlayerIncrement
If imgPlayer(0).Top > (picDesert.ScaleHeight -
imgPlayer(0).Height) Then
imgPlayer(0).Top = picDesert.ScaleHeight -
imgPlayer(0).Height
End If
End Select
InKeyDown = False
End Sub

Private Sub Form_Load()
Dim i As Integer
Timer1.Interval = 22
Timer1.Enabled = False
MouseButtonDown = NO_BUTTON
For i = 1 To NUM_BULLETS - 1
Load imgLBullet(i)
Load imgRBullet(i)
Next
End Sub

Private Sub Form_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseButtonDown = Button
End Sub

Private Sub Form_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
MouseButtonDown = NO_BUTTON
End Sub

' The main game timer.
Private Sub Timer1_Timer()
Const CactusIncrement = 30
Const BulletIncrement = 300
Const NumCacti = 2

Dim i As Integer
Dim rc As Integer
' Move the roving cacti.
For i = 0 To NumCacti - 1
imgCactus(i).Top = imgCactus(i).Top - CactusIncrement
If imgCactus(i).Top < -imgCactus(i).Height Then
imgCactus(i).Top = picDesert.Height
End If
Next
' Did player 0 fire a bullet?
If GunFired(0) Then
GunFired(0) = False
' Find a spare (invisible) bullet.
For i = 0 To NUM_BULLETS - 1
If Not imgLBullet(i).Visible Then
imgLBullet(i).Top = imgPlayer(0).Top
imgLBullet(i).Left = imgPlayer(0).Left +
(imgPlayer(0).Width / 2)
imgLBullet(i).Visible = True
Exit For
End If
Next
End If
' Did player 1 fire a bullet?
If GunFired(1) Then
GunFired(1) = False
' Find a spare (invisible) bullet.
For i = 0 To NUM_BULLETS - 1
If Not imgRBullet(i).Visible Then
imgRBullet(i).Top = imgPlayer(1).Top
imgRBullet(i).Left = imgPlayer(1).Left -
(imgPlayer(1).Width / 2)
imgRBullet(i).Visible = True
Exit For
End If
Next
End If
' Move Visible Bullets
For i = 0 To NUM_BULLETS - 1
' Move player 0's bullets.
If imgLBullet(i).Visible Then
imgLBullet(i).Left = imgLBullet(i).Left + BulletIncrement
If Collided(imgLBullet(i), imgCactus(0)) Then
imgLBullet(i).Visible = False
ElseIf Collided(imgLBullet(i), imgCactus(1)) Then
imgLBullet(i).Visible = False
ElseIf imgLBullet(i).Left > picDesert.ScaleWidth Then
imgLBullet(i).Visible = False
ElseIf Collided(imgLBullet(i), imgPlayer(1)) Then
imgLBullet(i).Visible = False
imgPlayer(1).Picture = imgRIP.Picture
Timer1.Enabled = False
rc = sndPlaySound(App.Path & "\OH!!.WAV", SND_ASYNC)
End If
End If
' Move player 1's bullets.
If imgRBullet(i).Visible Then
imgRBullet(i).Left = imgRBullet(i).Left - BulletIncrement
If Collided(imgRBullet(i), imgCactus(0)) Then
imgRBullet(i).Visible = False
ElseIf Collided(imgRBullet(i), imgCactus(1)) Then
imgRBullet(i).Visible = False
ElseIf imgRBullet(i).Left < -imgRBullet(i).Width Then
imgRBullet(i).Visible = False
ElseIf Collided(imgRBullet(i), imgPlayer(0)) Then
imgRBullet(i).Visible = False
imgPlayer(0).Picture = imgRIP.Picture
Timer1.Enabled = False
rc = sndPlaySound(App.Path & "\OH!!.WAV", SND_ASYNC)
End If
End If
Next
End Sub

' Handle Player 1's movement (up and down).
Private Sub tmrMouseCntl_Timer()
If Not Timer1.Enabled Then Exit Sub
Select Case MouseButtonDown
Case RBUTTON
imgPlayer(1).Top = imgPlayer(1).Top - PlayerIncrement
If imgPlayer(1).Top < 0 Then imgPlayer(1).Top = 0
Case LBUTTON
imgPlayer(1).Top = imgPlayer(1).Top + PlayerIncrement
If imgPlayer(1).Top > (picDesert.ScaleHeight -
imgPlayer(1).Height) Then
imgPlayer(1).Top = picDesert.ScaleHeight -
imgPlayer(1).Height
End If
End Select
End Sub