如何在delphi中计算下图中线条的长度和个数！！！ ( 积分: 100 )

  • 主题发起人 主题发起人 liwenbin
  • 开始时间 开始时间
L

liwenbin

Unregistered / Unconfirmed
GUEST, unregistred user!
如何在delphi中计算下图中线条的长度和个数！！！

http://www.01cn.net/noncgi/attach/2005/05/25/10268-aaaa-embed.JPG
 
如何在delphi中计算下图中线条的长度和个数！！！

http://www.01cn.net/noncgi/attach/2005/05/25/10268-aaaa-embed.JPG
 
循环比较颜色，你看可以不，
如果上下左右没有表示线段结束，是一条线段，你看如何？
 
具体的的代码我都些好了！！
但就是有一点点bug。采用的是类似种子填充的八连通算法！！1
留下你的email QQ，帮我捉捉虫！！！
 
能否探讨一下什么是八连通算法，在网上的资料不多；
 
贴出程序大家看看！！！

procedure StatistiCode;
type
stackfield = record
x, y, num: integer;
end;
var
stack: array of stackfield;
procedure set_stack_empty();
begin
setlength(stack, 1);
stack[0].num := 0;
end;
function stack_is_empty(): boolean;
begin
if stack[0].num = 0 then
result := true
else
result := false;
end;
function finddataisexit(point: Tpoint): boolean;
var
i: integer;
begin
Result := false;
if stack[0].num <> 0 then
for i := 1 to stack[0].num do
begin
if (point.X = stack.x) and (point.y = stack.y) then
Result := true
else
Result := false;
end;
end;
procedure push(point: Tpoint);
begin
stack[0].num := stack[0].num + 1;
if stack[0].num > (length(stack) - 1) then
setlength(stack, length(stack) + 1);
stack[stack[0].num].x := point.x;
stack[stack[0].num].y := point.y;
end;
procedure pop(var point: Tpoint);
begin
if stack[0].num > 0 then
begin
point.x := stack[stack[0].num].x;
point.y := stack[stack[0].num].y;
stack[0].num := stack[0].num - 1;
setlength(stack, length(stack) - 1);
end;
end;

var
Newbmp: TBitmap;
P: PByteArray;
iNumber: integer;
j, i: integer;
pt, pt1: Tpoint;

begin

Newbmp := TBitmap.Create;
Newbmp.Assign(form1.image1.Picture.Bitmap);
if Newbmp.PixelFormat <> pf8bit then
ShowMessage('false');
iNumber := 0;
for j := 0 to Newbmp.Height - 1 do
begin
P := Newbmp.ScanLine[j];
for i := 0 to Newbmp.Width - 1 do
if p= 255 then //if current piexl is white then
begin
set_stack_empty(); //clear stack
pt.X := i;
pt.Y := j;
p := 0;
push(pt);
Form1.Memo1.Lines.Add(inttostr(iNumber) + ' ' + inttostr(pt.x) + ' '
+ inttostr(pt.y));

while (not stack_is_empty()) do
begin
pop(pt);

P := Newbmp.ScanLine[pt.Y - 1];
if (pt.Y > 0) and (p[pt.X] = 255) then //up
begin
pt1.X := pt.X;
pt1.Y := pt.Y - 1;
p[pt1.X] := 0;
push(pt1);
end;

P := Newbmp.ScanLine[pt.Y - 1];
if (pt.Y > 0) and (pt.X < Newbmp.Width - 1)
and (p[pt.X + 1] = 255) then //right up
begin
pt1.X := pt.X + 1;
pt1.Y := pt.Y - 1;
p[pt1.X] := 0;
push(pt1);
end;

P := Newbmp.ScanLine[pt.Y];
if (pt.X < Newbmp.Width - 1)
and (p[pt.X + 1] = 255) then //right
begin
pt1.X := pt.X + 1;
pt1.Y := pt.Y;
p[pt1.X] := 0;
push(pt1);
end;

P := Newbmp.ScanLine[pt.Y + 1];
if (pt.Y < Newbmp.Height - 1) and (pt.X < Newbmp.Width - 1)
and (p[pt.X + 1] = 255) then //right down
begin
pt1.X := pt.X + 1;
pt1.Y := pt.Y + 1;
p[pt1.X] := 0;
push(pt1);
end;

P := Newbmp.ScanLine[pt.Y + 1];
if (pt.Y < Newbmp.Height - 1)
and (p[pt.X] = 255) then // down
begin
pt1.X := pt.X;
pt1.Y := pt.Y + 1;
p[pt1.X] := 0;
push(pt1);
end;

P := Newbmp.ScanLine[pt.Y + 1];
if (pt.Y < Newbmp.Height - 1) and
(pt.X > 0) and (p[pt.X - 1] = 255) then //left down
begin
pt1.X := pt.X - 1;
pt1.Y := pt.Y + 1;
p[pt1.X] := 0;
push(pt1);
end;

P := Newbmp.ScanLine[pt.Y];
if (pt.x > 0) and (p[pt.X - 1] = 255) then //left
begin
pt1.X := pt.X - 1;
pt1.Y := pt.Y;
p[pt1.X] := 0;
push(pt1);
end;

