Re: TBitmap - how to copy an "object"



Hello Peter.

Maarten Wiltink wrote:
"Peter Bauer" <PeterBauer@xxxxxxxx> wrote in message
i'm trying to copy an "object" of one color out of a TBitmap,
the problem i got is that i dont know when a pixel belongs to
this object when the image contains more then one objects.

I'll take a step back if you'll allow me, and solve one problem at a time. Am I correct in describing the first problem as finding a connected, single-colour area?

Great Maarten! I had read the posting and had no idea about the contents :-(


If you know where to start, you can search outwards in all directions
from the starting pixel, adding neighbouring pixels to your region
if they are still the same colour. It's easy to program as a
recursive algorithm; it's essentially a flood fill. Thinking back,
stack depth was a problem but this was in 1990 or so, still on a 16
bit platform.

Peter, here a recursiv (Program Stack stored) example. Place a TImage with a loaded Image on it on the form.
The example is *very* slow, because the Bitmap.Canvas.Pixels access slows down everything. Also the recursive approach is clear in how to program but maybe a a data stack is faster/better. A lot of pixels are tested twice or more, so it could be optimized in several ways. I made it just to give You an idea.


procedure ReplaceContinousColor(
            const Bitmap : TBitmap;
            const X,Y : Integer;
            const SearchColor, ReplaceColor : TColor);
begin
  if SearchColor = ReplaceColor then
    Exit; //Nothing to do
  if (X < 0) or (Y < 0) or
     (X >= Bitmap.Width) or (Y >= Bitmap.Height) then
    Exit; //Out of Range
  if Bitmap.Canvas.Pixels[X,Y] = SearchColor then
    Bitmap.Canvas.Pixels[X,Y] := ReplaceColor //Color found, replace
  else
    Exit; //Color not found, done
  //8 Pixels around
  ReplaceContinousColor(Bitmap,X-1,Y-1,SearchColor, ReplaceColor);
  ReplaceContinousColor(Bitmap,X-1,  Y,SearchColor, ReplaceColor);
  ReplaceContinousColor(Bitmap,X-1,Y+1,SearchColor, ReplaceColor);
  ReplaceContinousColor(Bitmap,X,  Y-1,SearchColor, ReplaceColor);
  ReplaceContinousColor(Bitmap,X,  Y+1,SearchColor, ReplaceColor);
  ReplaceContinousColor(Bitmap,X+1,Y-1,SearchColor, ReplaceColor);
  ReplaceContinousColor(Bitmap,X+1,  Y,SearchColor, ReplaceColor);
  ReplaceContinousColor(Bitmap,X+1,Y+1,SearchColor, ReplaceColor);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  ReplaceContinousColor(
            Image1.Picture.Bitmap,
            0,0,
            clWhite, clBlue);
end;

> Groetjes,
> Maarten Wiltink

Best regards
Ekkehard
.