Browse Source

* Floodfill implemented

luk 22 years ago
parent
commit
c6092609bb
2 changed files with 634 additions and 4 deletions
  1. 19 1
      fcl/image/fppixlcanv.pp
  2. 615 3
      fcl/image/pixtools.pp

+ 19 - 1
fcl/image/fppixlcanv.pp

@@ -247,7 +247,25 @@ begin  //TODO: how to find a point inside the polygon ?
 end;
 
 procedure TFPPixelCanvas.DoFloodFill (x,y:integer);
-begin    //TODO
+begin
+  case Brush.style of
+    bsSolid : FillFloodColor (self, x,y);
+    bsPattern : FillFloodPattern (self, x,y, brush.pattern);
+    bsImage :
+      if assigned (brush.image) then
+        if FRelativeBI then
+          FillFloodImageRel (self, x,y, brush.image)
+        else
+          FillFloodImage (self, x,y, brush.image)
+      else
+        raise PixelCanvasException.Create (sErrNoImage);
+    bsDiagonal : FillFloodHashDiagonal (self, x,y, FHashWidth);
+    bsFDiagonal : FillFloodHashBackDiagonal (self, x,y, FHashWidth);
+    bsCross : FillFloodHashCross (self, x,y, FHashWidth);
+    bsDiagCross : FillFloodHashDiagCross (self, x,y, FHashWidth);
+    bsHorizontal : FillFloodHashHorizontal (self, x,y, FHashWidth);
+    bsVertical : FillFloodHashVertical (self, x,y, FHashWidth);
+  end;
 end;
 
 procedure TFPPixelCanvas.DoPolygon (const points:array of TPoint);

+ 615 - 3
fcl/image/pixtools.pp

@@ -14,7 +14,6 @@
 
  **********************************************************************}
 {$mode objfpc}{$h+}
-{$mode objfpc}{$h+}
 unit PixTools;
 
 interface
@@ -29,6 +28,14 @@ procedure FillRectangleHashHorizontal (Canv:TFPCustomCanvas; const rect:TRect; w
 procedure FillRectangleHashVertical (Canv:TFPCustomCanvas; const rect:TRect; width:integer; const c:TFPColor);
 procedure FillRectangleHashDiagonal (Canv:TFPCustomCanvas; const rect:TRect; width:integer; const c:TFPColor);
 procedure FillRectangleHashBackDiagonal (Canv:TFPCustomCanvas; const rect:TRect; width:integer; const c:TFPColor);
+procedure FillFloodColor (Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
+procedure FillFloodPattern (Canv:TFPCustomCanvas; x,y:integer; const pattern:TBrushPattern; const color:TFPColor);
+procedure FillFloodHashHorizontal (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+procedure FillFloodHashVertical (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+procedure FillFloodHashDiagonal (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+procedure FillFloodHashBackDiagonal (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+procedure FillFloodHashDiagCross (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+procedure FillFloodHashCross (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
 
 procedure DrawSolidLine (Canv : TFPCustomCanvas; x1,y1, x2,y2:integer);
 procedure DrawPatternLine (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer; Pattern:TPenPattern);
@@ -38,9 +45,19 @@ procedure FillRectangleHashHorizontal (Canv:TFPCustomCanvas; const rect:TRect; w
 procedure FillRectangleHashVertical (Canv:TFPCustomCanvas; const rect:TRect; width:integer);
 procedure FillRectangleHashDiagonal (Canv:TFPCustomCanvas; const rect:TRect; width:integer);
 procedure FillRectangleHashBackDiagonal (Canv:TFPCustomCanvas; const rect:TRect; width:integer);
+procedure FillFloodColor (Canv:TFPCustomCanvas; x,y:integer);
+procedure FillFloodPattern (Canv:TFPCustomCanvas; x,y:integer; const pattern:TBrushPattern);
+procedure FillFloodHashHorizontal (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+procedure FillFloodHashVertical (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+procedure FillFloodHashDiagonal (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+procedure FillFloodHashBackDiagonal (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+procedure FillFloodHashDiagCross (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+procedure FillFloodHashCross (Canv:TFPCustomCanvas; x,y:integer; width:integer);
 
 procedure FillRectangleImage (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer; const Image:TFPCustomImage);
 procedure FillRectangleImageRel (Canv:TFPCustomCanvas; x1,y1, x2,y2:integer; const Image:TFPCustomImage);
+procedure FillFloodImage (Canv:TFPCustomCanvas; x,y :integer; const Image:TFPCustomImage);
+procedure FillFloodImageRel (Canv:TFPCustomCanvas; x,y :integer; const Image:TFPCustomImage);
 
 implementation
 
@@ -213,7 +230,7 @@ begin
 end;
 
 type
-  TLinePoints = array[0..PatternBitCount] of boolean;
+  TLinePoints = array[0..PatternBitCount-1] of boolean;
   PLinePoints = ^TLinePoints;
 
 procedure PatternToPoints (const APattern:TPenPattern; LinePoints:PLinePoints);
@@ -315,7 +332,6 @@ var LinePoints : TLinePoints;
         end;
       end;
     end;
-var r : integer;
 begin
   PatternToPoints (pattern, @LinePoints);
   with canv.pen do
@@ -554,4 +570,600 @@ begin
         Canv.colors[x,y] := colors[(x-x1) mod width, (y-y1) mod height];
 end;
 
+type
+  TFuncSetColor = procedure (Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+
+  PDoneRec = ^TDoneRec;
+  TDoneRec = record
+    x, min, max : integer;
+    next : PDoneRec;
+  end;
+
+  PFloodFillData = ^TFloodFillData;
+  TFloodFillData = record
+    Canv : TFPCustomCanvas;
+    ReplColor : TFPColor;
+    SetColor : TFuncSetColor;
+    ExtraData : pointer;
+    DoneList : TList;
+  end;
+
+function FindDoneIndex (const data:PFloodFillData; x:integer; var index:integer):boolean;
+begin
+  with data^.DoneList do
+    begin
+    index := 0;
+    while (index < count) and (PDoneRec(items[index])^.x <> x) do
+      inc (index);
+    result := (index < count) and (PDoneRec(items[index])^.x = x);
+    end;
+end;
+
+procedure FreeDoneList (const data:TFloodFillData);
+  procedure FreeList (p:PDoneRec);
+  var n : PDoneRec;
+  begin
+    while assigned(p) do
+      begin
+      n := p^.Next;
+      dispose (p);
+      p := n;
+      end;
+  end;
+var r : integer;
+begin
+  with data do
+  for r := 0 to DoneList.Count-1 do
+    FreeList (PDoneRec(DoneList[r]));
+end;
+
+procedure CheckFloodFillColor (x,top,bottom,Direction:integer; data:PFloodFillData);
+
+  procedure CheckRange;
+  var r,t,b : integer;
+  begin
+    t := top;
+    b := top -1;
+    for r := top to bottom do
+      with data^ do
+        begin
+        if canv.colors[x,r] = ReplColor then
+          begin
+          b := r;
+          SetColor(Canv,x,r,ExtraData);
+          end
+        else
+          begin
+          if t < r then
+            CheckFloodFillColor (x+Direction, t, r-1, Direction, data);
+          t := r + 1;
+          end;
+        end;
+    if t <= b then
+      CheckFloodFillColor (x+Direction, t, b, Direction, data);
+  end;
+
+  procedure CheckAboveRange;
+  var t,b : integer;
+  begin
+    with data^ do
+      begin
+      t := top - 1;
+      while (t >= 0) and (Canv.colors[x,t]=ReplColor) do
+        begin
+        SetColor(Canv, x,t, ExtraData);
+        dec (t);
+        end;
+      t := t + 1;
+      b := top - 1;
+      if t <= b then
+        begin
+        CheckFloodFillColor (x-1, t, b, -1, data);
+        CheckFloodFillColor (x+1, t, b, 1, data);
+        end;
+      end;
+  end;
+
+  procedure CheckBelowRange;
+  var r,t,b : integer;
+  begin
+    with data^ do
+      begin
+      r := Canv.Height;
+      b := bottom + 1;
+      t := b;
+      while (b < r) and (Canv.colors[x,b]=ReplColor) do
+        begin
+        SetColor (Canv,x,b,ExtraData);
+        inc (b);
+        end;
+      b := b - 1;
+      if t <= b then
+        begin
+        CheckFloodFillColor (x-1, t, b, -1, data);
+        CheckFloodFillColor (x+1, t, b, 1, data);
+        end;
+      end;
+  end;
+
+var DoAbove, DoBelow : boolean;
+
+begin
+  with data^ do
+    begin
+    if (x >= Canv.width) or (x < 0) then
+      Exit;
+    if top < 0 then
+      top := 0;
+    if bottom >= Canv.Height then
+      bottom := Canv.Height-1;
+    DoAbove := (Canv.colors[x,top] = ReplColor);
+    DoBelow := (Canv.colors[x,bottom] = ReplColor);
+    end;
+  CheckRange;
+  if DoAbove then
+    CheckAboveRange;
+  if DoBelow then
+    CheckBelowRange;
+end;
+
+procedure CheckFloodFill (x,top,bottom,Direction:integer; data:PFloodFillData);
+var beforetop, ontop, chain, myrec : PDoneRec;
+    doneindex : integer;
+
+  procedure CheckRange;
+  var r,t,b : integer;
+      n : PDoneRec;
+  begin
+    ontop := nil;
+    beforetop := nil;
+    n := chain;
+    while (n <> nil) and (n^.min <= top) do
+      begin
+      beforetop := ontop;
+      ontop := n;
+      n := n^.next;
+      end;
+    if assigned(ontop) and (ontop^.max < top) then
+      begin
+      beforetop := ontop;
+      ontop := nil;
+      end;
+    // ontop is: nil OR rec before top OR rec containing top
+    if assigned(ontop) then
+      begin
+      t := ontop^.max + 1;
+      myrec := ontop;
+      end
+    else
+      begin
+      t := top;
+      new(myrec);
+      myrec^.x := x;
+      myrec^.min := top;
+      myrec^.max := top;
+      myrec^.Next := n;
+      if assigned(beforetop) then
+        beforetop^.next := myrec
+      else
+        begin
+        with data^.DoneList do
+          if DoneIndex < Count then
+            Items[DoneIndex] := myrec
+          else
+            Add (myrec);
+        chain := myrec;
+        end;
+      end;
+    ontop := myrec;
+    // ontop is rec containing the top
+    b := t-1;
+    r := t;
+    while (r <= bottom) do
+      begin
+      with data^ do
+        begin
+        if canv.colors[x,r] = ReplColor then
+          begin
+          b := r;
+          SetColor(Canv,x,r,ExtraData);
+          end
+        else
+          begin
+          if t < r then
+            begin
+            myrec^.max := r;
+            CheckFloodFill (x+Direction, t, r-1, Direction, data);
+            end;
+          t := r + 1;
+          end;
+        inc (r);
+        end;
+      if assigned(n) and (r >= n^.min) then
+        begin
+        if t < r then
+          begin
+          myrec^.max := n^.min-1;
+          CheckFloodFill (x+Direction, t, r-1, Direction, data);
+          end;
+        while assigned(n) and (r >= n^.min) do
+          begin
+          myrec := n;
+          r := myrec^.max + 1;
+          n := n^.next;
+          end;
+        t := r;
+        end;
+      end;
+    myrec^.max := r - 1;
+    if t <= b then
+      CheckFloodFill (x+Direction, t, b, Direction, data);
+  end;
+
+  procedure CheckAboveRange (highest:integer);
+  var t,b : integer;
+  begin
+    with data^ do
+      begin
+      t := top - 1;
+      while (t >= highest) and (Canv.colors[x,t]=ReplColor) do
+        begin
+        SetColor(Canv, x,t, ExtraData);
+        dec (t);
+        end;
+      t := t + 1;
+      b := top - 1;
+      if t <= b then
+        begin
+        ontop^.min := t - 1;
+        CheckFloodFill (x-1, t, b, -1, data);
+        CheckFloodFill (x+1, t, b, 1, data);
+        end;
+      end;
+  end;
+
+  procedure CheckBelowRange (lowest : integer);
+  var t,b : integer;
+  begin
+    with data^ do
+      begin
+      b := bottom + 1;
+      t := b;
+      while (b <= lowest) and (Canv.colors[x,b]=ReplColor) do
+        begin
+        SetColor (Canv,x,b,ExtraData);
+        inc (b);
+        end;
+      b := b - 1;
+      if t <= b then
+        begin
+        myrec^.max := b+1;
+        CheckFloodFill (x-1, t, b, -1, data);
+        CheckFloodFill (x+1, t, b, 1, data);
+        end;
+      end;
+  end;
+
+var DoAbove, DoBelow : boolean;
+    m : integer;
+begin
+  with data^ do
+    begin
+    if (x >= Canv.width) or (x < 0) then
+      Exit;
+    if top < 0 then
+      top := 0;
+    if bottom >= Canv.Height then
+      bottom := Canv.Height-1;
+    DoAbove := (Canv.colors[x,top] = ReplColor);
+    DoBelow := (Canv.colors[x,bottom] = ReplColor);
+    end;
+  if FindDoneIndex (data, x, DoneIndex) then
+    begin
+    chain := PDoneRec(data^.DoneList[DoneIndex]);
+    myrec := chain;
+    while assigned(myrec) do
+      with myrec^ do
+        myrec := next;
+    end
+  else
+    chain := nil;
+  CheckRange;
+  // ontop: rec containing top
+  // myrec: rec containing bottom
+  if DoAbove and (ontop^.min = top) then
+    begin
+    if assigned (beforetop) then
+      m := beforetop^.max + 1
+    else
+      m := 0;
+    CheckAboveRange (m);
+    end;
+  if DoBelow and (myrec^.max = bottom) then
+    begin
+    if assigned (myrec^.next) then
+      m := myrec^.next^.min - 1
+    else
+      m := data^.Canv.Height - 1;
+    CheckBelowRange (m);
+    end;
+end;
+
+procedure SetFloodColor (Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+begin
+  Canv.colors[x,y] := PFPColor(data)^;
+end;
+
+procedure FillFloodColor (Canv:TFPCustomCanvas; x,y:integer; const color:TFPColor);
+var d : TFloodFillData;
+begin
+  d.Canv := canv;
+  d.ReplColor := Canv.colors[x,y];
+  d.SetColor := @SetFloodColor;
+  d.ExtraData := @color;
+  CheckFloodFillColor (x, y, y, 1, @d);
+end;
+
+procedure FillFloodColor (Canv:TFPCustomCanvas; x,y:integer);
+begin
+  FillFloodColor (Canv, x, y, canv.brush.color);
+end;
+
+type
+  TBoolPlane = array[0..PatternBitCount-1] of TLinePoints;
+  TFloodPatternRec = record
+    plane : TBoolPlane;
+    color : TFPColor;
+  end;
+  PFloodPatternRec = ^TFloodPatternRec;
+
+procedure SetFloodPattern (Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+var p : PFloodPatternRec;
+begin
+  p := PFloodPatternRec(data);
+  if p^.plane[x mod PatternBitCount, y mod PatternBitCount] then
+    Canv.colors[x,y] := p^.color;
+end;
+
+procedure FillFloodPattern (Canv:TFPCustomCanvas; x,y:integer; const pattern:TBrushPattern; const color:TFPColor);
+var rec : TFloodPatternRec;
+    d : TFloodFillData;
+
+  procedure FillPattern;
+  var r : integer;
+  begin
+    for r := 0 to PatternBitCount-1 do
+      PatternToPoints (pattern[r], @rec.plane[r]);
+  end;
+
+begin
+  d.Canv := canv;
+  d.ReplColor := Canv.colors[x,y];
+  d.SetColor := @SetFloodPattern;
+  d.ExtraData := @rec;
+  d.DoneList := TList.Create;
+  try
+    FillPattern;
+    rec.color := Color;
+    CheckFloodFill (x, y, y, 1, @d);
+  finally
+    FreeDoneList (d);
+  end;
+end;
+
+procedure FillFloodPattern (Canv:TFPCustomCanvas; x,y:integer; const pattern:TBrushPattern);
+begin
+  FillFloodPattern (Canv, x, y, pattern, Canv.Brush.color);
+end;
+
+type
+  TFloodHashRec = record
+    color : TFPColor;
+    width : integer;
+  end;
+  PFloodHashRec = ^TFloodHashRec;
+
+procedure SetFloodHashHor(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+var r : PFloodHashRec;
+begin
+  r := PFloodHashRec(data);
+  if (y mod r^.width) = 0 then
+    Canv.colors[x,y] := r^.color;
+end;
+
+procedure SetFloodHashVer(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+var r : PFloodHashRec;
+begin
+  r := PFloodHashRec(data);
+  if (x mod r^.width) = 0 then
+    Canv.colors[x,y] := r^.color;
+end;
+
+procedure SetFloodHashDiag(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+var r : PFloodHashRec;
+    w : 0..PatternBitCount-1;
+begin
+  r := PFloodHashRec(data);
+  w := r^.width;
+  if ((x mod w) + (y mod w)) = (w - 1) then
+    Canv.colors[x,y] := r^.color;
+end;
+
+procedure SetFloodHashBDiag(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+var r : PFloodHashRec;
+    w : 0..PatternBitCount-1;
+begin
+  r := PFloodHashRec(data);
+  w := r^.width;
+  if (x mod w) = (y mod w) then
+    Canv.colors[x,y] := r^.color;
+end;
+
+procedure SetFloodHashCross(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+var r : PFloodHashRec;
+    w : 0..PatternBitCount-1;
+begin
+  r := PFloodHashRec(data);
+  w := r^.width;
+  if ((x mod w) = 0) or ((y mod w) = 0) then
+    Canv.colors[x,y] := r^.color;
+end;
+
+procedure SetFloodHashDiagCross(Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+var r : PFloodHashRec;
+    w : 0..PatternBitCount-1;
+begin
+  r := PFloodHashRec(data);
+  w := r^.width;
+  if ( (x mod w) = (y mod w) ) or
+     ( ((x mod w) + (y mod w)) = (w - 1) ) then
+    Canv.colors[x,y] := r^.color;
+end;
+
+procedure FillFloodHash (Canv:TFPCustomCanvas; x,y:integer; width:integer; SetHashColor:TFuncSetColor; const c:TFPColor);
+var rec : TFloodHashRec;
+    d : TFloodFillData;
+begin
+  d.Canv := canv;
+  d.ReplColor := Canv.colors[x,y];
+  d.SetColor := SetHashColor;
+  d.ExtraData := @rec;
+  d.DoneList := TList.Create;
+  rec.color := c;
+  rec.width := Width;
+  try
+    CheckFloodFill (x, y, y, 1, @d);
+  finally
+    FreeDoneList (d);
+  end;
+end;
+
+procedure FillFloodHashHorizontal (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+begin
+  FillFloodHash (canv, x, y, width, @SetFloodHashHor, c);
+end;
+
+procedure FillFloodHashHorizontal (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+begin
+  FillFloodHashHorizontal (Canv, x, y, width, Canv.Brush.color);
+end;
+
+procedure FillFloodHashVertical (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+begin
+  FillFloodHash (canv, x, y, width, @SetFloodHashVer, c);
+end;
+
+procedure FillFloodHashVertical (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+begin
+  FillFloodHashVertical (Canv, x, y, width, Canv.Brush.color);
+end;
+
+procedure FillFloodHashDiagonal (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+begin
+  FillFloodHash (canv, x, y, width, @SetFloodHashDiag, c);
+end;
+
+procedure FillFloodHashDiagonal (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+begin
+  FillFloodHashDiagonal (Canv, x, y, width, Canv.Brush.color);
+end;
+
+procedure FillFloodHashBackDiagonal (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+begin
+  FillFloodHash (canv, x, y, width, @SetFloodHashBDiag, c);
+end;
+
+procedure FillFloodHashBackDiagonal (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+begin
+  FillFloodHashBackDiagonal (Canv, x, y, width, Canv.Brush.color);
+end;
+
+procedure FillFloodHashDiagCross (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+begin
+  FillFloodHash (canv, x, y, width, @SetFloodHashDiagCross, c);
+end;
+
+procedure FillFloodHashDiagCross (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+begin
+  FillFloodHashDiagCross (Canv, x, y, width, Canv.Brush.color);
+end;
+
+procedure FillFloodHashCross (Canv:TFPCustomCanvas; x,y:integer; width:integer; const c:TFPColor);
+begin
+  FillFloodHash (canv, x, y, width, @SetFloodHashCross, c);
+end;
+
+procedure FillFloodHashCross (Canv:TFPCustomCanvas; x,y:integer; width:integer);
+begin
+  FillFloodHashCross (Canv, x, y, width, Canv.Brush.color);
+end;
+
+type
+  TFloodImageRec = record
+    xo,yo : integer;
+    image : TFPCustomImage;
+  end;
+  PFloodImageRec = ^TFloodImageRec;
+
+procedure SetFloodImage (Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+var r : PFloodImageRec;
+begin
+  r := PFloodImageRec(data);
+  with r^.image do
+    Canv.colors[x,y] := colors[x mod width, y mod height];
+end;
+
+procedure FillFloodImage (Canv:TFPCustomCanvas; x,y :integer; const Image:TFPCustomImage);
+var rec : TFloodImageRec;
+    d : TFloodFillData;
+begin
+  d.Canv := canv;
+  d.ReplColor := Canv.colors[x,y];
+  d.SetColor := @SetFloodImage;
+  d.ExtraData := @rec;
+  d.DoneList := Tlist.Create;
+  rec.image := image;
+  try
+    CheckFloodFill (x, y, y, 1, @d);
+  finally
+    FreeDoneList (d);
+  end;
+end;
+
+procedure SetFloodImageRel (Canv:TFPCustomCanvas; x,y:integer; data:pointer);
+var r : PFloodImageRec;
+    xi, yi : integer;
+begin
+  r := PFloodImageRec(data);
+  with r^, image do
+    begin
+    xi := (x - xo) mod width;
+    if xi < 0 then
+      xi := width - xi;
+    yi := (y - yo) mod height;
+    if yi < 0 then
+      yi := height - yi;
+    Canv.colors[x,y] := colors[xi,yi];
+    end;
+end;
+
+procedure FillFloodImageRel (Canv:TFPCustomCanvas; x,y :integer; const Image:TFPCustomImage);
+var rec : TFloodImageRec;
+    d : TFloodFillData;
+begin
+  d.Canv := canv;
+  d.ReplColor := Canv.colors[x,y];
+  d.SetColor := @SetFloodImageRel;
+  d.ExtraData := @rec;
+  d.DoneList := TList.Create;
+  rec.image := image;
+  rec.xo := x;
+  rec.yo := y;
+  try
+    CheckFloodFill (x, y, y, 1, @d);
+  finally
+    FreeDoneList (d);
+  end;
+end;
+
 end.