躲避球游戏 - 编程论坛

#2

风吹过b2017-10-10 10:48

虽然补充了大量的注释在内，还是不建议新新手看。

画圆使用的勾股定理来画的，而没使用三角函数，
估计三角函数也需要绘制二遍，没去测试。

看看有谁能补充一个画直线的函数，一个画矩形的函数。这个虽然简单，但自己懒了。

最关键的，谁能补充一个填充有边界区域的函数给我。这个我直不会。

[此贴子已经被作者于2017-10-10 10:51编辑过]

#3

fangbnu2017-10-30 11:20

#4

zhucezy2021-03-03 11:29

谢谢版主。我昨天搜索加快PSet算法时搜到这个帖子，提供了不错的思路。

#5

zhucezy2021-03-03 11:40

好的，居然还可以回复。
试验了一下代码，看到里面有不少我没见过的东西，还没仔细研究。

有一点觉得不够满意，就是玩家控制的大点运动时与鼠标有延迟，应该是画图刷新率为0.1s造成的。
按照自己的思路，把大点的绘制放到mousemove事件里，基本上可以消除延迟。

为了方便验证，大点我用circle方法做的，在非最大化窗口里速度没问题，最大化会有卡顿。
由于原代码是内存绘图的，大点、小点一起刷新，那就没办法解决0.1s的问题。
或许，1，大点运动有延迟，更有游戏性
2，不要延迟，或许用二个图层好一些？

#6

yuma2022-08-25 18:21

这个应该是Bug,球不动的话，其它球会“十”字形集结。

关于画直线和画圆参考我这个：

程序代码：

Private Sub Form_Load()
Me.Show

Rem 在窗体坐标1000，1000的地方画一个半径800的圆
'画普通的圆
Circle (1000, 1000), 800
'画黄色的圆
Circle (1500, 1500), 800, RGB(255, 255, 0)

Rem 画实心圆
Me.DrawWidth = 100
'画默认颜色的圆
Me.PSet (2000, 2000)
'画背景色的圆
Me.PSet (2500, 2500), Me.BackColor
'画指定颜色的圆
PSet (3000, 3000), RGB(255, 255, 0)
End Sub

程序代码：

Private Sub Form_Load()
Form1.AutoRedraw = True
'Form1上画实心矩形
Form1.Line (500, 500)-(2000, 2000), vbRed, BF
Form1.Cls
'Form1上画空心矩形
Form1.Line (500, 500)-(2000, 2000), vbRed, B
'Form1.Cls
'Form1上画一条线段，左上—右下
Form1.Line (500, 500)-(2000, 2000), vbRed
'Form1.Cls
'Form1上画一条线段，右上—左下
Form1.Line (2000, 500)-(500, 2000), vbRed
End Sub

只有本站会员才能查看附件，请登录

#7

风吹过b2022-08-25 20:54

不是直接在屏幕上画直线，而在内存数组里画直线。
这个程序有一个多线程的版本，然后多线程程序里，绘图命令均非线程安全，只能主线程进行绘图操作，子线程一但绘图，程序立即报错。
所以就拐了个弯，先把需要绘图的数据装到 byte 数组里，然后多线程对 byte 数组操作，把需要绘图的数据，填进去，所以无法使用任何绘图命令。、
为什么这样操作，因为 byte 数据和 integer 及 LONG 数据，是原子操作，属于线程安全，可以在子线程中对同一个数组进行填充写入。

主线程绘图，FPS，我的电脑不会超过 20 。四线程绘图，100000 个点达到 32 。AMD K10 7850 / 8G / WIN7 。

-------------------------
绘图数据装到 byte数组里后，一个封包头 + BMP文件格式，绘图就是然后对这个BMP里的数据填充来绘图，这个填充只能自己写代码来填充，绘图命令操作不了的。
我程序里已有画点函数，画圆环函数，画实心圆函数，但因直线、矩形函数没有用到，所以没写。

#8

风吹过b2022-08-25 20:59

这个应该是Bug,球不动的话，其它球会“十”字形集结。

这个不是BUG，程序设定是，小球向大球集中，小球的移动只有三种移动方式，水平、垂直、45度斜线。
小球是根据自己的位置和大球的位置进行移动的，所以大球不动时，小球都是向大球的水平和垂直两根线方向集中。
这三种移动方式是最简单计算的。不需要使用到浮点运算。

#9

yuma2022-08-25 21:08

好的，B哥一定是职业程序员出身。我只是业余程序员，内存操作现在还搞不了。

#10

William19492022-08-27 10:32

PropertyBag 用在这个地方，还是头一次遇见

奇怪，为啥不能显示在第一页

[此贴子已经被作者于2022-8-27 10:40编辑过]

#11

风吹过b2022-08-29 13:23

太久的贴子再回复也默认不会在第一页的。
PropertyBag 本来就是一个大包裹，啥东西都可以装，前面有人用来装数据库的对象来。本地调用远程MDB。

