图象识别的简单问题,答对全部分数奉送(119分)

  • 主题发起人 主题发起人 pphuwww
  • 开始时间 开始时间
P

pphuwww

Unregistered / Unconfirmed
GUEST, unregistred user!
在背景色为黑的图象上,有若干白色的不规则的物体,现要计算每个白色的不规则的物体的
周长,详细的算法也可得全分;小弟急用,望哪为大哥救人一命,不胜感谢。。。
 
算法不算太难,和我做得有点像,

1 通过区域填充算法过滤掉物体内部的杂质!
2 逐个找出所有的孤立区域
3.通过边沿搜索算法找出边沿
4.任取一点搜索边沿(近似于填充算法)求出周长
 
先找出边沿。
不好意思,好久没有搞图像处理的了,都忘记了,好像是用了3 * 3,
阀值你可以用一个150,因为你是纯黑色和白色,所以阀值无所谓,随便找个
就可以了
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TIntArr = array of Integer;

TForm1 = class(TForm)
Image1: TImage;
ListBox1: TListBox;
Button1: TButton;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
function Cal: TIntArr;
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

const
Move: array [1..8, 1..2] of Integer = ((-1, 0), (-1, 1), (0, 1), (1, 1),
(1, 0), (1, -1), (0, -1), (-1, -1));

function TForm1.Cal: TIntArr;
type
TNode = record
x, y: Integer
end;
var
List: array [1..801*601] of TNode;
Close, Open: Integer;
Mark: array [0..800, 0..600] of Boolean;
i, j, d: Integer;
x, y: Integer;
Sum: Integer;
function InBorder(x, y: Integer): Boolean;
var
i: Integer;
xx, yy: Integer;
begin
Result:=False;
for i:=1 to 8 do
begin
xx:=x+Move[i, 1];
yy:=y+Move[i, 2];
if (xx>=0) and (xx<=Image1.Width) and (yy>=0) and (yy<=Image1.Height) then
if Image1.Canvas.Pixels[xx, yy]<>clWhite then
begin
Result:=True;
Exit
end
end
end;
begin
SetLength(Result, 0);
FillChar(Mark, SizeOf(Mark), 0);
for i:=0 to Image1.Width do
for j:=0 to Image1.Height do
if not Mark[i, j] then
begin
SetLength(Result, Length(Result)+1);
Sum:=0;
Close:=0;
Open:=1;
List[1].x:=i;
List[1].y:=j;
repeat
Inc(Close);
for d:=1 to 8 do
begin
x:=List[Close].x+Move[d, 1];
y:=List[Close].y+Move[d, 2];
if (x>=0) and (x<=Image1.Width) and (y>=0) and (y<=Image1.Height) then
if Image1.Canvas.Pixels[x, y]=clWhite then
if not Mark[x, y] then
begin
Inc(Open);
List[Open].x:=x;
List[Open].y:=y;
if InBorder(x, y) then
Inc(Sum)
end
end
until Close=Open;
Result[Length(Result)-1]:=Sum
end
end;

procedure TForm1.Button1Click(Sender: TObject);
var
i: Integer;
a: TIntArr;
begin
a:=Cal;
for i:=Low(a) to High(a) do
ListBox1.Items.Append(Format('%d: %d', [i+1, a]))
end;

end.
 
to:
LeeChange
这样噪声点对周长的影响很大, 这样计算周长肯定偏大。

 
to:
LeeChange
报错:‘stakc overflow’
 
多人接受答案了。
 
TO
yanxiaolong 不好意思,加错分了
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
I
回复
0
查看
612
import
I
I
回复
0
查看
609
import
I
后退
顶部