Re: TBitmap - how to copy an "object"

hi,

i tried to modify your example but i allways get a stack-overflow :(

the code:

unit Unit1;

interface

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

type
TCoordinateX = 1..242;
TCoordinateY = 1..102;
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 [TCoordinateX, TCoordinateY] of integer;
procedure Fill(X: TCoordinateX; Y: TCoordinateY; 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);
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: TCoordinateX; Y: TCoordinateY; Colour: integer);
var OldColour: Integer;
begin
OldColour:=MyImageMap[X, Y];
MyImageMap[X, Y]:=Colour;

//Dump(Image, X, Y);

{ 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(242+2)) div 2, (Pred(102+2)) div 2, 0);
end;

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

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

end.



"Maarten Wiltink" <maarten@xxxxxxxxxxxxxxxxxx> schrieb im Newsbeitrag
news:42714cfb$0$162$e4fe514c@xxxxxxxxxxxxxxxxx
> "Peter Bauer" <PeterBauer@xxxxxxxx> wrote in message
> news:4270e38f$0$27718$9b622d9e@xxxxxxxxxxxxxxxxxx
>
> <flood fill>
>
>> thanks, right thats what i want to do,
>> but i have no idea how translate this
>> into delphi code, i thought abt. a TList
>> to handle this, but i failed - i also
>> searched with google for hours, no usefull results :(
>
> Start simple. Start _really_ simple.
>
> Start with a small image. 5x5 is large enough.
> Start with few colours. Two.
> Start with a simple data structure. A 2D array.
>
> const
> N = 5;
> type
> TCoordinate = 1..N;
> TColour = '0'..'1';
> TImage = array [TCoordinate, TCoordinate] of TColour;
> const
> Image : TImage
> = (('1', '0', '1', '0', '0'),
> ('1', '0', '1', '1', '1'),
> ('1', '0', '1', '1', '0'),
> ('0', '0', '1', '0', '0'),
> ('0', '1', '1', '0', '1')
> );
>
> Set the starting configuration and kick off the computation:
>
> var
> NewImage: TImage;
> begin
> NewImage:=Image;
> Fill(NewImage, (Pred(N+2)) div 2, (Pred(N+2)) div 2, '0');
> end;
>
> Copy the original image to a variable where it can be changed,
> and call the worker procedure with the starting coordinates and
> the fill colour. The numbers may look a little intimidating but
> they're just being halved, rounded up. N is odd so it starts in
> the exact middle.
>
> The meat is of course in the Fill procedure:
>
> procedure Fill
> (var Image: TImage;
> const X, Y: TCoordinate;
> const NewColour: TColour);
> var
> OldColour: TColour;
> begin
> OldColour:=Image[X, Y];
> Image[X, Y]:=NewColour;
>
> { Look left }
> if (Low(X)<X) and (Image[Pred(X), Y]=OldColour)
> then Fill(Image, Pred(X), Y, NewColour);
>
> { Look right }
> if (X<High(X)) and (Image[Succ(X), Y]=OldColour)
> then Fill(Image, Succ(X), Y, NewColour);
>
> { Look up }
> if (Low(Y)<Y) and (Image[X, Pred(Y)]=OldColour)
> then Fill(Image, X, Pred(Y), NewColour);
>
> { Look down }
> if (Y<High(Y)) and (Image[X, Succ(Y)]=OldColour)
> then Fill(Image, X, Succ(Y), NewColour);
> end;
>
> First, save the "propagation colour". The fill algorithm keeps
> running as long as it can find more pixels of this colour. Next,
> overwrite the current pixel. This is done before recursing so
> progress is always being made and the recursion will stop in the
> end. Then each direction is inspected. If the fill should continue
> in that direction, it does.
>
> That's all. At this point, you can single-step through the code
> and it will work. It should be clear what it does, how it does it,
> and why it works. If it isn't, read it again. And again. If it's
> too simple for your tastes, remember that you couldn't come up
> with it. There is no shame in that. Learn to walk before you try
> to run. I did.
>
> Below is the full source code for a console application that
> demonstrates a working flood fill. It's an integral and verbatim
> copy of a project file that compiles and runs in D5. It incorporates
> a dump of the current image to screen after every iteration of the
> Fill procedure, with a star in the current pixel. What it _doesn't_
> show is the current stack, although that is a crucial part of the
> algorithm. You can place a breakpoint on the Dump() call and show
> the call stack window to see that develop.
>
> Groetjes,
> Maarten Wiltink
>
> ------------------------
>
> program FloodFill;
>
> const
> N = 5;
> type
> TCoordinate = 1..N;
> TColour = '0'..'1';
> TImage = array [TCoordinate, TCoordinate] of TColour;
>
> procedure Dump(const Image: TImage; const XX, YY: TCoordinate);
> var X, Y: TCoordinate;
> begin
> for X:=Low(X) to High(X)
> do begin
> for Y:=Low(Y) to High(Y)
> do begin
> if (X=XX) and (Y=YY)
> then Write('*')
> else Write(Image[X, Y]);
> end;
> WriteLn;
> end;
> WriteLn;
> end;
>
> procedure Fill
> (var Image: TImage;
> const X, Y: TCoordinate;
> const Colour: TColour);
> var
> OldColour: TColour;
> begin
> OldColour:=Image[X, Y];
> Image[X, Y]:=Colour;
>
> Dump(Image, X, Y);
>
> { Look left }
> if (Low(X)<X) and (Image[Pred(X), Y]=OldColour)
> then Fill(Image, Pred(X), Y, Colour);
>
> { Look right }
> if (X<High(X)) and (Image[Succ(X), Y]=OldColour)
> then Fill(Image, Succ(X), Y, Colour);
>
> { Look up }
> if (Low(Y)<Y) and (Image[X, Pred(Y)]=OldColour)
> then Fill(Image, X, Pred(Y), Colour);
>
> { Look down }
> if (Y<High(Y)) and (Image[X, Succ(Y)]=OldColour)
> then Fill(Image, X, Succ(Y), Colour);
> end;
>
> const
> Image : TImage
> = (('1', '0', '1', '0', '0'),
> ('1', '0', '1', '1', '1'),
> ('1', '0', '1', '1', '0'),
> ('0', '0', '1', '0', '0'),
> ('0', '1', '1', '0', '1')
> );
> var
> NewImage: TImage;
> begin
> NewImage:=Image;
> Fill(NewImage, (Pred(N+2)) div 2, (Pred(N+2)) div 2, '0');
> end.
>
>
>


.