关于图象识别的问题,请高手救我(100分)

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

pphuwww

Unregistered / Unconfirmed
GUEST, unregistred user!
在一底色为黑的图片上,有若干白色不规则物体,如何识别白色不规则物体的面积与周长
请给出详细的算法,提到图象处理的专用术语、知识稍加解释,非常感谢。。。
 
unit Unit1;

interface

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

type
TForm1 = class(TForm)
Image1: TImage;
Button1: TButton;
OpenPictureDialog1: TOpenPictureDialog;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
Count: Integer;
Colors: array [1..10000] of TColor;
procedure DoIt;
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

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

var
b: array [1..800, 1..600] of Integer;
List: array [1..800*600] of TPoint;

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
var
i: Integer;
begin
Image1.AutoSize:=True;
Count:=0;
FillChar(b, SizeOf(b), 0);
for i:=1 to 10000 do
Colors:=Random(256) shl 16+Random(256) shl 8+Random(256)
end;

procedure TForm1.DoIt;
var
Close, Open: Integer;
d: Byte;
i, j: Integer;
x, y: Integer;
begin
for i:=1 to Image1.Width do
for j:=1 to Image1.Height do
if (b[i, j]=0) and (Image1.Canvas.Pixels[i, j]<>clBlack) then
begin
Inc(Count);
b[j, j]:=Count;
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)
and (b[x, y]=0) and (Image1.Canvas.Pixels[x, y]<>clBlack) then
begin
b[x, y]:=Count;
Inc(Open);
List[Open].X:=X;
List[Open].Y:=y
end
end
until Close=Open;
ShowMessage(Format('第%d个物体面积为%d', [Count, Open]))
end;
Caption:=Format('共有%d个物体', [Count]);
for i:=1 to Image1.Width do
for j:=1 to Image1.Height do
Image1.Canvas.Pixels[i, j]:=Colors[b[i, j]]
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenPictureDialog1.Execute then
begin
Image1.Picture.LoadFromFile(OpenPictureDialog1.FileName);
if (Image1.Width<=800) and (Image1.Height<=600) then
DoIt
end
end;

end.
 
TO:
leechange
我测试了一个图。有一点误差
个数太多,并且有的白色不规则物体面积为1...
 
代码:
//--------------计算晶粒周长---------------
type TMessageGrid = array of array of boolean;
Myarray: TMessageGrid;
backarray:TMessageGrid;
procedure jinglicc;
var
cx,cy,ch,cw,m,n,i,j:integer;
str1,str2,tempaaa:string;
dx,dy:double;
label
aaa,bbb,ccc,ddd;
begin

with mainform.Image2 do begin
ch:=Picture.Height;
cw:=Picture.Width;
end;
//SetLength(myarray,intw,inth); 已有值

// SetLength(backarray,intw,inth); 已有值
backarray:= myarray;
dx:=1;
dy:=1;

dbnum:=0.0; //晶粒数
for cx:=0 to cw-1 do
begin
for cy:=0 to ch-1 do
begin
if backarray[cx,cy] then begin
// 找到最左点
length:=0.0;
xleft:=cx;
yleft:=cy;
m:=cx;
n:=cy;
//寻找最下点
aaa: for i:=-2 to 3 do begin
if (m+i>=0)and (M+i<=cw-1)and (n+1<=ch-1)and (backarray[m+i,n+1])then
begin
M:=M+i;
N:=N+1;
length:=length+sqrt(1+i*i)*dy;
goto aaa;
end;
end;
xbuttom:=m;
ybuttom:=n;
// 寻找最右点
bbb: for i:=-3 to 2do begin
if (m-i>=0)and (M-i<=cw-1)and (n-1>=0)and (backarray[m-i,n-1])then
begin
M:=M-i;
N:=N-1;
length:=length+sqrt(1+i*i)*dy;
goto bbb;
end;
end;
xright:=m;
yright:=n;
// 寻找最高点
ccc: for i:=-2 to 3 do begin
if (m-i>=0)and (M-i<=cw-1)and (n-1>=0)and (backarray[m-i,n-1])then
begin
M:=M-i;
N:=N-1;
length:=length+sqrt(1+i*i)*dy;
goto ccc;
end;
end;
xtop:=m;
ytop:=n;
// 寻找起点
ddd: for i:=-3to 2 do begin
if (m+i>=0)and (M+i<=cw-1)and (n+1<=ch-1)and (backarray[m+i,n+1])then
begin
M:=M+i;
N:=N+1;
length:=length+sqrt(1+I*i)*dy;
goto ddd;
end;
end;

xend:=m;
yend:=n;
if (abs(xleft-xend)<=2)and (abs(yleft-yend)<=2)then begin
tempaaa:='好好';
end;
//标记遍历过
for i:=xleft to xright do begin
for j:=ytop to ybuttom do
begin
backarray[i,j]:=false;
end;

end;
//写入数据库
if length<((strtofloat(szform.edit3.Text))*pi) then
begin
;
end else
begin
dbnum:=dbnum+1;
try
form11.table1.Insert;
form11.Table1.FieldByName('number').AsString:=floattostr(dbnum);
form11.table1.FieldByName('length').AsString:=floattostr(length);
form11.table1.FieldByName('r').AsString:=floattostr(length/(2*pi));
form11.table1.FieldByName('a').AsString:=floattostr(length*length/(4*pi));
form11.table1.FieldByName('rmin').AsString:=IntToStr(xleft);
form11.table1.FieldByName('rmax').AsString:=IntToStr(yleft);
form11.table1.FieldByName('bi').AsString:=floatToStr(xtop);
form11.table1.FieldByName('size').AsString:=floatToStr(ytop);
form11.Table1.Post;
numi2:=numi2+1;
except
showmessage('保存数据失败');
end;
end;

end;

end;
end;
上面的问题是只能计算一遍,再计算时dnum为0,但我在每次处理前已保存了,
同时也有个数太多,并且有的白色不规则物体周长
为1和.周长
太小的值..
 
to 楼主:
不好意思,程序是原先替另外一个dfw编的,他的条件是只要不是黑色就算一个物体,你的条件是
只有白色是物体,所以把
if (x>0) and (x<=Image1.Width) and (y>0) and (y<=Image1.Height)
and (b[x, y]=0) and (Image1.Canvas.Pixels[x, y]<>clBlack) then
改为
if (x>0) and (x<=Image1.Width) and (y>0) and (y<=Image1.Height)
and (b[x, y]=0) and (Image1.Canvas.Pixels[x, y]=clWhite) then
 
稍加解释一下
until Close=Open;
的含义,多谢
 
后退
顶部