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
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.