| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 4142 人关注过本帖
标题:我也开新贴吧
只看楼主 加入收藏
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
结帖率:100%
收藏
 问题点数:0 回复次数:17 
我也开新贴吧
原问题讨论:
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


整个工程:
点游戏.rar (11.9 KB)
2016-05-28 21:34
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
图片附件: 游客没有浏览图片的权限,请 登录注册

授人于鱼,不如授人于渔
早已停用QQ了
2016-05-28 21:36
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
谢谢风版,我琢磨一下,看能不能改动一下我的代码来达成

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

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

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


编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2016-05-29 17:34
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
我仔细看了你的第二个程序的流程。
定时器代码问题。
定时器里,不要再使用 DoEvents 命令。该命令会导致VB暂停当前定时器代码,而去响应新的定时器代码。
造成堆栈里全是这个TIMER1定时器的处理过程,然后游戏结束后,没有了新的事件,然后就继续处理堆栈中的这些代码,
这些代码是放在 FROM2 中的,就会造成 Form2 的隐性加载。


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


授人于鱼,不如授人于渔
早已停用QQ了
2016-05-29 17:52
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
3L的错误已经确认了,是我的代码不规范,布尔值不在公共函数中,导致加载Form2时自动退出,解决方案是将布尔值放到模块中

编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2016-05-29 17:54
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
回复 4楼 风吹过b
我想到一个主意,可否在每个定时器前面加这么一段代码:
If ExitMode = True Then Unload Me: Exit Sub
ExitMode就是我所说的布尔值

编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2016-05-29 17:55
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
回复 6楼 renxiaoyao36
确认方案有缺陷:因为我在Form1里有将ExitMode值调为Fasle的代码,这又是不可或缺的,没有会导致无法重新进入游戏

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

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


编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2016-05-29 17:57
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:贵宾
威 望:364
帖 子:4947
专家分:30084
注 册:2008-10-15
收藏
得分:0 
我仔细看了你的第二个程序的流程。
定时器代码问题。
定时器里,不要再使用 DoEvents 命令。该命令会导致VB暂停当前定时器代码,而去响应新的定时器代码。
造成堆栈里全是这个TIMER1定时器的处理过程,然后游戏结束后,没有了新的事件,然后就继续处理堆栈中的这些代码,
这些代码是放在 FROM2 中的,就会造成 Form2 的隐性加载。

授人于鱼,不如授人于渔
早已停用QQ了
2016-05-29 17:58
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
回复 8楼 风吹过b
已经删除了Doevents,程序无错了

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


编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2016-05-29 18:08
renxiaoyao36
Rank: 9Rank: 9Rank: 9
来 自:七宝中学
等 级:贵宾
威 望:31
帖 子:347
专家分:1077
注 册:2014-9-18
收藏
得分:0 
回复 8楼 风吹过b
我决定一会开始对我的代码完全修改,借鉴风版的代码
另外,我先把我之前修改了几个版本的另一个思路的的代码发上来,有需要的可以下载看看,或许思路在这里不对,但是可能在其他地方有效呢
小游戏.zip (6.24 KB)


一会完全修改完毕后,我会把最终稿发上来供大家分享

编程蛋疼的不是枯燥,而是辛辛苦苦编完几百行的代码,运行,“Runtime Error “xxx””。
2016-05-29 18:37
快速回复:我也开新贴吧
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.042984 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved