Ubuntu und Floodfill

Zur Vorstellung von Komponenten und Units für Lazarus

Ubuntu und Floodfill

Beitragvon wennerer » 20. Mär 2016, 21:10 Ubuntu und Floodfill

Floodfill, Ubuntu14.04, opbitmap1_7

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.
 
wennerer
 
Beiträge: 22
Registriert: 19. Mai 2015, 19:05
OS, Lazarus, FPC: Ubuntu 16.04, Lazarus 1.6, FPC 3.0.0 | 
CPU-Target: xxBit
Nach oben

• Themenende •

Zurück zu Units/Komponenten



Wer ist online?

Mitglieder in diesem Forum: 0 Mitglieder und 2 Gäste

porpoises-institution
accuracy-worried