// Ein TPngImage wird partiell eingefärbt, wobei eine bestimmte Toleranz
// für die zu überdeckende Farbe angegeben werden kann.
// Siehe auch: FloodFill nachempfinden

// Getestet mit RS 10.4 unter Win11

Original FloodFill PngFloodFill

uses System.Generics.Collections, System.Types; 
 
procedure PngFloodFill(Bild: TPngImage; X, Y: Integer; oldCol, newCol: TColor; 
  Toleranz: Byte); 
const 
  s = 100 / 255; 
var 
  Queue: TQueue<TPoint>; 
  Entn, Ent, CrtPt: TPoint; 
  Line: Pointer; 
  r, g, b, rn, gn, bn: Byte; 
 
  function prozent(p: Pointer; X: Integer): Boolean; 
  begin 
    result := (abs(b - PRGBLine(Line)^[X].rgbtBlue) * s <= Toleranz) and 
      (abs(g - PRGBLine(Line)^[X].rgbtGreen) * s <= Toleranz) and 
      (abs(r - PRGBLine(Line)^[X].rgbtRed) * s <= Toleranz); 
  end; 
 
  function gleich(X, Y: Integer): Boolean; 
  begin 
    Line := Bild.Scanline[Y]; 
    result := (PRGBLine(Line)^[X].rgbtBlue = bn) and 
      (PRGBLine(Line)^[X].rgbtGreen = gn) and (PRGBLine(Line)^[X].rgbtRed = rn); 
  end; 
 
  function drin(X, Y: Integer): Boolean; 
  begin 
    Line := Bild.Scanline[Y]; 
    result := prozent(Line, X); 
  end; 
 
  procedure doit(X, Y: Integer); 
  begin 
    Line := Bild.Scanline[Y]; 
    PRGBLine(Line)^[X].rgbtBlue := bn; 
    PRGBLine(Line)^[X].rgbtGreen := gn; 
    PRGBLine(Line)^[X].rgbtRed := rn; 
  end; 
 
begin 
  oldCol := ColorToRGB(oldCol); 
  newCol := ColorToRGB(newCol); 
  r := GetRValue(oldCol); 
  g := GetGValue(oldCol); 
  b := GetBValue(oldCol); 
  rn := GetRValue(newCol); 
  gn := GetGValue(newCol); 
  bn := GetBValue(newCol); 
 
  Queue := TQueue<TPoint>.Create; 
  Queue.Enqueue(Point(X, Y)); 
  while (Queue.Count > 0) do 
  begin 
    Ent := Queue.Dequeue; 
    if not drin(Ent.X, Ent.Y) or gleich(Ent.X, Ent.Y) then 
      continue; 
    Entn := Ent; 
    CrtPt := TPoint.Create(Ent.X + 1, Ent.Y); 
    while (Entn.X >= 0) and drin(Entn.X, Entn.Y) do 
    begin 
      doit(Entn.X, Entn.Y); 
      if ((Entn.Y > 0) and drin(Entn.X, Entn.Y - 1)) then 
        Queue.Enqueue(TPoint.Create(Entn.X, Entn.Y - 1)); 
      if (Entn.Y < Bild.Height - 1) and drin(Entn.X, Entn.Y + 1) then 
        Queue.Enqueue(TPoint.Create(Entn.X, Entn.Y + 1)); 
      dec(Entn.X); 
    end; 
    while (CrtPt.X <= Bild.Width - 1) and drin(CrtPt.X, CrtPt.Y) do 
    begin 
      doit(CrtPt.X, CrtPt.Y); 
      if (CrtPt.Y > 0) and drin(CrtPt.X, CrtPt.Y - 1) then 
        Queue.Enqueue(TPoint.Create(CrtPt.X, CrtPt.Y - 1)); 
      if (CrtPt.Y < Bild.Height - 1) and drin(CrtPt.X, CrtPt.Y + 1) then 
        Queue.Enqueue(TPoint.Create(CrtPt.X, CrtPt.Y + 1)); 
      inc(CrtPt.X); 
    end; 
  end; 
  Queue.free; 
end; 
 
 
// Beispielaufruf für PngFloodFill 
 
procedure TForm1.Button1Click(Sender: TObject); 
var 
  png: TPngImage; 
  p1, p2: TPoint; 
begin 
  p1 := Point(90, 225); 
  p2 := Point(70, 205); 
  png := TPngImage.CreateBlank(COLOR_RGB, 8, Image1.Picture.Width, 
    Image1.Picture.Height); 
  png.Canvas.Draw(0, 0, Image1.Picture.Graphic); 
  PngFloodFill(png, p1.X, p1.Y, png.Canvas.Pixels[p1.X, p1.Y], clAqua, 35); 
  PngFloodFill(png, p2.X, p2.Y, png.Canvas.Pixels[p2.X, p2.Y], clLime, 40); 
  Image1.Picture.Assign(png); 
  FreeAndNil(png); 
end; 
 
 
// Vergleich mit FloodFill 
 
procedure TForm1.Button2Click(Sender: TObject); 
var 
  png: TPngImage; 
  p1, p2: TPoint; 
begin 
  p1 := Point(90, 225); 
  p2 := Point(70, 205); 
  png := TPngImage.CreateBlank(COLOR_RGB, 8, Image2.Picture.Width, 
    Image2.Picture.Height); 
  png.Canvas.Draw(0, 0, Image2.Picture.Graphic); 
  png.Canvas.Brush.Color := clAqua; 
  png.Canvas.FloodFill(p1.X, p1.Y, png.Canvas.Pixels[p1.X, p1.Y], fsSurface); 
  png.Canvas.Brush.Color := clLime; 
  png.Canvas.FloodFill(p2.X, p2.Y, png.Canvas.Pixels[p2.X, p2.Y], fsSurface); 
  Image2.Picture.Assign(png); 
  FreeAndNil(png); 
end; 

Zugriffe seit 6.9.2001 auf Delphi-Ecke