基于VB6.0射击游戏的实现急急!!!!!求救

基于VB6.0射击游戏的实现急急!!!!!求救,第1张

你是要源程序,还是要安装软件?????

角色击中标志

为了使程序中的仙人掌、游戏角色和射击时发射的子d可以移动,需要向项目中添加定时器tmrMouseCnt和Timer1,在这两个定时响应函数中完成不同对象的移动功能。在游戏运行后,为了使用户可以通过键盘和鼠标来 *** 作游戏的角色,实现射击的功能,需要添加鼠标消息和键盘消息处理函数。例如,对于角色1来说,可以通过上下键来移动,空格键来射击,对于角色2来说,鼠标左右键控制移动,双击实现射击。在射击过程中,要处理两个细节,一个细节是子d与仙人掌及角色的区域重叠问题,当子d与仙人掌重叠时让子d隐藏起来,与角色重叠时表示击中目标,游戏结束。这里需要判断何时两个区域有重叠,解决这个问题的方法是使用API函数IntersectRect,用它来判断两个区域是否有重叠。另一个细节是子d射击过程中需要添加"呼啸"的声音和击中目标时添加人物惨叫的声音,来达到逼真的效果,为了实现这个功能,需要向程序中添加语音文件(程序中的语音文件分别为:BANG.WAV和OH!!.WAV),然后通过API函数sndPlaySound来实现。另外,在对象移动的过程中,需要注意移动到边缘位置的情况处理。

程序的具体实现代码如下:

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

Private Declare Function GetObject Lib "gdi32 "

Private Declare Function GetBitmapBits Lib "gdi32 "

Private Declare Function SetBitmapBits Lib "gdi32 "

Dim PicBits() As Byte, PicInfo As BITMAP, Cnt As Long

Private Sub Command1_Click()

Set Picture1.Picture = Clipboard.GetData(vbCFBitmap)

GetObject Picture1.Picture, Len(PicInfo), PicInfo

Debug.Print PicInfo.bmWidth * PicInfo.bmHeight * 3

ReDim PicBits(1 To PicInfo.bmWidth * PicInfo.bmHeight * 3) As Byte

GetBitmapBits Picture1.Picture, UBound(PicBits), PicBits(1)

For Cnt = 1 To UBound(PicBits)

PicBits(Cnt) = 255 - PicBits(Cnt)

Next Cnt

SetBitmapBits Picture1.Picture, UBound(PicBits), PicBits(1)

Picture1.Refresh

End Sub


欢迎分享,转载请注明来源:内存溢出

原文地址: http://outofmemory.cn/yw/11463289.html

(0)
打赏 微信扫一扫 微信扫一扫 支付宝扫一扫 支付宝扫一扫
上一篇 2023-05-16
下一篇 2023-05-16

发表评论

登录后才能评论

评论列表(0条)

保存