首先通过一个阈值将图象二值化，然后通过下面的程序可以获得各个块的大小以及
最小矩形框。
type
TCell = record
Left, Top, Right, Bottom: Integer;
Size: Integer;
end;
function GetCell(Bmp: TBitmap; x, y: Integer): TCell;
const
dx: array [1..4] of Integer = (-1, 0, 1, 0);
dy: array [1..4] of Integer = ( 0,-1, 0, 1);
var
Ptr: PByteArray;
Cell: TCell;
i, nx, ny: Integer;
begin
Ptr := Bmp.ScanLine[y];
Ptr[x] := 0;
with Result do begin
Left := x;
Right := x;
Top := y;
Bottom := y;
Size := 1;
end;
for i := 1 to 4 do begin
nx := x + dx;
ny := y + dy;
if (nx >= 0) and (nx < Bmp.Width) and
(ny >= 0) and (ny < Bmp.Height) then begin
Ptr := Bmp.ScanLine[ny];
if Ptr[nx] = 0 then begin
Cell := GetCell(Bmp, nx, ny);
with Result do begin
if Cell.Left < Left then Left := Cell.Left;
if Cell.Right > Right then Right := Cell.Right;
if Cell.Top < Top then Top := Cell.Top;
if Cell.Bottom > Bottom then Bottom := Cell.Bottom;
Inc(Size, Cell.Size);
end;
end;
end;
end;
end;
function CellToString(Cell: TCell): String;
begin
Result := Format('(%d, %d) - (%d, %d): %d',
[Cell.Left, Cell.Top, Cell.Right, Cell.Bottom, Cell.Size]);
end;
procedure TForm1.Button1Click(Sender: TObject);
var
Bmp: TBitmap;
Ptr: PByteArray;
i, j: Integer;
Cell: TCell;
begin
Bmp := TBitmap.Create;
try
Bmp.LoadFromFile('d:/myfiles/Cells.bmp');
Bmp.PixelFormat := pf8Bit;
for i := 0 to Bmp.Height - 1 do begin
Ptr := Bmp.ScanLine;
for j := 0 to Bmp.Width - 1 do
if Ptr[j] = 0 then begin
Cell := GetCell(Bmp, j, i);
ListBox1.Items.Add(CellToString(Cell));
end;
end;
finally
Bmp.Free;
end;
end;
ByteArray;