PDot = ^TDot;
//点指针
TDot = record //点类型
No: Integer;
//序号
Next: PDot;
//下一点指针
X: Integer;
Y: Integer;
RGBColor: TRGBColor;
KLColor: TKLColor;
IsSeperate: Boolean;
end;
PArea = ^TArea;
//区域指针
TArea = record //区域类型
No: Integer;
//区域序号 1-----
Description: string;
//描述
do
tNumber: Integer;
//点数
Next: PArea;
//下一区域指针
do
t: PDot;
//指向第一个点
end;
MyArray: array[1..txcl_object_width,1..txcl_object_high] of integer;
//目标真值图
var
i, j, k, k1, k2, k3, kk2, num: Integer;
//i列 j行
t, t1, t2, t3, tt2, newarea, pdtj: Boolean;//新区域
//找到新区域后找新区域的所有点
//本过程从第一行开始扫描，从左到右
label here1,here2;
begin
if not(FImageLoaded and FModelLoaded) then
exit;
Refresh;
//清除标记
do
Analyse(False);
ClearArea;
highlight_area:=nil;
Refresh ;
num:=0;
//ProgressBar.Position:=0;
//newarea:=True;
for j:=3 to txcl_object_highdo
begin
ProgressBar.Position:=j+200;
for i := 1 to txcl_object_widthdo
begin
newarea:=False;
if (i=154) and (j=167) then
begin
//showmessage('here')
end;
if (i=354) and (j=167) then
begin
//showmessage('here')
end;
if myarray[i,j]=1 then
//equal to 1 may be new area
begin
if j > 3 then
//不是第一行
begin
if i=1 then
pdtj:=(myarray[i,j-1]=1)
else
pdtj:= ((myarray[i-1,j]=1) or (myarray[i,j-1]=1));
if (not pdtj) then
//前面的点和上面的点不是区域点,则有可能是新区域点
begin
//found new area
if i = txcl_object_width then
newarea := True
else
begin
//可能是区域点，判断
t := True;
k := j - 1;
//行记数 先向上移一行
if k > 398 then
//last lin point
begin
newarea := True;
t := False;
end;
here2: ;
while tdo
//not last line point
begin
k:=k+1;
//行加1 向下移动
if (k > txcl_object_high) or (myarray[i,k]=0) then
//avoid over in loop
begin
newarea:=True;
//下面的行不是区域点，判定结束，出口
t := False;
//是新区域，返回
goto here2;
end
else
begin
// else
1
t3 := True;
t1 := True;
k1 := i;
//右移指针
k3 := i;
//左移指针
while t1do
begin
k1 := k1 + 1;
//向右移动
if (myarray[k1,k]=0) or (k1>599) then
//右移到头
begin
t1:=False;
//出右移循环
end
else
begin
//再向上查找
t2:=True;
k2:=k;
while t2do
begin
k2:=k2-1;
if (k2<3) or (myarray[k1,k2]=0) then
t2 := False
end;
if k2 < j-1 then
//not new area
begin
newarea := False;
//t2 := False;
t1 := False;
t3 := False;
t := False;
end
else
begin
//t2 := False;
end;
end;
//再向上查找
end;
//while t1
while t3do
begin
k3 := k3-1;
//向左移动
if (myarray[k3,k]=0) or (k3<1) then
//左移到头
begin
t3:=False;
//出左移循环
end
else
begin
//再向上查找
tt2:=True;
kk2:=k;
while tt2do
begin
kk2:=kk2-1;
if (kk2<3) or (myarray[k3,kk2]=0) then
tt2 := False;
end;
if kk2<j then
//not new area
begin
newarea := False;
//tt2 := False;
t3 := False;
//t1 := False;
t := False;
end
else
begin
//tt2 := False;
end;
end;
//再向上查找
end;
//while t3
end;
//else
1
end;
//not last line point
end;
//可能是区域点，判断
end;
//前面的点和上面的点不是区域点,则有可能是新区域点
end //不是第一行
else
//first line to process
begin
newarea := False;
if i = 1 then
newarea := True
else
if myarray[i-1,j]<>1 then
//前面一个不是
begin
k := j;
//k是行
t := True;
while tdo
begin
k := k+1;
//向下移
if (myarray[i,k]=0) or (k>599) then
begin
newarea:=True;
t:=False;
end
else
begin
//else
2
t1:=True;
//左循环
k1:=i;
//k1是列
while t1do
begin
k1:=k1-1;
//向左移
if (k1<1) or (myarray[k1,k]=0) then
begin
t1:=False;
end
else
begin
//再向上
k2:=k;
//行
t2:=True;
while t2do
begin
k2:=k2-1;
if (k2<j) or (myarray[k1,k2]=0) then
t2:=False;
end;
if k2<j then
//not new area
begin
newarea:=False;
//t2 := False;
t1 := False;
t := False;
end
else
begin
//t2 := False;
end;
end;
//再向上
end;
//while t1
end;
//else
2
end;
//while t
end;
//前面一个不是
end;
//=1 if
end;
////first line to process end of if myarray[i,j]=1
if newarea then
begin
// showmessage('found new area');
//DrawDot(i,j,clred);
//DrawDot(i,j-1,clred);
//DrawDot(i,j+1,clred);
//DrawDot(i-1,j,clred);
//DrawDot(i+1,j,clred);
AddArea(i,j);
num:=num+1;
end;
end;
//j loop
end;
//i loop