-----------------
因为多线程不是我的框架，所以多线程的代码不发，好像弄丢了。
把一个循环里跑的内容，分拆到 4个线程里去跑，然后子线程跑完后，主线程再把图像显示出来。
VB6 的所有控件操作都是线程非安全，子线程不能操作涉及控件、GDI 等操作，只能操作内存。

#12

William19492022-08-31 09:03

我知道 PropertyBag 啥东西都可以装。

我说的重点是：PropertyBag 用在这个地方，很少见。更多的时候用在 ActiveX 控件上，用于保存属性值，使得控件在“设计状态”和“运行状态”能够得到保存，使其不丢失。

看你的代码，是用 PropertyBag 获得位图的 Bits, 其实一些 gdi 函数也可以达到同样的目的(如：GetDIBits、GetObject)

自我感觉：用 PropertyBag 反而不会提高效率，因为：
先开始要：PBag.WriteProperty "Picture", Picture1.Image
然后在：Pbb = PBag.Contents
'--------------------------
Pbb 数组处理过程
'--------------------------
Pbb 数组经过处理后，然后在：
Pb1.Contents = Pbb
Set Picture1.Picture = Pb1.ReadProperty("Picture")

感觉，一进一出，都要用 PropertyBag 过一遍手，多一道工序，还不如直接用 gdi 函数在内存DC里画图,然后 BitBlt 到目标DC上。

#13

风吹过b2022-09-01 10:36

写这些代码，我主要的目的是多线程使用
使用VB6自带绘图函数，会造成子线程崩溃，然后我猜想  GDI 函数也应该会导致这个问题。

这个程序的主要运算量，就是在屏幕上画这个圆的图形，单线程绘制 VB 效率上不去，FPS 达不到要求。
----------------------------
在初始化使用一次。得到原始数据，并初始化数组大小。这里使用 image 属于是为了不出现背景图形，如果有
PBag.WriteProperty "Picture", Picture1.Image

在每次重绘时使用一次。这里使用 picture 属性，是为了得到一个持久的图形
Pb1.Contents = Pbb
Set Picture1.Picture = Pb1.ReadProperty("Picture")

--------------
Picture控件绘图区域，我理解分成二层，底层是 Picture ，上层是 Image ，VB 的绘图命令只操作到 Image 层，自动重绘开关也只影响这层。
Picture 层只有载入图像命令才能写入数据，并且是自动重绘的。

[此贴子已经被作者于2022-9-1 10:52编辑过]

#14

William19492022-09-03 11:08

Set Picture1.Picture = Pb1.ReadProperty("Picture")
是一种很慢的操作，而且还是在 Timer()事件中频繁被调用，会拖累整个程序。我还是建议放弃使用 PropertyBag。

可以用以下代码测试一下：
测试前的准备：
1、在窗体中装2个picture,并使2个picture大小相同，最好尺寸调大点，测试效果会更明显。
2、picture 1 放一张图片，（随便什么图片都行，最好是大图，不要16*16的小图标），picture 2保持原样(空白)。

程序代码：

Option Explicit
Private Declare Function BitBlt Lib "gdi32" (ByVal hDestDC As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long, ByVal xSrc As Long, ByVal ySrc As Long, ByVal dwRop As Long) As Long

Private Sub Command1_Click()
    Dim P   As Long
    Dim TTT As Single

TTT = Timer
    For P = 0 To 100
        Set Picture2.Picture = Picture1.Picture
    Next
Debug.Print "Set xxx = yyy ,用时 = " & (Timer - TTT) * 1000
End Sub

Private Sub Command2_Click()
    Dim P   As Long
    Dim TTT As Single
    Dim PBag As New PropertyBag

    PBag.WriteProperty "Picture", Picture1.Picture
TTT = Timer
    For P = 0 To 100
        Set Picture2.Picture = PBag.ReadProperty("Picture")
    Next
Debug.Print "PropertyBag , 用时 = " & (Timer - TTT) * 1000
End Sub

Private Sub Command3_Click()
    Dim P   As Long
    Dim TTT As Single

TTT = Timer
    For P = 0 To 100
        Call BitBlt(Picture2.hDc, 0, 0, Picture2.ScaleWidth, Picture2.ScaleHeight, Picture1.hDc, 0, 0, vbSrcCopy)
    Next
Debug.Print "BitBlt , 用时 = " & (Timer - TTT) * 1000
End Sub

看看哪种用时最长？

#15

William19492022-09-03 11:28

只有本站会员才能查看附件，请登录

这是我修改的程序。（单线程， gdi 画图）
但我没有足够的信心。不确定在你电脑上的运行效果如何？所以，我只把与 PropertyBag 相关的代码进行修改。

[此贴子已经被作者于2022-9-3 11:30编辑过]