前面的帖子地址 https://bbs.bccn.net/viewthread.php?tid=465198&pid=2570150&page=1#pid2570150

经过我的思考，我修改了点的移动方式，将所有的点的移动分配到了多个Timer上面，每个Timer仅仅计算50个点的移动，大幅提升了游戏速度，但是有一些小BUG，我找不到问题出在哪里，故在这里放上源代码，请各位帮忙看看
改动点：加入加载timer1的代码（由本来负责加入新的点的Timer2负责，刷新频率5S，所有负责点的移动的timer1加入控件数组，通过算法让每个timer1负责50个点的移动
问题1：游戏结束后会莫名其妙的重新加载Form_Load，导致页面无限刷新（我调试就因为这害的我只能强制关掉编译环境，建议在调试的时候加入断点，否则哭都没地哭去）
问题2：在第三次加载Timer1之前会有一部分点不会移动（未找到原因）

这个解决方式我想了很久，原来只需要基本语句就可以完成了……大家想太多了，都牵扯到结构体和VB的动画效果了，实际上没那么深奥滴……
希望大家能再祝我一臂之力，谢谢啦
（注：这个帖子是补充的帖子，所以不发专家分了，见谅）
下面放上源代码

注意：这个版本是最早期的版本，大家不用下载了，可以看下面的帖子更新

[此贴子已经被作者于2016-5-28 20:35编辑过]

个人思考了一下问题1，觉得原因可能是Timer处于控件数组之中，一个Timer结束了它的工作，运行Unload语句的时候，其他Timer仍然需要运行，致使窗体重新加载的问题
我的解决方案：单个Timer1的结束代码前面加入循环语句，在运行UNLOAD之前，将所有Timer的Enabled属性全部调为False
还没尝试，不知道有没有效

之前所述的方式无效，同时发现另外BUG：
1.加载新的点之后，这些点在下一次重加载Timer1之前都无法运动，同时新的点的运动速度不可控，不知道为什么……
2.有时在加载新的点时，会莫名其妙的触发“死亡机制”，莫名其妙的判定死亡，游戏结束

另外，测试发现了异常情况：问题1的触发是随机的，5次测试，有1次成功完成退出操作，没有触发Load事件

[此贴子已经被作者于2016-5-28 20:14编辑过]

已经查出了楼上的2号错误的原因：Timer的分配机制不当，同时On error resume next 的存在使得读取不存在的点的数据的时候不会报错，致使判定失误，触发死亡

接下来给出更新了两次的新源代码：

需要注意的是，现在还是有特别致命的错误：窗体无法退出，一旦退出会触发窗体加载事件，原因不明，请大家优先帮我解决这个问题，谢谢

[此贴子已经被作者于2016-5-28 20:37编辑过]

1、还是那句话，大量的动画，不要用控件去弄。而应该绘图。
2、你的代码加注释。否则真没心情仔细读代码。
3、一般情况下，不要多个语句写到一行，少用 冒号分隔语句。
4、尽量少用 GOTO 命令，而应该使用 DO LOOP 循环。你看我的代码里创建新点坐标的循环。
5、程序代码里，如果度量单位使用的缇，如果转化为像素时，或使用像素，转化为缇时，注意使用 Screen.TwipsPerPixelX 和 Screen.TwipsPerPixelY 这二个比例来转化。
   长度数据指定，一般建议按像素指定，不建议用缇，每像素＝？缇，在Windows 下面可变的。要注意这个兼容性。
6、
屏幕大小并不一定等于程序可用绘图大小，有可能屏幕左右上下还有固定的工具栏、程序本身的标题栏
MouseX = Screen.Width / 2
MouseY = Screen.Height

其实，每个容器，都提供了二个属性，来告诉我们可用大小
'保存显示区域最大值
MaxX = Picture1.ScaleWidth
MaxY = Picture1.ScaleHeight

7、你的代码还是有点问题，你想到的用不同定时器来实现移动不同的批的点。
其实这个方法你还是想错了。
关键问题在于VB6编译出来的程序默认是单线程。
如果同时存在 20个定时器，那么当这20个定时器同时到时间时，我们的程序是按收到这20个定时器的事件依次执行代码。
当前面一个定时器代码没有执行完时，不会执行下面一个定时器的代码。
也就是说20个定时器，如果足够快的情况，这20个定时器相当于一个定时器。

