我的图像是8位0 255图像，图像紧紧是通过细化处理。我贴出主要实现代码你看看.
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;
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
//问题是有几处p是255，在本程序中，0代表黑色，255代表白色
//但Image1.Canvas.Pixels[i,j]却是黑色。
set_stack_empty(); //clear stack
pt.Y := j;
pt.x := i;
p := 0;
push(pt);
Form1.Memo1.Lines.Add(inttostr(iNumber) + ': ' + inttostr(pt.x) + ' '
+ inttostr(pt.y) );
// Form1.Memo1.Lines.Add(inttostr(iNumber) + ': ' + inttostr(pt.x) + ' '
// + inttostr(pt.y) + ' ' + IntToStr(stack[0].num));
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.X < Newbmp.Width - 1) and (pt.Y < Newbmp.Height - 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;
