Hallo Leute,
ich war für mich selber auf der Suche nach einem Floodfill für ein kleines Zeichenprogramm. Ich bin zwar auf viele nützliche Hinweise im Netz und auch hier im Forum gestoßen hab aber eigentlich nichts gefunden was ich verwenden konnte. Ein wertvoller Tipp war die Verwendung von OpBitmap und ScanLine. Jedenfalls hab ich mir Opbitmap1_7 runtergeladen und installiert. Rausgekommen ist ein relativ einfaches floodfill. Geht bestimmt viel besser und schneller, hab aber wie gesagt nichts fertiges gefunden und immerhin läuft es bei mir stabil. Für alle die es mal probieren möchten folgt ein kleines Demo-Programm und die Unit fuellen.
☺an alle Profis, bitte lasst etwas Nachsicht walten.
Demo Programm:
Code: Alles auswählen
unit unit1Fluten;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, Forms, Controls, Graphics, Dialogs,ExtCtrls,StdCtrls,fuellen;
type
{ TForm1 }
TForm1 = class(TForm)
Paintbox1 : TPaintbox;
StaticText1 : TStaticText;
Button1 : TButton;
StaticText2 : TStaticText;
procedure FormCreate(Sender: TObject);
procedure PaintboxPaint(Sender: TObject);
procedure waehle_die_fuellfarbe(Sender: TObject);
procedure MouseDown (Button:TMouseButton;Shift:TShiftState;x,y:integer);override;
procedure alles_loeschen(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1 : TForm1;
Shape : array of TShape;
FuellFarbe : TColor;
implementation
{$R *.lfm}
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
var lv : integer;
begin
Form1.Left := (Screen.Width div 2) - 400;
Form1.Top := 50;
Form1.Width := 800;
Form1.Height := 700;
Form1.Color := clgray;
Form1.Caption := 'Fluten';
Paintbox1 := TPaintbox.Create(self);
Paintbox1.Parent := Form1;
Paintbox1.Left := 0;
Paintbox1.Top := 0;
Paintbox1.Width := 800;
Paintbox1.Height := 600;
Paintbox1.OnPaint := @PaintboxPaint;
Paintbox1.OnMouseDown := TMouseEvent(@MouseDown);
StaticText1 := TStaticText.Create(self);
StaticText1.Parent := Form1;
StaticText1.Left := 10;
StaticText1.Top := 605;
StaticText1.Width := 240;
StaticText1.Height := 30;
StaticText1.Font.Name := 'Purisa';
StaticText1.Font.Color := clwhite;
StaticText1.Font.Height := 20;
StaticText1.Caption := 'Wähle die Füllfarbe:';
setlength(Shape,4);
for lv:= 0 to 3 do
begin
Shape[lv] := TShape.Create(self);
Shape[lv].Parent := Form1;
Shape[lv].Left := 10 + (60*lv);
Shape[lv].Top := 640;
Shape[lv].Width := 50;
Shape[lv].Height := 50;
if Lv=0 then Shape[lv].Brush.Color := cllime;
if Lv=1 then Shape[lv].Brush.Color := clblue;
if Lv=2 then Shape[lv].Brush.Color := clyellow;
if Lv=3 then Shape[lv].Brush.Color := clred;
Shape[lv].OnClick := @waehle_die_fuellfarbe;
end;
Button1 := TButton.Create(self);
Button1.Parent := Form1;
Button1.Left := 280;
Button1.Top := 660;
Button1.Width := 480;
Button1.Height := 30;
Button1.Font.Name := 'Purisa';
Button1.Font.Color := clblue;
Button1.Font.Height := 20;
Button1.Caption := 'Alles löschen';
Button1.OnClick := @alles_loeschen;
StaticText2 := TStaticText.Create(self);
StaticText2.Parent := Form1;
StaticText2.Left := 285;
StaticText2.Top := 610;
StaticText2.Width := 480;
StaticText2.Height := 30;
StaticText2.Font.Name := 'Purisa';
StaticText2.Font.Color := clwhite;
StaticText2.Font.Height := 18;
StaticText2.Caption := 'Klicke mit der Maus in die zufüllende Fläche!';
FuellFarbe:=clgreen;
end;
procedure TForm1.PaintboxPaint(Sender: TObject);
begin
Paintbox1.Canvas.Brush.Style := bssolid;
Paintbox1.Canvas.Brush.Color := clwhite;
Paintbox1.Canvas.Pen.Color := clwhite;
Paintbox1.Canvas.Rectangle(0,0,800,600);
Paintbox1.Canvas.Brush.Color := clAqua;
Paintbox1.Canvas.Pen.Color := clFuchsia;
Paintbox1.Canvas.Rectangle(10,10,100,150);
Paintbox1.Canvas.Brush.Color := clgray;
Paintbox1.Canvas.Pen.Color := clgray;
Paintbox1.Canvas.Ellipse(120,10,220,160);
Paintbox1.Canvas.Brush.Color := clSkyBlue;
Paintbox1.Canvas.Pen.Color := clblack;
Paintbox1.Canvas.RoundRect(250,10,450,150,10,10);
Paintbox1.Canvas.Pen.Color := clSkyBlue;
Paintbox1.Canvas.Line(500,10,650,10);
Paintbox1.Canvas.LineTo(575,150);
Paintbox1.Canvas.LineTo(500,10);
Paintbox1.Canvas.Pen.Color := clnavy;
Paintbox1.Canvas.Line(700,10,780,10);
Paintbox1.Canvas.LineTo(750,150);
Paintbox1.Canvas.LineTo(670,150);
Paintbox1.Canvas.LineTo(700,10);
Paintbox1.Canvas.Brush.Color := clPurple;
Paintbox1.Canvas.Pen.Color := clFuchsia;
Paintbox1.Canvas.Rectangle(10,180,400,590);
Paintbox1.Canvas.Brush.Color := clwhite;
Paintbox1.Canvas.Pen.Color := clolive;
Paintbox1.Canvas.RoundRect(450,180,780,590,20,20);
Paintbox1.Canvas.Rectangle(550,300,750,550);
Paintbox1.Canvas.Ellipse(500,250,600,400);
Paintbox1.Canvas.Line(450,180,780,590);
Paintbox1.Canvas.Line(450,320,780,320);
end;
procedure TForm1.waehle_die_fuellfarbe(Sender: TObject);
begin
if Sender = Shape[0] then FuellFarbe := cllime;
if Sender = Shape[1] then FuellFarbe := clblue;
if Sender = Shape[2] then FuellFarbe := clyellow;
if Sender = Shape[3] then FuellFarbe := clred;
end;
procedure TForm1.MouseDown (Button:TMouseButton;Shift:TShiftState;x,y:integer);
var Bmp1 : TBitmap;
recht : TRect;
StartPunkt : TPoint;
begin
Bmp1 := TBitmap.Create;
Bmp1.Width := Paintbox1.Width;
Bmp1.Height := Paintbox1.Height;
recht:=Rect(0,0,Paintbox1.Width,Paintbox1.Height);
Bmp1.Canvas.CopyRect(recht,Form1.Paintbox1.Canvas,recht);
StartPunkt.X:=x;
StartPunkt.Y:=y;
fluten(StartPunkt,FuellFarbe,Bmp1);
Paintbox1.Canvas.CopyRect(recht,Bmp1.Canvas,recht);
Bmp1.Free;
end;
procedure TForm1.alles_loeschen(Sender: TObject);
begin
Paintbox1.Invalidate;
end;
end.
Unit fuellen:
Code: Alles auswählen
unit fuellen;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,lclintf,Graphics,Dialogs,opbitmap,lazbridge;
type
TBereich = record
Punkt : TPoint;
Gechecked : boolean;
end;
Fuellbereich = array of TBereich;
procedure fluten(Startpunkt:TPoint;FuellFarbe:TColor;Bmp1:TBitmap);
function StFarbe(Startpunkt:TPoint):TColor;
procedure Check4(Checkpunkt:TPoint);
var Bereich : Fuellbereich;
Bmp2 : TCanvasOPBitmap;
varR,varG,varB : byte;
vR,vG,vB : byte;
i : integer;
StartFarbe : TColor;
Recht1 : TRect;
implementation
procedure fluten(Startpunkt:TPoint;FuellFarbe:TColor;Bmp1:TBitmap);
var lv : integer;
alle : boolean;
begin
bmp1.Width :=bmp1.Width+4;
bmp1.Height :=bmp1.Height+4;
bmp1.Canvas.Draw(1,1,bmp1);
Bmp2 := TCanvasOPBitmap.Create;
Bmp2.Width := Bmp1.Width;
Bmp2.Height := Bmp1.Height;
Bmp2.PixelFormat := pf24bit;
AssignBitmapToOpBitmap(Bmp1,Bmp2);
Bmp2.PixelFormat := pf24bit;
Recht1:=Rect(1,1,Bmp1.Width,Bmp1.Height);
vR:=getRvalue(Fuellfarbe);
vG:=getGvalue(Fuellfarbe);
vB:=getBvalue(Fuellfarbe);
Startfarbe:=StFarbe(StartPunkt);
if Startfarbe <> Fuellfarbe then
begin
i:=1;
setlength(Bereich,i+2);
Bereich[i].Punkt.X :=Startpunkt.X;
Bereich[i].Punkt.Y :=Startpunkt.Y;
Bereich[i].Gechecked := true;
Check4(StartPunkt);
repeat
alle:=true;
for lv:=1 to i do
begin
if Bereich[lv].Gechecked = false then
begin
Bereich[lv].Gechecked := true;
Check4(Bereich[lv].Punkt);
end;
end;
for Lv:=1 to i do
begin
if Bereich[lv].Gechecked = false then alle:=false;
end;
until (alle = true)or (lv>1500000) ;
AssignOpBitmapToBitmap(Bmp2,Bmp1);
end;
bmp1.Canvas.Draw(-1,-1,bmp1);
bmp1.Width :=bmp1.Width-4;
bmp1.Height :=bmp1.Height-4;
Bmp2.free;
end;
function StFarbe(Startpunkt:TPoint):TColor;
begin
varr:= PRGBTriple(Bmp2.ScanLine[StartPunkt.Y])[StartPunkt.X].rgbtRed;
varG:= PRGBTriple(Bmp2.ScanLine[StartPunkt.Y])[StartPunkt.X].rgbtGreen;
varB:= PRGBTriple(Bmp2.ScanLine[StartPunkt.Y])[StartPunkt.X].rgbtBlue;
StFarbe:=rgb(varR,varG,VarB);
PRGBTriple(Bmp2.ScanLine[Startpunkt.Y])[Startpunkt.X].rgbtRed := vr; //füllen
PRGBTriple(Bmp2.ScanLine[Startpunkt.Y])[Startpunkt.X].rgbtGreen := vg;
PRGBTriple(Bmp2.ScanLine[Startpunkt.Y])[Startpunkt.X].rgbtBlue := vb;
end;
procedure Check4(Checkpunkt:TPoint);
var x,y : integer;
Pixel : TColor;
NeuerPunkt : TPoint;
begin
x:= Checkpunkt.X;
y:= Checkpunkt.Y;
varr:= PRGBTriple(Bmp2.ScanLine[Y])[X+1].rgbtRed; //rechts scannen
varG:= PRGBTriple(Bmp2.ScanLine[Y])[X+1].rgbtGreen;
varB:= PRGBTriple(Bmp2.ScanLine[Y])[X+1].rgbtBlue;
Pixel:=rgb(varR,varG,VarB);
NeuerPunkt.X:=x+1;NeuerPunkt.Y:=y;
if (Pixel = StartFarbe) and (PtinRect(Recht1,NeuerPunkt)=true) then
begin
inc(i);
setlength(Bereich,i+1);
Bereich[i].Punkt.X :=x+1;
Bereich[i].Punkt.Y :=y;
Bereich[i].Gechecked := false;
PRGBTriple(Bmp2.ScanLine[Y])[X+1].rgbtRed := vr; //füllen
PRGBTriple(Bmp2.ScanLine[Y])[X+1].rgbtGreen := vg;
PRGBTriple(Bmp2.ScanLine[Y])[X+1].rgbtBlue := vb;
end;
varr:= PRGBTriple(Bmp2.ScanLine[Y+1])[X].rgbtRed; //unten scannen
varG:= PRGBTriple(Bmp2.ScanLine[Y+1])[X].rgbtGreen;
varB:= PRGBTriple(Bmp2.ScanLine[Y+1])[X].rgbtBlue;
Pixel:=rgb(varR,varG,VarB);
NeuerPunkt.X:=x;NeuerPunkt.Y:=y+1;
if (Pixel = StartFarbe) and (PtinRect(Recht1,NeuerPunkt)=true) then
begin
inc(i);
setlength(Bereich,i+1);
Bereich[i].Punkt.X :=x;
Bereich[i].Punkt.Y :=y+1;
Bereich[i].Gechecked := false;
PRGBTriple(Bmp2.ScanLine[Y+1])[X].rgbtRed := vr; //füllen
PRGBTriple(Bmp2.ScanLine[Y+1])[X].rgbtGreen := vg;
PRGBTriple(Bmp2.ScanLine[Y+1])[X].rgbtBlue := vb;
end;
varr:= PRGBTriple(Bmp2.ScanLine[Y])[X-1].rgbtRed; //links scannen
varG:= PRGBTriple(Bmp2.ScanLine[Y])[X-1].rgbtGreen;
varB:= PRGBTriple(Bmp2.ScanLine[Y])[X-1].rgbtBlue;
Pixel:=rgb(varR,varG,VarB);
NeuerPunkt.X:=x-1;NeuerPunkt.Y:=y;
if (Pixel = StartFarbe) and (PtinRect(Recht1,NeuerPunkt)=true) then
begin
inc(i);
setlength(Bereich,i+1);
Bereich[i].Punkt.X :=x-1;
Bereich[i].Punkt.Y :=y;
Bereich[i].Gechecked := false;
PRGBTriple(Bmp2.ScanLine[Y])[X-1].rgbtRed := vr; //füllen
PRGBTriple(Bmp2.ScanLine[Y])[X-1].rgbtGreen := vg;
PRGBTriple(Bmp2.ScanLine[Y])[X-1].rgbtBlue := vb;
end;
varr:= PRGBTriple(Bmp2.ScanLine[Y-1])[X].rgbtRed; //oben scannen
varG:= PRGBTriple(Bmp2.ScanLine[Y-1])[X].rgbtGreen;
varB:= PRGBTriple(Bmp2.ScanLine[Y-1])[X].rgbtBlue;
Pixel:=rgb(varR,varG,VarB);
NeuerPunkt.X:=x;NeuerPunkt.Y:=y-1;
if (Pixel = StartFarbe) and (PtinRect(Recht1,NeuerPunkt)=true) then
begin
inc(i);
setlength(Bereich,i+1);
Bereich[i].Punkt.X :=x;
Bereich[i].Punkt.Y :=y-1;
Bereich[i].Gechecked := false;
PRGBTriple(Bmp2.ScanLine[Y-1])[X].rgbtRed := vr; //füllen
PRGBTriple(Bmp2.ScanLine[Y-1])[X].rgbtGreen := vg;
PRGBTriple(Bmp2.ScanLine[Y-1])[X].rgbtBlue := vb;
end;
end;
end.