你打算并行的话，就必须使用多线程。每个线程负责移动指定的点。
线程是分配在不同CPU内核上运行的，当系统负荷不重时，线程被同时执行的可能性是非常大的。
但系统负荷比较重时，就需要考虑到线程执行情况不同步的情况。
线程里，一般只有一个函数。这个函数执行完当前任务后，像你这个游戏里，线程不能销毁，
要么暂停，由外部开启
要么暂停X毫秒，检测外部信号量决定是否继续暂停，还是继续执行任务。
外部信号量发现所有的任务都执行完后，才继续下一次的执行。


-------------------
想到什么就说的什么，水平有限，如有错误，请忽略。

经测试，你的所谓速度搞多了是牺牲其他点不动的情况下实现的。理论上，作为单线程的vb并不会因为你讲任务分配到多个timer就会提高并行能力，你可以通过在一个timer梨执行死循环来判断另一个timer是否正常计时得到答案。你那个出现反复不退出的情况是由于控件数组任务现场还原造成的，控件数组执行任务时会保存原状态，你unload后，会返回到上一个控件数组的执行状态，这时你取消的定时器又处于enable=true的状态了，由于定时器有效，所以又会执行控件显示操作，重新执行form_load。将form2里的代码修改如下(红色部分为修改部分）：

Dim Movement As Integer, JValue As Integer, TimerIndex As Integer
Dim Speed As Integer, MouseX As Integer, MouseY As Integer
Private Declare Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Dim Time As Integer
Private Sub Form_Load()
Me.Height = Screen.Height: Me.Width = Screen.Width
If Difficulty = 1 Then
Speed = 100: Me.Caption = Me.Caption & "简单"
ElseIf Difficulty = 2 Then
Speed = 300: Me.Caption = Me.Caption & "普通"
ElseIf Difficulty = 3 Then
Speed = 600: Me.Caption = Me.Caption & "困难"
ElseIf Difficulty = 4 Then
Speed = 1000: Me.Caption = Me.Caption & "爆炸难度"
End If
Timer1(0).Interval = 10
MouseX = Screen.Width / 2
MouseY = Screen.Height
Dim i As Integer
For i = 1 To Speed Step 1 '循环加载部件
sss:
On Error Resume Next
Load Shape(i): Shape(i).Left = 40000 * Rnd: Shape(i).Top = 20000 * Rnd: Shape(i).FillColor = Shape(0).FillColor: Shape(i).BorderColor = Shape(0).BorderColor: Shape(i).Height = 135: Shape(i).Width = 135: Shape(i).Visible = True: Shape(i).Shape = 3
If Shape(i).Left < MouseX + 1000 And Shape(i).Left > MouseX - 1000 Then GoTo sss
If Shape(i).Top < MouseY + 1000 And Shape(i).Top > MouseY - 1000 Then GoTo sss '防止生成在鼠标附近
Next i
Me.WindowState = 2
SetCursorPos ScaleX((Screen.Width / 2), 1, 3), ScaleY((Screen.Height / 2), 1, 3) '移动鼠标位置  因为SetCursorPos使用的坐标是以像素为单位，而Screen的Width和Height属性是以缇为单位，所以必须将Screen的Width和Height属性值转换为像素才行。代码中ScaleX和ScaleY就是完成缇到像素的单位转换的。

JValue = Speed
Time = -1
TimerIndex = 1
For e = 1 To Speed / 50 - 1 '循环加载Timer
Load Timer1(e): Timer1(e).Enabled = True: Timer1(e).Interval = 10 '加载Timer
TimerIndex = TimerIndex + 1
Next e
End Sub
Private Sub Form_MouseMove(Button As Integer, Shift As Integer, x As Single, y As Single)
MouseX = x
MouseY = y
Shape1.Left = x - 100
Shape1.Top = y - 100
End Sub


Private Sub Timer1_Timer(Index As Integer)
Dim JValue2 As Integer, b As Timer
If (Index + 1) * 50 > JValue Then
  JValue2 = JValue
    Else
  JValue2 = (Index + 1) * 50
End If
For i = Index * 50 To JValue2
If Abs(Shape1.Top - Shape(i).Top) < 100 And Abs(Shape1.Left - Shape(i).Left) < 100 Then
Debug.Print Shape(i).Top
Debug.Print Shape(i).Left
'这里删除部分
Open App.Path & "\高分榜\" & Replace(Replace(Replace(Replace(Speed, "1000", "VeryDifficult.sav"), "300", "Middle.sav"), "600", "Difficult.sav"), "100", "Easy.sav") For Input As #1
Input #1, a
Close #1
If a > Time Then
MsgBox "你死了！游戏结束！未破纪录。分数：" & CStr(Time)  '这里删除部分
Else
Open App.Path & "\高分榜\" & Replace(Replace(Replace(Replace(Speed, "1000", "VeryDifficult.sav"), "300", "Middle.sav"), "600", "Difficult.sav"), "100", "Easy.sav") For Output As #1 '输出分数，REPLACE函数负责模式检测
Print #1, Time
Close #1
MsgBox "你死了！游戏结束！你的分数是最高纪录！分数：" & CStr(Time) '这里删除部分
End If
Unload Me
For Each b In Timer1
  b.Enabled = False
Next
Timer2.Enabled = False
Timer3.Enabled = False
Form1.Show
Exit Sub
End If
Movement = Abs(Shape1.Left - Shape(i).Left) / Abs(Shape1.Top - Shape(i).Top) '计算移动比例
If Shape1.Left > Shape(i).Left Then
  Shape(i).Left = Shape(i).Left + 15
ElseIf Shape1.Left < Shape(i).Left Then
  Shape(i).Left = Shape(i).Left - 15
End If
On Error Resume Next
If Movement = 0 Then Movement = 1
If Shape1.Top > Shape(i).Top Then
  Shape(i).Top = Shape(i).Top + 15 / Movement
ElseIf Shape1.Top < Shape(i).Top Then
  Shape(i).Top = Shape(i).Top - 15 / Movement
End If

DoEvents
Next i
End Sub

Private Sub Timer2_Timer()
For i = JValue To JValue + 30
sss:
On Error Resume Next
Load Shape(i): Shape(i).Left = 40000 * Rnd: Shape(i).Top = 20000 * Rnd: Shape(i).FillColor = Shape(0).FillColor: Shape(i).BorderColor = Shape(0).BorderColor: Shape(i).Height = 135: Shape(i).Width = 135: Shape(i).Visible = True: Shape(i).Shape = 3
If Shape(i).Left < MouseX + 1000 And Shape(i).Left > MouseX - 1000 Then GoTo sss
If Shape(i).Top < MouseY + 1000 And Shape(i).Top > MouseY - 1000 Then GoTo sss '防止生成在鼠标附近
Next i
JValue = JValue + 30
If JValue > TimerIndex * 50 Then Load Timer1(TimerIndex): Timer1(TimerIndex).Enabled = True: Timer1(TimerIndex).Interval = 10 '加载Timer
TimerIndex = TimerIndex + 1
End Sub

Private Sub Timer3_Timer()
Time = Time + 1
Form2.Caption = Replace(Replace(Replace(Replace(("反应速度测试 难度：" & Speed), "1000", "爆炸难度"), "300", "普通"), "600", "困难"), "100", "简单") & " 分数" & CStr(Time)
End Sub

谢谢楼上的帮助，看来还是不能绕过多线程啊，只能去学习多线程了……

基于我自己的代码：https://bbs.bccn.net/thread-465343-1-1.html

转化为多线程。
结果：支持 100000 个点时，我的电脑的 FPS 只有 1 。
仔细：检查，CPU占用率一个核也是满载，经检查，卡在 绘图过程中。
好吧。改进绘图过程去。

基于你的代码，估计会出问题，子线程中，应该不能操作窗体上的控件，我用子线程绘图，立马报错。
估计还是线程数据安全的问题，如果使用临界，那等于白用了多线程。

附件是已编译好的代码，没有放源代码，需要时再说吧，主要是主体代码不是我的。

改进绘图，使用事先绘制好的点进行贴图，结果没有任何改观，估计还是点太多造成的。
不知使用BIT贴会怎么样，也不知道使用 DX 进行贴会怎么样。
估计往 DX 方向是王道。

照样，附已编译好的工程。这个爆炸是10000个点的。

VB6也可以实现多线程？好像很难吧，能否分享看看，527474946@，谢谢