我也开新贴吧
原问题讨论: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)