注册 登录
编程论坛 VB6论坛

我也开新贴吧

风吹过b 发布于 2016-05-28 21:34, 4517 次点击
原问题讨论:
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


------窗体代码-------
程序代码:
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


整个工程:
只有本站会员才能查看附件,请 登录
17 回复
#2
风吹过b2016-05-28 21:36
只有本站会员才能查看附件,请 登录
#3
renxiaoyao362016-05-29 17:34
谢谢风版,我琢磨一下,看能不能改动一下我的代码来达成

风版给了我一个新的思路啊,小的点原来可以设定生存周期,我前面都没注意,导致我的程序的计算量只会越来越大。但是最重要的还是代码核心出了问题,导致速度不可能太快

回到主菜单的代码看样子还是只能用我的,但是大家给出的解决方案无效啊,依然会导致Form2窗体无法卸载掉,重新选择模式会出现问题。
根据这个问题,我是这样处理的:Timer1里输出卸载窗体时,为了防止窗体重加载,加了一个布尔值,让它在卸载窗体时值为真,在窗体加载事件当中加入判别代码,如果布尔值为真就Exit sub
但是又出来一个新的问题:Form1里的Form2.Show居然出错了!出错信息是“窗体已卸载”,我纳闷了,这个代码不就是让你加载窗体么?就是因为窗体已卸载才运行你的啊,结果莫民奇妙的报错

[此贴子已经被作者于2016-5-29 17:53编辑过]

#4
风吹过b2016-05-29 17:52
我仔细看了你的第二个程序的流程。
定时器代码问题。
定时器里,不要再使用 DoEvents 命令。该命令会导致VB暂停当前定时器代码,而去响应新的定时器代码。
造成堆栈里全是这个TIMER1定时器的处理过程,然后游戏结束后,没有了新的事件,然后就继续处理堆栈中的这些代码,
这些代码是放在 FROM2 中的,就会造成 Form2 的隐性加载。


[此贴子已经被作者于2016-5-29 17:58编辑过]

#5
renxiaoyao362016-05-29 17:54
3L的错误已经确认了,是我的代码不规范,布尔值不在公共函数中,导致加载Form2时自动退出,解决方案是将布尔值放到模块中
#6
renxiaoyao362016-05-29 17:55
回复 4楼 风吹过b
我想到一个主意,可否在每个定时器前面加这么一段代码:
If ExitMode = True Then Unload Me: Exit Sub
ExitMode就是我所说的布尔值
#7
renxiaoyao362016-05-29 17:57
回复 6楼 renxiaoyao36
确认方案有缺陷:因为我在Form1里有将ExitMode值调为Fasle的代码,这又是不可或缺的,没有会导致无法重新进入游戏

解决方案:在Form1里用Timer延时运行这段代码,加入加载界面防止用户在延时操作结束之前点击进入游戏导致报错,实践证明程序稳定性提高

[此贴子已经被作者于2016-5-29 18:07编辑过]

#8
风吹过b2016-05-29 17:58
我仔细看了你的第二个程序的流程。
定时器代码问题。
定时器里,不要再使用 DoEvents 命令。该命令会导致VB暂停当前定时器代码,而去响应新的定时器代码。
造成堆栈里全是这个TIMER1定时器的处理过程,然后游戏结束后,没有了新的事件,然后就继续处理堆栈中的这些代码,
这些代码是放在 FROM2 中的,就会造成 Form2 的隐性加载。
#9
renxiaoyao362016-05-29 18:08
回复 8楼 风吹过b
已经删除了Doevents,程序无错了

[此贴子已经被作者于2016-5-29 18:09编辑过]

#10
renxiaoyao362016-05-29 18:37
回复 8楼 风吹过b
我决定一会开始对我的代码完全修改,借鉴风版的代码
另外,我先把我之前修改了几个版本的另一个思路的的代码发上来,有需要的可以下载看看,或许思路在这里不对,但是可能在其他地方有效呢
只有本站会员才能查看附件,请 登录


一会完全修改完毕后,我会把最终稿发上来供大家分享
#11
renxiaoyao362016-05-30 16:03
修改完毕,但是我发现风版的代码似乎兼容性很差啊,我把代码进行了略微修改(核心未改),但是运行直接死机了……
放上源代码:
只有本站会员才能查看附件,请 登录

我做了很多断点,发现错误点详细到这段代码:
Do
    .X = Int(Rnd() * MaxX)
    .Y = Int(Rnd() * MaxY)
Loop While Abs(.X - DDian.X) < i And Abs(.Y - DDian.Y) < i              '如果有大点周围,重新去产生位置
再仔细查错,发现MaxX一直是0……不知道为什么,正在努力查错,大家也帮忙看看吧

[此贴子已经被作者于2016-5-30 16:09编辑过]

#12
renxiaoyao362016-05-30 16:10
刚才查错发现楼上所述的代码还是我的问题……我的这段代码被移到Form_Load环节了,当然没有来得及触发resize事件

解决方案:添加新的timer,interval为10,把一部分代码放到里面去,也就是延时加载,不会出错了
放上代码
只有本站会员才能查看附件,请 登录


还有一个小问题:FPS显示不正常,一直保持在32,没变过

[此贴子已经被作者于2016-5-30 16:27编辑过]

#13
风吹过b2016-05-30 17:23
Form2 代码中:
Private Sub Timer3_Timer()
这行改成:
Public Sub startgame()
同时去掉这个过程中最后一句,
Timer3.Enabled = False
删掉 Timer3 这个控件。

Form1 代码中:
Form2.Show
Call Form2.startgame            '加一句手动调用
Unload Me

------------------
FPS:肯定是游戏中段肯定稳定的,在游戏刚开始那下是比较低,然后稳定到正常水平,结束时,对应框显示时,FPS 会掉到 0 去。
如果不关掉FORM2 的话,就可以看到 FPS 会稳定在一个很高的水平,我自己电脑是可以达到 65 以上。

-------------------
你的 Difficulty 是从1-4,而我的名字数组是从 0-3 ,所以这段代码里需要 减 1 。
另外,计分,可以根据难度来计分。这句        Score = Score + 1   你可以按难度变化。

程序代码:
Private Sub Timer2_Timer()

Select Case GameMode
    Case Gamerun                '运行状态,按1秒2分进行 计分
        Score = Score + 1
        Me.Caption = "反应速度测试-难度:" & LdStr(Difficulty - 1) & " 得分:" & Score & "  FPS: " & FPS
        FPS = 0
    Case GameMin                '游戏最小化时,直接暂停,不需要处理
    Case Gamestop               '游戏结束状态
        Me.Caption = "反应速度测试-结束 FPS: " & FPS
        FPS = 0
    Case GamePause              '游戏暂停状态,需要提示暂停
        Me.Caption = "反应速度测试-难度:" & LdStr(Difficulty - 1) & " 得分:" & Score & " 暂停 FPS: " & FPS
        FPS = 0
End Select
End Sub


[此贴子已经被作者于2016-5-30 17:46编辑过]

#14
风吹过b2016-05-30 17:42
保存记录,不要用你那么复杂的方法,四个数值,竟然保存在四个文件里。
程序代码:

If GameEnd Then
    GameMode = Gamestop
   
    Dim s As String                     '记录文件
    Dim m(3) As Long                    '4个记录,按顺序来。0号是简单,1号是普通,2困难,3是爆炸,与 Difficulty 变量值对应
    Dim fr As Long                      '文件号
   
    s = App.Path                        '取程序路径
    If Right(s, 1) <> "\" Then          '根据程序路径最后是否存在 \ 符号,生成存盘文件名
        s = s & "\Score.sav"
    Else
        s = s & "Score.sav"
    End If
   
    fr = FreeFile                       '取空闲文件号,防止出错
    If Dir(s) <> "" Then                '文件存在
        Open s For Binary As #fr        '打开文件
            Get #fr, , m                '一次性读四个值,这里文件如果损坏,会导致程序报错,需要处理,这里省略,自己想。
        Close fr
    End If
   
    If Score > m(Difficulty - 1) Then   '如果破了指定难度的记录
        m(Difficulty - 1) = Score       '保存记录
        Open s For Binary As #fr        '打开文件
            Put #fr, , m                '写入记录
        Close fr
        MsgBox "你死了!游戏结束!你的分数是最高纪录!分数:" & CStr(Score)
    Else
        MsgBox "你死了!游戏结束!未破纪录。分数:" & CStr(Score)
    End If
    Form1.Show '显示开始界面
    Unload Me '卸载窗体
    Exit Sub
   
End If


Form3 的代码
程序代码:
Private Sub Form_Load()
Dim a As String
On Error Resume Next '无纪录依然可以显示

    Dim s As String
    Dim m(3) As Long
    Dim fr As Long
   
    s = App.Path
    If Right(s, 1) <> "\" Then
        s = s & "\Score.sav"
    Else
        s = s & "Score.sav"
    End If
   
    fr = FreeFile
    If Dir(s) <> "" Then
        Open s For Binary As #fr
            Get #fr, , m
        Close fr
    End If

Label1.Caption = m(0)
Label2.Caption = m(1)
Label3.Caption = m(2)
Label4.Caption = m(3)
End Sub

#15
风吹过b2016-05-30 21:53
难以至信的优化结果:
100000 个点,我的电脑达到了 32 FPS
再增加点,立即报错,感觉是数组占用的内存爆掉了。

优化方向,干掉 Circle 方法,而使用直接操作内存写入数据来生成图形的方法。
现在带来的后果就是 生成的圆,有毛刺,有点像的头样的。

现在就是一个问题,程序稳定性比较差,正在努力中。

----------------
照例,因多线程主体框架不是我的,所以只传编译后的文件。CPU占用率40%
只有本站会员才能查看附件,请 登录


------------去掉结束游戏那部分判断代码抓图测试代码----------------
只有本站会员才能查看附件,请 登录


[此贴子已经被作者于2016-5-30 22:06编辑过]

#16
renxiaoyao362016-06-01 17:33
回复 15楼 风吹过b
这两天没上线,谢谢风版的帮助!事实上这两天我也进行了一些改进,你所说的缺陷我也发现了部分,现在把新的源代码放上来
话说我准备加入成就系统,高难度动作加分……正在努力思考中
另外,你所说的存储方式我参考了一下,也很好,存储在了1个文件当中,但是我存储在4个文件是方便手动删除最高纪录值的,因此这段我没有改动(反正没多少影响嘛)
只有本站会员才能查看附件,请 登录
#17
八云2018-03-19 03:09
回复 15楼 风吹过b
能看到“直接操作内存写入数据来生成图形”的源码就好了
#18
风吹过b2018-05-10 22:21
回复 17楼 八云
1