// Der folgende
Code imitiert "FloodFill", wobei "Brush.Color"
// nicht geändert werden muss. Allerdings ist er etwas langsamer
// als das Original und enthält nicht "FillStyle", bietet aber bei
// geringfügigen Änderungen mehr Möglichkeiten für Manipulationen
//
(z.B. das Füllen
mit
unterschiedlichen
Farbpunkten innerhalb einer
//
bestimmten
Fäche. Siehe weiter unten).
// Getestet mit RS 10.4 unter Win11uses
System.Generics.Collections, System.Types;
procedure BmpFloodFill(bmp: TBitmap; X, Y: integer;
oldColor, newColor: cardinal);
var
DC: HDC;
Queue: TQueue<TPoint>;
Entn, Ent, CrtPt: TPoint;
c: cardinal;
begin
DC := bmp.Canvas.handle;
Queue := TQueue<TPoint>.Create;
Queue.Enqueue(Point(X, Y));
while (Queue.Count > 0) do
begin
Ent := Queue.Dequeue;
c := GetPixel(DC, Ent.X, Ent.Y);
if (c <> oldColor) or (c = newColor) then
continue;
Entn := Ent;
CrtPt := TPoint.Create(Ent.X + 1, Ent.Y);
while ((Entn.X >= 0) and (GetPixel(DC, Entn.X, Entn.Y) = oldColor)) do
begin
bmp.Canvas.pixels[Entn.X, Entn.Y] := newColor; // oder etwas anderes
if ((Entn.Y > 0) and (GetPixel(DC, Entn.X, Entn.Y - 1) = oldColor)) then
Queue.Enqueue(TPoint.Create(Entn.X, Entn.Y - 1));
if ((Entn.Y < bmp.Height - 1) and (GetPixel(DC, Entn.X, Entn.Y + 1)
= oldColor)) then
Queue.Enqueue(TPoint.Create(Entn.X, Entn.Y + 1));
dec(Entn.X);
end;
while ((CrtPt.X <= bmp.Width - 1) and (GetPixel(DC, CrtPt.X, CrtPt.Y)
= oldColor)) do
begin
bmp.Canvas.pixels[CrtPt.X, CrtPt.Y] := newColor; // oder etwas anderes
if ((CrtPt.Y > 0) and (GetPixel(DC, CrtPt.X, CrtPt.Y - 1) = oldColor))
then
Queue.Enqueue(TPoint.Create(CrtPt.X, CrtPt.Y - 1));
if ((CrtPt.Y < bmp.Height - 1) and (GetPixel(DC, CrtPt.X, CrtPt.Y + 1)
= oldColor)) then
Queue.Enqueue(TPoint.Create(CrtPt.X, CrtPt.Y + 1));
inc(CrtPt.X);
end;
end;
Queue.free;
end;
procedure TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
B: Byte;
begin
if ssAlt in Shift then
B := 0
else
B := 3;
with Image1.Picture do
BmpFloodFill(Bitmap, X, Y, Bitmap.Canvas.Pixels[X, Y], B)
end;
|