P := Newbmp.ScanLine[pt.Y - 1];
if (pt.x > 0) and (pt.Y > 0) and (p[pt.X - 1] = 255) then //left up
begin
pt1.X := pt.X - 1;
pt1.Y := pt.Y - 1;
p[pt1.X] := 0;
push(pt1);
end;
// Form1.Memo1.Lines.Add(inttostr(iNumber) + ': ' + inttostr(pt1.x) + ' '
// + inttostr(pt1.y) + ' ' + IntToStr(stack[0].num));
end;

inc(iNumber);
end;
end;
Form1.Caption := IntToStr(iNumber);
Newbmp.Free;
end;
 
打个包，把图片一起发过来吧 tseug@263.net
 
种子填充的八连通算法？
这要求图形是封闭的啊。
用这个东东怎么达到你的要求？种子怎么选？说个大概原理来听听？
 
太難, 不會!
 
假设图像背景是黑色（0），前景是白色（255），
那我就从图像（8位位图）的数据区用ScanLine开始扫描，如果碰到的数据是黑色（0），就跳过，继续扫描，一、 如果碰到的数据是白色（255），就将此点设置位黑色（0），并且将此点的位置压入堆栈。二、又将此点位置从堆栈弹出，然后从此点上方开始顺时针扫描其周围的八个点是否是白色（255），如果是白色，将此点置黑，仍然将此点的位置压入堆栈。反复到第二部操作。知道堆栈为空。 然后。。。。。
具体实现在程序里，你运行一下，看看目录下的a.txt文件和程序，就会理解我得意思！

现在问题是在成程序运行到点216，54 点时，216 54点应该是黑色（0），但计算机判断是白色（255）。所以不知道问题出在那里？
谢谢！！！
 
依据黑色（0），白色（255）两个值来作为判断依据，我看必须是纯粹的二值图(只有黑白
二色)才行。否则，只要存在灰阶，那么必然有很多中间值在里面。
比如图上你看着似乎已经足够黑的地方，但是其实并没有黑到家(值不为0，可能为1或2
什么的)，这样计算机当然不会判断为0拉。
你帖出来的这张图明显有灰阶，把它另存为二值图(单色位图)再试一下。(Windows的画图
程序就能做到了，Photoshop也行)
如果不想这么做，那么只好改判断条件：黑色(0~3或更大)，白色(255~253或更小)，即稍微
模糊一些。
 
对不起忘了说明一下，图像已经是二值图像了，里面的数据只有0 或者 255 不存在其他数据。
 
汗~~！怎么会用这个？
QQ群：10577739
10577780
大虾菜鸟来交流
 
还是一头雾水...
 
请看看拉
 
你的线条的长度是什么意思,是所有线条的长度的总和吗?
 
procedure TForm1.Button1Click(Sender: TObject);
var
i,j,k:integer;
len,number:integer;
begin
len:=0;
number:=0;
for i:=0 to Image1.Width do
for j:=0 to Image1.Height do
begin
if Image1.Canvas.Pixels[i,j]=clblack then
begin
k:=0;
len:=len+1;
if Image1.Canvas.Pixels[i-1,j]=clblack then
k:=K+1;
if Image1.Canvas.Pixels[i-1,j-1]=clblack then
k:=K+1;
if Image1.Canvas.Pixels[i,j-1]=clblack then
k:=K+1;
if Image1.Canvas.Pixels[i+1,j-1]=clblack then
k:=K+1;
if Image1.Canvas.Pixels[i+1,j]=clblack then
k:=K+1;
if Image1.Canvas.Pixels[i+1,j+1]=clblack then
k:=K+1;
if Image1.Canvas.Pixels[i,j+1]=clblack then
k:=K+1;
if Image1.Canvas.Pixels[i-1,j+1]=clblack then
k:=K+1;
if k=1 then
begin
number:=number+1;
end;
end;

end;
showmessage('总长度：'+inttostr(len)+' '+'线条个数：'+inttostr(number));
end;
 
请问楼主会不会检测圆的中心坐标和直径的代码
 
不是！！！是一个单个线条长度的象素以及总线条的个数。
to wanghaiou:
你的这种方法可以行，但就是在处理2500 x 3300 这么大的图像时要耗费3s，而用自己编写的StatistiCode代码只要180ms
谢谢！！！
具体的代码如下：

http://www.01cn.net/noncgi/attach/2005/06/14/10557-10286-statistic.rar

http://www.01cn.net/noncgi/attach/2005/06/14/10558-2.rar
 
您必须登录或注册才可回复。

Similar threads

X
使用kbmmw中的随机数替换delphi 10.3 自带的随机数 - xalion
回复
0
查看
741
xalion
X
X
使用kbmmw中的随机数替换delphi 10.3 自带的随机数 - xalion
回复
0
查看
912
xalion
X
S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
[转]ClientDataSet加上TDataSetProvider的数据保存问题
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
[原]Delphi XE10调用百度地图和百度导航
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部