Re: analysing a bitmap



oh that was the wrong code


unit Unit1;

interface

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

type
TCoordinate = 1..300;
TForm1 = class(TForm)
Image1: TImage;
Image2: TImage;
Button1: TButton;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private-Deklarationen }
CacheBitmap: TBitmap;
MyImageMap: array [TCoordinate, TCoordinate] of integer;
procedure Fill(X, Y: TCoordinate; Colour: integer);
procedure BuildImageMap;
public
{ Public-Deklarationen }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BuildImageMap;
var
TempBitmap: TBitmap;
x, y: Integer;
P: PRGBQuad; // definiert in Windows.pas
begin
TempBitmap:= TBitMap.create;
//MyImageMap:= MyImageMap;
try
TempBitmap.Assign(Image1.Picture.Bitmap);
TempBitmap.PixelFormat:= pf32bit;

for y:= 0 to TempBitmap.Height-1 do
begin
P:= TempBitmap.ScanLine[y];
for x:= 0 to TempBitmap.Width-1 do
begin
if (P^.rgbRed = 0) and (P^.rgbGreen = 0) and (P^.rgbBlue = 0) then
MyImageMap[X, Y]:= 1
else
MyImageMap[X, Y]:= 0;
end;
end;
finally
TempBitmap.Free;
end;
end;

procedure TForm1.Fill(X, Y: TCoordinate; Colour: integer);
var OldColour: Integer;
begin
OldColour:=MyImageMap[X, Y];
MyImageMap[X, Y]:=Colour;

//Dump(Image, X, Y);
if OldColour=Colour then exit;
{ Look left }
if (Low(X)<X) and (MyImageMap[Pred(X), Y]=OldColour)
then Fill(Pred(X), Y, Colour);

{ Look right }
if (X<High(X)) and (MyImageMap[Succ(X), Y]=OldColour)
then Fill(Succ(X), Y, Colour);

{ Look up }
if (Low(Y)<Y) and (MyImageMap[X, Pred(Y)]=OldColour)
then Fill(X, Pred(Y), Colour);

{ Look down }
if (Y<High(Y)) and (MyImageMap[X, Succ(Y)]=OldColour)
then Fill(X, Succ(Y), Colour);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
BuildImageMap;
Fill((Pred(300+2)) div 2, (Pred(300+2)) div 2, 0);
showmessage('done');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
CacheBitmap:= TBitMap.create;
CacheBitmap.PixelFormat:= pf32bit;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
CacheBitmap.Free;
end;

end.


.