| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 编程论坛
共有 758 人关注过本帖
标题:为什么用VB6.0做出云图会有很多黑点,用的是pset方法
只看楼主 加入收藏
造物主的落寞
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2017-4-18
结帖率:100%
  已结贴   问题点数:10  回复次数:6   
为什么用VB6.0做出云图会有很多黑点,用的是pset方法

附件: 您没有浏览附件的权限,请 登录注册
2018-03-20 17:35
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:230
帖 子:4333
专家分:26462
注 册:2008-10-15
  得分:10 
不知道你的数据是怎么样的,只能猜测了。

PSET 画点,原始单位情况下,单位是 缇。这种情况下,对某一坐标画点,
会被扩展为对包含该坐标的像素画点。
坐标值也就存在 四舍五入 的误差,有可能导致某个像素点没有数据。

修改方向:
1、绘图时,自己转换坐标为像素来画图。可选
2、绘图时,大面积绘制时,不要使用PSET 来画,可以选择使用 link 画。
  如,1,2 1,3 1,4 1,5 这4个点,
用PSET需要绘图4次。经统计发现这4个点的 X坐标均相同,并且Y坐标是连续的。
那个使用 link 绘图,直接从 1,2 到 1,5 绘制一根直线。
可以加快绘图速度。

3、画点时,改用画圆命令,半径为1 。以覆盖相领的像素。
4、用PSET画点时,以X轴循环计算了第一遍后,再以Y轴循环计算第二遍。

我前面发了一个 躲避球游戏 ,使用的是内存直接写数据方式绘图,
当使用 勾股定理 画实心圆时,也会出现黑点。

X轴偏移原点M单位,然后到圆边缘的Y坐标是:SQR(R*R-M*M)
然后从这个坐标向 0 进行循环描点。
按原理来说,毛刺可能存在,但中心不应该存在黑点
但绘制出来的圆就是存在黑点。无法解释,只能理解为 四舍五入的误差导致。
for x=0 to r          'X从0到半径循环,每步一单位
  yr= SQR(R*R-x*x)    'Y最大坐标,R为长边,X偏移为一直角边,高为另一直角边,高即Y最大值
  for y=0 to yr       'Y从0到半径循环,每步一单位
     pset x,y         '四个象限画点
     pset x,-y
     pset -x,y
     pset -x,-y
  next y
next x

你说奇怪不奇怪。
收到的鲜花
  • xiangyue0510 于 2018-03-21 13:03 送鲜花  10朵   附言:好文章

授人于鱼,不如授人于渔
早已停用QQ了
2018-03-21 11:24
造物主的落寞
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2017-4-18
  得分:0 
回复 2楼 风吹过b
数据形式是这样的。
a(1,1)   a(1,2)  a(1,3)  . . .  a(1,10)
a(2,1)                              .
  .                                 .  
  .                                 .
a(n,1)   .   .              .   a(n,10)

已知水平方向上10个点数据,我人为在这10个数据之间插值了10各点,算出来他们大小,存入到新的数组中,根据已经映射好的(颜色-数据)之间关系,依次pset画出来各个点颜色,就出现这些黑点了,我认为可能是数据插值出错或者是像素没有覆盖到,正在找原因。



附件: 您没有浏览附件的权限,请 登录注册
2018-03-21 17:40
造物主的落寞
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2017-4-18
  得分:0 
回复 2楼 风吹过b
已经解决这个问题,问题出在界定数据-颜色对比环节,没有限定好范围,导致有的数据没有办法对应上颜色,那个数据点颜色就取了RGB(0,0,0),出现黑色点。解决附图。
附件: 您没有浏览附件的权限,请 登录注册
2018-03-21 22:18
wmf2014
Rank: 18Rank: 18Rank: 18Rank: 18Rank: 18
等 级:贵宾
威 望:156
帖 子:1717
专家分:9556
注 册:2014-12-6
  得分:0 
