VB太空大战代码

'键盘检测函数
Private Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
'CPU休息函数
Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
'画图函数
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long
Private Const SRCCOPY = &HCC0020 ' (DWORD) dest = source
Private Const SRCPAINT = &HEE0086 ' (DWORD) dest = source OR dest
Private Const SRCAND = &H8800C6 ' (DWORD) dest = source AND dest
'概念一个坐标结构体
Private Type POINTAPI
X As Long
Y As Long
End Type
Private Type Bullet '概念子弹的结构体
X As Integer 'X坐标
Y As Integer 'Y坐标
Width As Integer '子弹宽
Height As Integer '子弹高
Type As String '子弹类型，要紧和图片挂钩，什么类型的子弹画什么图State As String '状态
Owner As String '所有者
Speed As Integer '速度
Hurt As Integer '损害
End Type
Private Type Rocket '概念火箭的结构体
X As Integer 'X坐标
Y As Integer 'Y坐标
Width As Integer '宽
Height As Integer '高
Direct As String '方向
Action As String '行动
State As String '状态
Life As Integer '生命值
Level As Integer '品级
Speed As Integer '速度
FrTime As Integer '动画帧相对游戏帧的延时
Frame As Integer '动画第几帧
End Type
Private Type Enemy '概念仇敌的结构体
X As Integer 'X坐标
Y As Integer 'Y坐标
Type As String ' 类型
State As String '状态
Life As Integer '生命值
Speed As Integer '速度
FrTime As Integer '动画帧相对游戏帧的延时
Frame As Integer '动画第几帧
FrameSpeed As Integer '动画帧切换速度
Rect_LeftUp As POINTAPI '概念碰撞矩形的左上角点
Rect_RightDown As POINTAPI '概念碰撞矩形的右下角点
End Type
Private Type Boom '概念爆炸的结构体
X As Integer 'X坐标
Y As Integer 'Y坐标
Type As String '爆炸类型，要紧和图片挂钩，什么类型的画什么爆炸State As String '状态
Frame As Integer '动画第几帧
FrameSpeed As Integer '动画帧切换速度End Type
Const GAME_INIT = 0
Const GAME_MENU = 1
Const GAME_STARTING = 2
Const GAME_RUN = 3
Const GAME_RESTART = 4
Const GAME_EXIT = 5
Const BlltNum = 99 '100颗子弹
Const BoomNum = 49 '50个爆炸成效
Const EnemyNum = 29 '30个仇敌
Dim game_state As Integer '游戏的状态
Dim error As Integer '错误
Dim sY As Integer 'space 的y坐标
Dim mRocket As Rocket '概念一个火箭
Dim ShootInterval As Integer '概念火箭子弹距离Dim ShootLock As Boolean '概念发射锁
Dim Bllt(BlltNum) As Bullet '概念BlltNum颗子弹
Dim mBoom(BoomNum) As Boom '概念50个爆炸Dim mEnemy(EnemyNum) As Enemy '概念30个仇敌Dim EnemyN As Integer '仇敌显现的数量
Private Sub Start()
Do While game_state <> GAME_EXIT
Select Case game_state
Case Is = GAME_INIT
Init
game_state = GAME_MENU
Case Is = GAME_MENU
Menu
game_state = GAME_STARTING
Case Is = GAME_STARTING
Setup_For_Run '游戏设置
game_state = GAME_RUN '游戏开始Case Is = GAME_RUN
Clear '清场
Get_Input '获取输入
Do_Logic
Render_Frame
Wait
Case Is = GAME_RESTART
Fixup
game_state = GAME_MENU
Case Is = GAME_EXIT
Release_And_Cleanup
error = 0
End Select
DoEvents
Loop
End Sub
Private Sub Init()
End Sub
Private Sub Menu()
End Sub
Private Sub Setup_For_Run()
'背景太空的初始画图位置
sY = 1782
'创建火箭
With mRocket
'火箭初始的起始位置
.X = / 2 - 15
.Y = / 2
'火箭的生命值
.Life = 2
'火箭初始速度
.Speed = 2
'火箭动画切换速度
.FrameSpeed = 5
'火箭品级初始为1
.Level = 3
'火箭的宽和高
.Width = 29
.Height = 64
.State = "active" End With
'火箭发射子弹的初始距离
ShootInterval = 40
End Sub
Private Sub Clear()
End Sub
Private Sub Get_Input()
If (GetAsyncKeyState(vbKeyUp) <> 0) Then = "up" '按键上
If (GetAsyncKeyState(vbKeyDown) <> 0) Then = "down" '按键下
If (GetAsyncKeyState(vbKeyLeft) <> 0) Then = "left" '按键左
If (GetAsyncKeyState(vbKeyRight) <> 0) Then = "right" '按键右
If (GetAsyncKeyState(vbKeyUp) <> 0) And (GetAsyncKeyState(vbKeyLeft) <> 0) Then = "left_up" '按键左上
If (GetAsyncKeyState(vbKeyUp) <> 0) And (GetAsyncKeyState(vbKeyRight) <> 0) Then = "right_up" '按键右上
If (GetAsyncKeyState(vbKeyDown) <> 0) And (GetAsyncKeyState(vbKeyLeft) <> 0) Then = "left_down" '按键左下
If (GetAsyncKeyState(vbKeyDown) <> 0) And (GetAsyncKeyState(vbKeyRight) <> 0) Then = "right_down" '按键右下
If (GetAsyncKeyState(vbKeySpace) <> 0) Then = "shoot" '按键空格
' = GetAsyncKeyState(vbKeySpace)
End Sub
Private Sub Do_Logic()
'计算地图的转动切换
sY = sY - 1
If sY < 0 Then sY = 1782
'随机创建些仇敌
Create_Enemy
'计算火箭位移
Calc_Rocket_Move
'创建火箭发射的子弹
Create_Rocket_Bullet
'计算仇敌位移（包括是不是与火箭发生碰撞）
Calc_Enemy_Move
'计算子弹的位移（包括是不是与火箭或仇敌发生碰撞）
Calc_Bullet_Move
'计算动画帧（包括火箭、仇敌、爆炸）
Calc_Frame_Play
End Sub
Private Sub Render_Frame()
' 画太空图
BitBlt , 0, 0, 600, 600, , 0, sY - 600, SRCCOPY
BitBlt , 0, -sY, 600, 601, , 0, 1782 - 601, SRCCOPY
'画子弹
Dim i As Integer
For i = 0 To BlltNum
With Bllt(i)
If .State = "active" Then
If Left(.Type, 3) = "Lv1" Or Left(.Type, 3) = "Lv2" Then
BitBlt , .X, .Y, 8, 12, , 0, 0, SRCAND
BitBlt , .X, .Y, 8, 12, , 0, 12, SRCPAINT
ElseIf Left(.Type, 3) = "Lv3" Then
If .Type = "" Then
BitBlt , .X, .Y, 8, 8, , 8, 0, SRCAND
BitBlt , .X, .Y, 8, 8, , 8, 8, SRCPAINT
ElseIf .Type = "" Then
BitBlt , .X, .Y, 8, 12, , 0, 0, SRCAND
BitBlt , .X, .Y, 8, 12, , 0, 12, SRCPAINT
ElseIf .Type = "" Then
BitBlt , .X, .Y, 8, 12, , 0, 0, SRCAND
BitBlt , .X, .Y, 8, 12, , 0, 12, SRCPAINT
ElseIf .Type = "" Then
BitBlt , .X, .Y, 8, 8, , 8, 0, SRCAND
BitBlt , .X, .Y, 8, 8, , 8, 8, SRCPAINT
End If
End If
End If
End With
Next
' 画火箭
With mRocket
If .State = "active" Then
If .Frame = 1 Then
BitBlt , .X, .Y, 29, 64, , 0, 0, SRCAND
BitBlt , .X, .Y, 29, 64, , 0, 64, SRCPAINT
ElseIf .Frame = 2 Then
BitBlt , .X, .Y, 29, 64, , 29, 0, SRCAND
BitBlt , .X, .Y, 29, 64, , 29, 64, SRCPAINT
ElseIf .Frame = 3 Then
BitBlt , .X, .Y, 29, 64, , 58, 0, SRCAND
BitBlt , .X, .Y, 29, 64, , 58, 64, SRCPAINT
ElseIf .Frame = 4 Then
BitBlt , .X, .Y, 29, 64, , 87, 0, SRCAND
BitBlt , .X, .Y, 29, 64, , 87, 64, SRCPAINT
End If
End If
End With
'画仇敌
For i = 0 To EnemyNum
With mEnemy(i)
If .State = "active" Then
If .Type = "e1" Then
If .Frame = 1 Then
BitBlt , .X, .Y, 32, 50, , 0, 0, SRCAND
BitBlt , .X, .Y, 32, 50, , 0, 50, SRCPAINT
ElseIf .Frame = 2 Then
BitBlt , .X, .Y, 32, 50, , 32, 0, SRCAND
BitBlt , .X, .Y, 32, 50, , 32, 50, SRCPAINT
End If
End If
End If
End With
Next
'画爆炸
For i = 0 To BoomNum
With mBoom(i)
If .State = "active" Then
If .Frame = 1 Then
BitBlt , .X, .Y, 64, 64, , 0, 0, SRCAND
BitBlt , .X, .Y, 64, 64, , 0, 64, SRCPAINT
ElseIf .Frame = 2 Then
BitBlt , .X, .Y, 64, 64, , 64, 0, SRCAND
BitBlt , .X, .Y, 64, 64, , 64, 64, SRCPAINT
ElseIf .Frame = 3 Then
BitBlt , .X, .Y, 64, 64, , 128, 0, SRCAND
BitBlt , .X, .Y, 64, 64, , 128, 64, SRCPAINT
ElseIf .Frame = 4 Then
BitBlt , .X, .Y, 64, 64, , 192, 0, SRCAND
BitBlt , .X, .Y, 64, 64, , 192, 64, SRCPAINT
ElseIf .Frame = 5 Then
BitBlt , .X, .Y, 64, 64, , 256, 0, SRCAND
BitBlt , .X, .Y, 64, 64, , 256, 64, SRCPAINT
ElseIf .Frame = 6 Then
BitBlt , .X, .Y, 64, 64, , 320, 0, SRCAND
BitBlt , .X, .Y, 64, 64, , 320, 64, SRCPAINT
ElseIf .Frame = 7 Then
BitBlt , .X, .Y, 64, 64, , 384, 0, SRCAND
BitBlt , .X, .Y, 64, 64, , 384, 64, SRCPAINT
End If
End If
End With
Next
End Sub
Private Sub Wait()
Sleep 10
End Sub
Private Sub Fixup()
End Sub
Private Sub Release_And_Cleanup()
End Sub
Private Sub Form_Activate()
game_state = GAME_INIT
Start
End Sub
Private Sub Form_Unload(Cancel As Integer) game_state = GAME_EXIT
End Sub
'创建仇敌进程
Private Sub Create_Enemy()
Dim eX, i, n As Integer
Dim MaxNum As Integer '仇敌最大显现的个数MaxNum = 20
If EnemyN < MaxNum Then
Randomize
For i = 0 To EnemyNum
'创建仇敌
eX = Int(Rnd * 560)
With mEnemy(i)
If .State = "" Then
.Type = "e1"
.Speed = 2
.Life = 1
.State = "active"
.X = eX
.Y = -100
.FrameSpeed = 5
. = .X
. = .Y
EnemyN = EnemyN + 1
End If
End With
If EnemyN = MaxNum Then Exit For Next
End If
End Sub
'计算火箭位移
Private Sub Calc_Rocket_Move()
With mRocket
If .State = "active" Then
If .Direct = "up" Then '上If .Y >= .Speed Then .Y = .Y - .Speed
ElseIf .Direct = "down" Then '下If .Y <= 600 - .Speed - 64 Then .Y = .Y + .Speed
ElseIf .Direct = "left" Then '左
If .X >= .Speed Then .X = .X - .Speed
ElseIf .Direct = "right" Then '右
If .X <= 600 - .Speed - 29 Then .X = .X + .Speed
ElseIf .Direct = "left_up" Then '左上If .X >= .Speed Then .X = .X - .Speed * 2 / 3
If .Y >= .Speed Then .Y = .Y - .Speed * 2 / 3
ElseIf .Direct = "right_up" Then '右上If .X <= 600 - .Speed - 29 Then .X = .X + .Speed * 2 / 3
If .Y >= .Speed Then .Y = .Y - .Speed * 2 / 3
ElseIf .Direct = "left_down" Then '左下If .X >= .Speed Then .X = .X - .Speed * 2 / 3
If .Y <= 600 - .Speed - 64 Then .Y = .Y + .Speed * 2 / 3
ElseIf .Direct = "right_down" Then '右下
If .X <= 600 - .Speed - 29 Then .X = .X + .Speed * 2 / 3
If .Y <= 600 - .Speed - 64 Then .Y = .Y + .Speed * 2 / 3
End If
End If
'避免持续位移，方向清空
.Direct = ""
End With
End Sub
'火箭发射子弹的进程
Private Sub Create_Rocket_Bullet()
'若是Rocket shoot了，就创建一颗子弹
Dim i, j, k As Integer
Dim nBllt As Integer '概念子弹个数
Dim nn As Integer '子弹创建个数计数
If = "shoot" And ShootLock = True And = "active" Then '必需抵达距离时刻,而且火箭若是活着的时候才能创建新的子弹
If = 1 Then '品级1 子弹
nBllt = 1
For i = 0 To BlltNum
With Bllt(i)
If .Owner = "" Then
.Owner = "rocket"
.State = "active"
.Type = "Lv1"
.X = + 14 - 4 '初始子弹在火箭的正上方
.Y = - 12
.Height = 12
.Width = 8
.Speed = 4
.Hurt = 1
nn = nn + 1
If nn = nBllt Then Exit For
End If
End With
Next
ElseIf = 2 Then '品级2 子弹
nBllt = 2
For i = 0 To BlltNum
With Bllt(i)
If .Owner = "" Then
.Owner = "rocket"
.State = "active"
.Type = "Lv2." & Trim(Str(nn + 1))
If .Type = "" Then
.X = + 10 - 4 '第一颗子弹在火箭的上方
.Y = - 12
ElseIf .Type = "" Then
.X = + 20 - 4 '第二颗子弹在火箭的上方
.Y = - 12
End If
.Height = 12
.Width = 4
.Speed = 4
.Hurt = 1 '子弹的损害
nn = nn + 1
If nn = nBllt Then Exit For
End If
End With
Next
ElseIf = 3 Then '品级3 子弹
nBllt = 4
For i = 0 To BlltNum
With Bllt(i)
If .Owner = "" Then
.Owner = "rocket"
.State = "active"
.Type = "Lv3." & Trim(Str(nn + 1))
If .Type = "" Then
.X = - 4
.Y = - 8
ElseIf .Type = "" Then
.X = + 10 - 4 '第一颗子弹在火箭的上方
.Y = - 12
ElseIf .Type = "" Then
.X = + 20 - 4 '第二颗子弹在火箭的上方
.Y = - 12
ElseIf .Type = "" Then
.X = + 30 - 4 '第二颗子弹在火箭的上方
.Y = - 8
End If
.Height = 12
.Width = 8
.Speed = 4
.Hurt = 1 '子弹的损害
nn = nn + 1
If nn = nBllt Then Exit For
End If
End With
Next
End If
ShootLock = False '创建一颗子弹以后就锁上End If
'计算发射子弹距离，到了距离时刻再开发射锁
Static n As Integer
If ShootLock = False Then
n = n + 1
If n = ShootInterval Then
n = 0
ShootLock = True
End If
End If
'恢复发射子弹状态到一般状态
= ""
End Sub
'计算仇敌位移的进程
Private Sub Calc_Enemy_Move()
Dim i As Integer
'计算仇敌的位移
For i = 0 To EnemyNum
With mEnemy(i)
If .State = "active" Then
'.X = .X + .Speed
'If .X > 600 Then .X = 0
.Y = .Y + .Speed
If .Y > 600 Then .Y = 0
. = .X
. = .Y
. = .X + 32
. = .Y + 50
'仇敌是不是与我火箭相撞，确实是判定，火箭矩形4个角点是不是有任意一个落在仇敌的碰撞矩形中
'左上角点
If = "active" Then
If > . And < . And > . And < . Then
.Life = .Life - 1 '撞到后，敌机生命值减1
If .Life = 0 Then '假设敌机生命值为0则产生爆炸PlayBoom .X, .Y, "b1"
.State = ""
EnemyN = EnemyN - 1
End If
= - 1 '假设我火箭生命值为0那么产生爆炸
If = 0 Then
PlayBoom , , "b1"
= ""
End If
'左下角点
ElseIf > . And < . And + > . And + < . Then .Life = .Life - 1 '撞到后，敌机生命值减1
If .Life = 0 Then '假设敌机生命值为0则产生爆炸PlayBoom .X, .Y, "b1"
.State = ""
EnemyN = EnemyN - 1
End If
= - 1 '假设我火箭生命值为0那么产生爆炸
If = 0 Then
PlayBoom , , "b1"
= ""
End If
'右上角点
ElseIf + > . And + < . And > . And < . Then .Life = .Life - 1 '撞到后，敌机生命值减1
If .Life = 0 Then '假设敌机生命值为0则产生爆炸PlayBoom .X, .Y, "b1"
.State = ""
EnemyN = EnemyN - 1
End If
= - 1 '假设我火箭生命值为0那么产生爆炸
If = 0 Then
PlayBoom , , "b1"
= ""
End If
'右下角点
ElseIf + > . And + < . And + > . And + < . Then .Life = .Life - 1 '撞到后，敌机生命值减1
If .Life = 0 Then '假设敌机生命值为0则产生爆炸PlayBoom .X, .Y, "b1"
.State = ""
EnemyN = EnemyN - 1
End If
= - 1 '假设我火箭生命值为0那么产生爆炸
If = 0 Then
PlayBoom , , "b1"
= ""
End If
End If
End If
End If
End With
Next
End Sub
'计算子弹位移的进程
Private Sub Calc_Bullet_Move()
Dim i, j As Integer
For i = 0 To BlltNum
With Bllt(i)
If .Owner = "rocket" Then '若是火箭发射的子弹
If .State = "active" Then '若是子弹处于激活状态
If .Type = "Lv1" Or Left(.Type, 3) = "Lv2" Then '依照子弹类型计算运动速度
.Y = .Y - .Speed '向上
If .Y < Then '若是子弹飞出窗口，初始化那个子弹
.Owner = ""
.State = ""
.Type = ""
End If
ElseIf Left(.Type, 3) = "Lv3" Then
If .Type = "" Then
.Y = .Y - .Speed
.X = .X - .Speed / 2
If .Y < Or .X < Then '左上，若是子弹飞出窗口，初始化那个子弹
.Owner = ""
.State = ""
.Type = ""
End If
ElseIf .Type = "" Then
.Y = .Y - .Speed '向上
If .Y < Then '上，若是子弹飞出窗口，初始化那个子弹
.Owner = ""
.State = ""
.Type = ""
End If
ElseIf .Type = "" Then
.Y = .Y - .Speed '向上
If .Y < Then '上，若是子弹飞出窗口，初始化那个子弹
.Owner = ""
.State = ""
.Type = ""
End If
ElseIf .Type = "" Then
.Y = .Y - .Speed
.X = .X + .Speed / 2
If .Y < Or .X > 600 Then '右上，若是子弹飞出窗口，初始化那个子弹
.Owner = ""
.State = ""
.Type = ""
End If
End If
End If
'计算我发射的子弹是不是与敌机相撞
For j = 0 To EnemyNum
If mEnemy(j).State = "active" Then
If (.X + .Width / 2 > mEnemy(j). And (.X + .Width / 2 < mEnemy(j). And (.Y + .Height / 2 > mEnemy(j). And (.Y + .Height / 2 < mEnemy(j). Then
'若是有碰撞发生那么减去仇敌生命值
mEnemy(j).Life = mEnemy(j).Life - 1
'若是生命值=0那么产生大爆炸
If mEnemy(j).Life = 0 Then
PlayBoom mEnemy(j).X, mEnemy(j).Y, "b1" '挪用爆炸函数
'销毁那个仇敌
mEnemy(j).State = ""
EnemyN = EnemyN - 1
End If
'销毁这颗子弹
.State = ""
.Owner = ""
Exit For
End If
End If
Next
End If
End If
End With
Next
End Sub
'计算动画帧的进程（火箭、仇敌、爆炸）Private Sub Calc_Frame_Play()
Dim i As Integer
'计算火箭动画帧
With mRocket
.FrTime = .FrTime + 1
If .FrTime = .FrameSpeed Then
.Frame = .Frame + 1
If .Frame = 5 Then .Frame = 1
.FrTime = 0
End If
End With
'计算爆炸的动画帧
For i = 0 To BoomNum
With mBoom(i)
If .State = "active" Then
.FrTime = .FrTime + 1 '计数延时，相关于游戏帧产生延时
If .FrTime = .FrameSpeed Then '当延时到一按时刻，就切换一个动画帧
.Frame = .Frame + 1
If .Frame = 8 Then
.Frame = 0
.State = ""
End If
.FrTime = 0
End If
End If
End With
Next
'计算仇敌的动画帧
For i = 0 To EnemyNum
With mEnemy(i)
If .State = "active" Then
.FrTime = .FrTime + 1 '计数延时，相关于游戏帧产生延时
If .FrTime = .FrameSpeed Then '
当延时到一按时刻，就切换一个动画帧
.Frame = .Frame + 1
If .Frame = 3 Then .Frame = 1
.FrTime = 0
End If
End If
End With
Next
End Sub
'创建爆炸的进程
Private Sub PlayBoom(X As Integer, Y As Integer, bType As String) Dim k As Integer
For k = 0 To BoomNum
With mBoom(k)
If .State = "" Then
.State = "active"
.Type = bType
If .Type = "b1" Then .FrameSpeed = 5
.X = X
.Y = Y
Exit For
End If
End With
Next
End Sub。