// 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 Win11
uses 
  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;
 
 
Zugriffe seit 6.9.2001 auf Delphi-Ecke