回复 2楼 风吹过b
经测试,没有看到风斑竹所说的圆中心黑点,不知道风斑竹时在什么情况下得到的结果,可能我的模拟不正确。模拟代码及画图结果如下(注:Me.ScaleWidth、Me.ScaleHeight要能被2整除,否则会出现半光栅):
程序代码:
Private Sub Command1_Click()
Dim x As Double, y As Double, yr As Double, r As Integer
Me.ScaleLeft = -Me.ScaleWidth / 2
Me.ScaleTop = -Me.ScaleHeight / 2
r = 40
For x = 0 To r        'X从0到半径循环,每步一单位
  yr = Sqr(r * r - x * x) 'Y最大坐标,R为长边,X偏移为一直角边,高为另一直角边,高即Y最大值
  For y = 0 To yr     'Y从0到半径循环,每步一单位
     PSet (x, y), vbRed       '四个象限画点
     PSet (x, -y), vbRed
     PSet (-x, y), vbRed
     PSet (-x, -y), vbRed
  Next y
Next x
Me.ScaleLeft = -Me.ScaleWidth / 2 - 50
Me.ScaleTop = -Me.ScaleHeight / 2 - 50
r = 10
For x = 0 To r        'X从0到半径循环,每步一单位
  yr = Sqr(r * r - x * x) 'Y最大坐标,R为长边,X偏移为一直角边,高为另一直角边,高即Y最大值
  For y = 0 To yr     'Y从0到半径循环,每步一单位
     PSet (x, y), vbBlue       '四个象限画点
     PSet (x, -y), vbBlue
     PSet (-x, y), vbBlue
     PSet (-x, -y), vbBlue
  Next y
Next x

End Sub



[此贴子已经被作者于2018-3-22 09:26编辑过]

附件: 您没有浏览附件的权限,请 登录注册

能编个毛线衣吗?
2018-03-22 09:23
风吹过b
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:230
帖 子:4333
专家分:26462
注 册:2008-10-15
  得分:0 
好奇怪,我刚又回头复查了代码,又没出现 黑点了。。。。。
难道是电脑问题。

程序代码:
'调用:如
'
    Call Disc(DDian.X, DDian.Y, DDR * TX, DDian.Red, DDian.G, DDian.B)   '实心圆
'
绘制完成后,把内存数据转化为图像
'
Pb1.Contents = Pbb                      '把绘图数据放进图像数据中
'
Set Picture1.Picture = Pb1.ReadProperty("Picture")      '把图像数据显示出来,这里是放置在 Picture 层,该层是持久显示的

'有一个绘图区域大小变化时初始化数据
'
Picture1.Cls
'
PBag.WriteProperty "Picture", Picture1.Image
'
Pb1.WriteProperty "Picture", Picture1.Image
'
Call AnalysisPB

'----BAS代码----
Public Type pbbtype
    BMPSTART As Long                'BM头起位置
    MaxX As Long                    '图像横
    MaxY As Long                    '图像竖
    DatStart As Long                '数据区起始
    X() As Long                     '每行的起始坐标
'
    XL As Long                      '每行的数据个数,不含对齐用的数据
End Type


Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (Destination As Any, Source As Any, ByVal Length As Long)

Public PBag  As New PropertyBag         '空白数据,每次内存绘图时使用的初始化数据
Public Pb1 As New PropertyBag           '图像数据,每次绘图结束后显示用的数据
Public Pbb() As Byte                    '空白数据导出的绘图数组,内存绘图块
Public PbT As pbbtype                   '图像数据内存结构分析数据

Public Sub Circle2(X As Long, Y As Long, R As Long, Optional Red As Byte = 0, Optional Green As Byte = 0, Optional Blue As Byte = 0)
'空心圆,图像看起来有点问题
'
X,Y,R 以缇为单位
    Dim i As Long, j As Long
    Dim m As Long, m2 As Long
    Dim n1 As Long, n2 As Long
   
    i = Int(X / TX)                 '缇转像素
    j = Int(Y / TX)
    m = Int(R / TX)

    'Call Pset2(i, j, Red, Green, Blue)
   
For n1 = 0 To m                     'X轴,半幅
    m2 = Sqr(m * m - n1 * n1)       '计算X值固定时,Y坐标是多少
   
        '一次画8个点,会导致重复画点,但能确保画出来的圆闭合,光滑
        
        '使用X轴循环画Y轴点
        Call Pset2(i + n1, j + m2, Red, Green, Blue)        '四个象限画点
        Call Pset2(i - n1, j + m2, Red, Green, Blue)
        Call Pset2(i + n1, j - m2, Red, Green, Blue)
        Call Pset2(i - n1, j - m2, Red, Green, Blue)
        
        '使用Y轴循环画X轴点
        Call Pset2(i + m2, j + n1 - 1, Red, Green, Blue)      '四个象限画点
        Call Pset2(i - m2, j + n1 - 1, Red, Green, Blue)
        Call Pset2(i + m2, j - n1 + 1, Red, Green, Blue)
        Call Pset2(i - m2, j - n1 + 1, Red, Green, Blue)

