Re: TBitmap - how to copy an "object"
- From: Ekkehard Domning <edo@xxxxxxxx>
- Date: Thu, 28 Apr 2005 16:45:26 +0200
Hello Peter.
Maarten Wiltink wrote:
"Peter Bauer" <PeterBauer@xxxxxxxx> wrote in messagei'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 .
- Follow-Ups:
- Re: TBitmap - how to copy an "object"
- From: Nicholas Sherlock
- Re: TBitmap - how to copy an "object"
- References:
- TBitmap - how to copy an "object"
- From: Peter Bauer
- Re: TBitmap - how to copy an "object"
- From: Maarten Wiltink
- TBitmap - how to copy an "object"
- Prev by Date: Re: Free Delphi 2005 Professional....
- Next by Date: Can't delete directories
- Previous by thread: Re: TBitmap - how to copy an "object"
- Next by thread: Re: TBitmap - how to copy an "object"
- Index(es):