好奇怪,我刚又回头复查了代码,又没出现 黑点了。。。。。
难道是电脑问题。
程序代码:
'调用:如
' 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