Next n1

End Sub

Public Sub Disc(X As Long, Y As Long, R As Long, Optional Red As Byte = 0, Optional Green As Byte = 0, Optional Blue As Byte = 0)
'实心圆
'
X,Y,R 以缇为单位
    Dim i As Long, j As Long
    Dim m As Long, m2 As Long
    Dim n1 As Long, n2 As Long
   
    i = Int(X / TX)         '缇转像素
    j = Int(Y / TX)
    m = Int(R / TX)

    Call Pset2(i, j, Red, Green, Blue)      '先画圆心
   
    Call Circle2(X, Y, R, Red, Green, Blue) '先画空心圆,使用外圈光滑

'再填充,填充时,不管外圈
For n1 = 0 To m                             'X轴,半幅
    m2 = Sqr(m * m - n1 * n1)               '计算X值固定时,Y坐标是多少
    For n2 = -m2 + 1 To m2 - 1                  'Y坐标在上下两幅中使用循环描中间的点
   
        Call Pset2(i + n1, j + n2, Red, Green, Blue)            '描X轴 左右两幅的点
        Call Pset2(i - n1, j + n2, Red, Green, Blue)
        
    Next n2
Next n1

End Sub


Public Sub Pset2(X As Long, Y As Long, Optional Red As Byte = 0, Optional Green As Byte = 0, Optional Blue As Byte = 0)
'画点
'
X,Y 以像素为单

每回合画点统计 = 每回合画点统计 + 1             'debug统计用

    Dim m As Long
   
    If X > 0 And Y > 0 And Y < PbT.MaxY And X < PbT.MaxX Then
   
        m = PbT.X(Y) + X * 3            '计算内存偏移量
        Pbb(m) = Blue                   '置三原色分量
        Pbb(m + 1) = Green
        Pbb(m + 2) = Red
        
    End If
End Sub

Public Sub AnalysisPB()
'解析PBB

Pbb = PBag.Contents

Dim i As Long
Dim HBN As Long

For i = 0 To 200                                    '搜索前200字节,一般在58字节位置
If Pbb(i) = 66 And Pbb(i + 1) = 77 Then
    PbT.BMPSTART = i
    Exit For
End If
Next i

If PbT.BMPSTART = 0 Then
    MsgBox "解析图像数据失败", vbCritical, "致命错误"
    End
End If

    CopyMemory PbT.DatStart, Pbb(PbT.BMPSTART + 10), 4      '图像结构头长度
    PbT.DatStart = PbT.DatStart + PbT.BMPSTART              '图像数据区起点

    CopyMemory PbT.MaxX, Pbb(PbT.BMPSTART + 18), 4          '图像宽
    CopyMemory PbT.MaxY, Pbb(PbT.BMPSTART + 22), 4          '图像高

    ReDim PbT.X(PbT.MaxY)                                   '重定义 数据每行的起点位置 数组
   
    HBN = PbT.MaxX * 3                                      '计算每行总字节,加上了对齐用的字节
    If HBN Mod 4 <> 0 Then
        HBN = HBN + (4 - HBN Mod 4)
    End If
   
    For i = 1 To PbT.MaxY                                   '分析数据每行的起点位置
        PbT.X(PbT.MaxY - i + 1) = PbT.DatStart + HBN * (i - 1)
    Next i

End Sub


授人于鱼,不如授人于渔
早已停用QQ了
2018-03-22 10:21
造物主的落寞
Rank: 1
等 级:新手上路
帖 子:4
专家分:0
注 册:2017-4-18
  得分:0 
回复 6楼 风吹过b
大神,现在有一个问题,就是绘图速度问题,因为使用的是VB中的Pest方法,而且每次描点绘图都是使用循环,所以速度很慢很慢,如何写入内存中,然后再从内存中调用显示,很困扰,能不能简单的给个代码演示一下,比如说现在,RGB(i,j,k)与数据已经对应好了,就是写入内存中,再显示在picture中这个过程。或者给我一些建议,查一下哪方面的资料可以参考一下。万分感谢!
2018-04-08 15:28







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

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