![]() |
#2
风吹过b2016-05-28 21:36
|
https://bbs.bccn.net/thread-465198-1-1.html
新贴:
https://bbs.bccn.net/thread-465341-1-1.html
我的电脑:AMD:7800,8G
我的代码:爆炸难度:40FPS,我对这个结果很满意了。
全VB6代码绘图,未使用 API ,主要原因是不太熟悉这块。
如果点由图像贴图的话,只需要改 显示函数就可以了,直接贴图就行了。
------BAS 文件-----

Option Explicit
Public Type Dtype
X As Long
Y As Long
R As Long
C As Long
Speed As Long
HP As Long
End Type
Public Enum GameModeEnum
gamestop = 0
gamerun = 1
GamePause = 2
GameMin = 3
End Enum
Public MaxX As Long, MaxY As Long '最大坐标
Public GameMode As GameModeEnum
Public LdStr(3) As String
Public LdN As Long
Public Score As Long
Public dian() As Dtype
Public JValue As Long
Public DDian As Dtype '大点
Public DM(1) As Long '大点移动,0:X,1:Y
Public Const DDR = 10 '大点半径,以像素 为单位
Public Const DdC = 65280 '大点颜色 ,65280=绿色 ,使用立即窗口用 RGB函数查询
Public TX As Long 'Screen.TwipsPerPixelX
Public FPS As Long
Public TI As Single '游戏最后一个运行回合的时间
;---------------代码开始---------------
Public Sub NewDian(Cs As Dtype)
With Cs
Dim i As Long
i = DDR * 10 * TX '多少半径的空位
Do
.X = Int(Rnd() * MaxX)
.Y = Int(Rnd() * MaxY)
Loop While Abs(.X - DDian.X) < i And Abs(.Y - DDian.Y) < i '如果有大点周围,重新去产生位置
.HP = Int(Rnd() * 100) + 1 '存活周期 1-100 ,定时器是100,100就是10秒
.R = (Int(Rnd() * 4) + 2) * TX '点的半径,1-4像素
.Speed = Int(Rnd() * 3 + 1) * TX '点移动速度
'颜色还可以根据大小+速度来设定。这里仅仅演示使用速度
Select Case .Speed '4种速度对应的颜色,可以使用 RGB函数取不同的颜色
Case TX
.C = 64
Case TX * 2
.C = 128
Case TX * 3
.C = 192
Case TX * 4
.C = 255
End Select
End With
End Sub
Public Type Dtype
X As Long
Y As Long
R As Long
C As Long
Speed As Long
HP As Long
End Type
Public Enum GameModeEnum
gamestop = 0
gamerun = 1
GamePause = 2
GameMin = 3
End Enum
Public MaxX As Long, MaxY As Long '最大坐标
Public GameMode As GameModeEnum
Public LdStr(3) As String
Public LdN As Long
Public Score As Long
Public dian() As Dtype
Public JValue As Long
Public DDian As Dtype '大点
Public DM(1) As Long '大点移动,0:X,1:Y
Public Const DDR = 10 '大点半径,以像素 为单位
Public Const DdC = 65280 '大点颜色 ,65280=绿色 ,使用立即窗口用 RGB函数查询
Public TX As Long 'Screen.TwipsPerPixelX
Public FPS As Long
Public TI As Single '游戏最后一个运行回合的时间
;---------------代码开始---------------
Public Sub NewDian(Cs As Dtype)
With Cs
Dim i As Long
i = DDR * 10 * TX '多少半径的空位
Do
.X = Int(Rnd() * MaxX)
.Y = Int(Rnd() * MaxY)
Loop While Abs(.X - DDian.X) < i And Abs(.Y - DDian.Y) < i '如果有大点周围,重新去产生位置
.HP = Int(Rnd() * 100) + 1 '存活周期 1-100 ,定时器是100,100就是10秒
.R = (Int(Rnd() * 4) + 2) * TX '点的半径,1-4像素
.Speed = Int(Rnd() * 3 + 1) * TX '点移动速度
'颜色还可以根据大小+速度来设定。这里仅仅演示使用速度
Select Case .Speed '4种速度对应的颜色,可以使用 RGB函数取不同的颜色
Case TX
.C = 64
Case TX * 2
.C = 128
Case TX * 3
.C = 192
Case TX * 4
.C = 255
End Select
End With
End Sub
------窗体代码-------

Option Explicit
'凡有结构体的,我习惯把结构做放到模块中,所以这里没有了定义
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
'按键暂停和取消,防止 Picture1 中没触发到
If KeyCode = 32 Or KeyCode = 27 Then
If GameMode = GamePause Then
GameMode = gamerun
ElseIf GameMode = gamerun Then
GameMode = GamePause
End If
End If
End Sub
Private Sub Form_Load()
'游戏状态为停止
GameMode = gamestop
'最大化窗体
Form1.WindowState = vbMaximized
'缓冲区需要持久性位图
Picture3.AutoRedraw = True
'显示区需要快速显示,不需要持久性位图
Picture1.AutoRedraw = False
'初始化随机函数发生器
Randomize
'四个难度名字,显示标题栏用
LdStr(0) = "简单"
LdStr(1) = "普通"
LdStr(2) = "困难"
LdStr(3) = "爆炸难度"
'像素与缇的比例,这里只取 X轴,
TX = Screen.TwipsPerPixelX
End Sub
Private Sub Form_Resize()
If Form1.WindowState = vbMinimized Then '最小化时暂停
If GameMode = gamerun Then
GameMode = GameMin '设置当前模式为最小化,游戏自动暂停
End If
Exit Sub
End If
'最大化游戏区域
Picture1.Move 120, 120, Me.ScaleWidth - 240, Me.ScaleHeight - 120
'保存显示区域最大值
MaxX = Picture1.ScaleWidth
MaxY = Picture1.ScaleHeight
'选单居中
Picture2.Move (MaxX - Picture2.Width) / 2, (MaxY - Picture2.Height) / 2
'缓冲区,需要与显示区一样大
Picture3.Move Picture1.Left, Picture1.Top, Picture1.Width, Picture1.Height
'如果游戏是从最小化状态恢复的,自动继续运行
If GameMode = GameMin Then
GameMode = gamerun
End If
End Sub
Private Sub Label2_Click(Index As Integer)
LdN = Index '保存难度等级
'各个难度对应点的数量
Select Case Index
Case 0
JValue = 100
Case 1
JValue = 300
Case 2
JValue = 600
Case 3
JValue = 1000
End Select
ReDim dian(JValue) '保存点数组
Picture2.Visible = False '隐藏选单
DDian.X = MaxX / 2 '大点先放在窗体中央
DDian.Y = MaxY / 2
DDian.C = DdC
DDian.R = DDR * TX
Dim i As Long
For i = 0 To JValue
Call NewDian(dian(i)) '生成每个点的数据
Next i
Score = 0
TI = Timer '保存第一次回合前的时间
Timer1.Enabled = True '开定时器
Timer2.Enabled = True '其实这二个定时器,都应该默认为开启的
GameMode = gamerun '设置游戏状态为运行
End Sub
Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 32 Or KeyCode = 27 Then '按下空格键时
If GameMode = GamePause Then '暂停状态
GameMode = gamerun '改为运行状态
ElseIf GameMode = gamerun Then '运行状态
GameMode = GamePause '改为暂停状态
End If
End If
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If GameMode = gamestop Then '游戏处于结束状态,按下鼠标时显示开始选单
Picture2.Visible = True
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'保存鼠标位置,点的位置,通过
DM(0) = X
DM(1) = Y
End Sub
Public Sub view(obj As PictureBox)
'只有处于游戏运行状态,才需要绘图,否则直接显示缓冲区图像就可以了。
If GameMode = gamerun Then
obj.Cls
Dim i As Long
Dim j As Long
Dim R As Long
'线条宽 1 像素
obj.DrawWidth = 1
'先画大点
With DDian
For j = 1 To .R Step TX
obj.Circle (.X, .Y), j, DdC
Next j
End With
'再画小点
For i = 1 To JValue
With dian(i)
'使用画同心圆的方式得到实心圆
' obj.Circle (.X, .Y), .R, .C
For j = 1 To .R Step TX
obj.Circle (.X, .Y), j, .C
Next j
End With
Next i
End If
End Sub
Private Sub Picture1_Paint()
'系统需要重绘时,直接复制缓冲区图像。如被对话框覆盖清掉了的时候
Picture1.PaintPicture Picture3.Image, 0, 0
End Sub
Private Sub Timer1_Timer()
FPS = FPS + 1
If Timer - TI > 0 And Timer - TI < 0.1 Then '游戏每回合时间,0.1 代表 0.1秒
'注意,过天时判断会有忽略一次时间间隔BUG,不影响游戏运行
Exit Sub
End If
TI = Timer
If GameMode <> gamerun Then '如果不是处在运行状态,则退出定时器
Exit Sub
End If
Dim i As Long
Dim GameEnd As Boolean
GameEnd = False
'按鼠标位置移动大点,大点的速度是大点的半径
'i = DDR * TX
'With DDian
'If DM(0) - .X > i Then
' .X = .X + i
'ElseIf .X - DM(0) > i Then
' .X = .X - i
'Else
' .X = DM(0)
'End If
'
'If DM(1) - .Y > i Then
' .Y = .Y + i
'ElseIf .Y - DM(1) > i Then
' .Y = .Y - i
'Else
' .Y = DM(1)
'End If
'End With
'大点直接在鼠标下面
DDian.X = DM(0)
DDian.Y = DM(1)
For i = 1 To JValue
With dian(i)
If Abs(.X - DDian.X) < DDian.R And Abs(.Y - DDian.Y) < DDian.R Then
'结束
GameEnd = True
'因为需要绘制最终的图像,所以不能在这里直接切换为结束游戏,需要等这个回合结束
End If
'按大点方位移动小点,移动X,Y方向移动距离最大情况是相同的
If .X - DDian.X > .Speed Then '距离超过 速度
.X = .X - .Speed '移动速度
ElseIf DDian.X - .X > .Speed Then '距离反方向超过速度
.X = .X + .Speed '移动速度
Else
.X = DDian.X '否则移动到目标位置
End If
If .Y - DDian.Y > .Speed Then
.Y = .Y - .Speed
ElseIf DDian.Y - .Y > .Speed Then
.Y = .Y + .Speed
Else
.Y = DDian.Y
End If
.HP = .HP - 1 '生命-1
If .HP = 0 Then '如果生命为0
Call NewDian(dian(i)) '重新产生一个新点
End If
End With
Next i
Call view(Picture3) '绘图到缓冲区
Picture1.PaintPicture Picture3.Image, 0, 0 '把缓冲区的图像显示出来
If GameEnd Then
GameMode = gamestop
MsgBox "游戏结束" & vbCrLf & "得分:" & Score, vbInformation, "游戏结束"
'调用写记录事件,这里省略,需要补
End If
End Sub
Private Sub Timer2_Timer()
Select Case GameMode
Case gamerun '运行状态,按1秒1分进行 计分
Score = Score + LdN + 1
Me.Caption = "躲避点-难度:" & LdStr(LdN) & " 得分:" & Score & " FPS: " & FPS
FPS = 0
Case GameMin '游戏最小化时,直接暂停,不需要处理
Case gamestop '游戏结束状态
Me.Caption = "躲避点-结束 FPS: " & FPS
FPS = 0
Case GamePause '游戏暂停状态,需要提示暂停
Me.Caption = "躲避点-难度:" & LdStr(LdN) & " 得分:" & Score & " 暂停 FPS: " & FPS
FPS = 0
End Select
End Sub
'凡有结构体的,我习惯把结构做放到模块中,所以这里没有了定义
Private Sub Form_KeyUp(KeyCode As Integer, Shift As Integer)
'按键暂停和取消,防止 Picture1 中没触发到
If KeyCode = 32 Or KeyCode = 27 Then
If GameMode = GamePause Then
GameMode = gamerun
ElseIf GameMode = gamerun Then
GameMode = GamePause
End If
End If
End Sub
Private Sub Form_Load()
'游戏状态为停止
GameMode = gamestop
'最大化窗体
Form1.WindowState = vbMaximized
'缓冲区需要持久性位图
Picture3.AutoRedraw = True
'显示区需要快速显示,不需要持久性位图
Picture1.AutoRedraw = False
'初始化随机函数发生器
Randomize
'四个难度名字,显示标题栏用
LdStr(0) = "简单"
LdStr(1) = "普通"
LdStr(2) = "困难"
LdStr(3) = "爆炸难度"
'像素与缇的比例,这里只取 X轴,
TX = Screen.TwipsPerPixelX
End Sub
Private Sub Form_Resize()
If Form1.WindowState = vbMinimized Then '最小化时暂停
If GameMode = gamerun Then
GameMode = GameMin '设置当前模式为最小化,游戏自动暂停
End If
Exit Sub
End If
'最大化游戏区域
Picture1.Move 120, 120, Me.ScaleWidth - 240, Me.ScaleHeight - 120
'保存显示区域最大值
MaxX = Picture1.ScaleWidth
MaxY = Picture1.ScaleHeight
'选单居中
Picture2.Move (MaxX - Picture2.Width) / 2, (MaxY - Picture2.Height) / 2
'缓冲区,需要与显示区一样大
Picture3.Move Picture1.Left, Picture1.Top, Picture1.Width, Picture1.Height
'如果游戏是从最小化状态恢复的,自动继续运行
If GameMode = GameMin Then
GameMode = gamerun
End If
End Sub
Private Sub Label2_Click(Index As Integer)
LdN = Index '保存难度等级
'各个难度对应点的数量
Select Case Index
Case 0
JValue = 100
Case 1
JValue = 300
Case 2
JValue = 600
Case 3
JValue = 1000
End Select
ReDim dian(JValue) '保存点数组
Picture2.Visible = False '隐藏选单
DDian.X = MaxX / 2 '大点先放在窗体中央
DDian.Y = MaxY / 2
DDian.C = DdC
DDian.R = DDR * TX
Dim i As Long
For i = 0 To JValue
Call NewDian(dian(i)) '生成每个点的数据
Next i
Score = 0
TI = Timer '保存第一次回合前的时间
Timer1.Enabled = True '开定时器
Timer2.Enabled = True '其实这二个定时器,都应该默认为开启的
GameMode = gamerun '设置游戏状态为运行
End Sub
Private Sub Picture1_KeyUp(KeyCode As Integer, Shift As Integer)
If KeyCode = 32 Or KeyCode = 27 Then '按下空格键时
If GameMode = GamePause Then '暂停状态
GameMode = gamerun '改为运行状态
ElseIf GameMode = gamerun Then '运行状态
GameMode = GamePause '改为暂停状态
End If
End If
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If GameMode = gamestop Then '游戏处于结束状态,按下鼠标时显示开始选单
Picture2.Visible = True
End If
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
'保存鼠标位置,点的位置,通过
DM(0) = X
DM(1) = Y
End Sub
Public Sub view(obj As PictureBox)
'只有处于游戏运行状态,才需要绘图,否则直接显示缓冲区图像就可以了。
If GameMode = gamerun Then
obj.Cls
Dim i As Long
Dim j As Long
Dim R As Long
'线条宽 1 像素
obj.DrawWidth = 1
'先画大点
With DDian
For j = 1 To .R Step TX
obj.Circle (.X, .Y), j, DdC
Next j
End With
'再画小点
For i = 1 To JValue
With dian(i)
'使用画同心圆的方式得到实心圆
' obj.Circle (.X, .Y), .R, .C
For j = 1 To .R Step TX
obj.Circle (.X, .Y), j, .C
Next j
End With
Next i
End If
End Sub
Private Sub Picture1_Paint()
'系统需要重绘时,直接复制缓冲区图像。如被对话框覆盖清掉了的时候
Picture1.PaintPicture Picture3.Image, 0, 0
End Sub
Private Sub Timer1_Timer()
FPS = FPS + 1
If Timer - TI > 0 And Timer - TI < 0.1 Then '游戏每回合时间,0.1 代表 0.1秒
'注意,过天时判断会有忽略一次时间间隔BUG,不影响游戏运行
Exit Sub
End If
TI = Timer
If GameMode <> gamerun Then '如果不是处在运行状态,则退出定时器
Exit Sub
End If
Dim i As Long
Dim GameEnd As Boolean
GameEnd = False
'按鼠标位置移动大点,大点的速度是大点的半径
'i = DDR * TX
'With DDian
'If DM(0) - .X > i Then
' .X = .X + i
'ElseIf .X - DM(0) > i Then
' .X = .X - i
'Else
' .X = DM(0)
'End If
'
'If DM(1) - .Y > i Then
' .Y = .Y + i
'ElseIf .Y - DM(1) > i Then
' .Y = .Y - i
'Else
' .Y = DM(1)
'End If
'End With
'大点直接在鼠标下面
DDian.X = DM(0)
DDian.Y = DM(1)
For i = 1 To JValue
With dian(i)
If Abs(.X - DDian.X) < DDian.R And Abs(.Y - DDian.Y) < DDian.R Then
'结束
GameEnd = True
'因为需要绘制最终的图像,所以不能在这里直接切换为结束游戏,需要等这个回合结束
End If
'按大点方位移动小点,移动X,Y方向移动距离最大情况是相同的
If .X - DDian.X > .Speed Then '距离超过 速度
.X = .X - .Speed '移动速度
ElseIf DDian.X - .X > .Speed Then '距离反方向超过速度
.X = .X + .Speed '移动速度
Else
.X = DDian.X '否则移动到目标位置
End If
If .Y - DDian.Y > .Speed Then
.Y = .Y - .Speed
ElseIf DDian.Y - .Y > .Speed Then
.Y = .Y + .Speed
Else
.Y = DDian.Y
End If
.HP = .HP - 1 '生命-1
If .HP = 0 Then '如果生命为0
Call NewDian(dian(i)) '重新产生一个新点
End If
End With
Next i
Call view(Picture3) '绘图到缓冲区
Picture1.PaintPicture Picture3.Image, 0, 0 '把缓冲区的图像显示出来
If GameEnd Then
GameMode = gamestop
MsgBox "游戏结束" & vbCrLf & "得分:" & Score, vbInformation, "游戏结束"
'调用写记录事件,这里省略,需要补
End If
End Sub
Private Sub Timer2_Timer()
Select Case GameMode
Case gamerun '运行状态,按1秒1分进行 计分
Score = Score + LdN + 1
Me.Caption = "躲避点-难度:" & LdStr(LdN) & " 得分:" & Score & " FPS: " & FPS
FPS = 0
Case GameMin '游戏最小化时,直接暂停,不需要处理
Case gamestop '游戏结束状态
Me.Caption = "躲避点-结束 FPS: " & FPS
FPS = 0
Case GamePause '游戏暂停状态,需要提示暂停
Me.Caption = "躲避点-难度:" & LdStr(LdN) & " 得分:" & Score & " 暂停 FPS: " & FPS
FPS = 0
End Select
End Sub
整个工程:
只有本站会员才能查看附件,请 登录