Re: Magic Wand

Subject:	Re: Magic Wand
Posted by:	Paul Nicholls (paul_nichol…@hotmail.NOSPAM.com)
Date:	Fri, 25 Jan 2008

"Finn Tolderlund" <no@spam.com> wrote in message
news:4798c9bf$…@newsgroups.borland.com...
> Or just search for "delphi floodfill" (without the " for better results)
> in google groups.
> There was an interesting discussion about floodfill in
> borland.public.delphi.graphics in 2003.
> --
> Finn Tolderlund
>
> "Andrew Jameson" <softspotsoftware…@SPAMgmail.com> skrev i meddelelsen
> news:479776…@newsgroups.borland.com...
>> Andrew Jameson wrote :
>>> There was a very good thread, maybe 3 years ago, that provided some much
>>> more efficient floodfill algorithms, one was very fast and did not use
>>> recursion - maybe someone has copies / links ?
>>
>> I think that this was the thread ... do a Google search in groups "delphi
>> floodfill Miklós Kiss"
>>
>> Andrew

Hi people,
  Below I have pasted a floodfill routine that I converted from an article
with C code online a while ago.
It doesn't use recursion, and also I have added in a tolerance for the
colours when doing the pixel comparisoms, similar to what Paint.NET uses.
The code below is for Graphics32, but could easily be adapted to other
systems...

Hope this helps :-)

Function  CheckColor(a,b: TColorBgra; tolerance: Integer): Boolean;
Var
    sum  : Integer;
    diff : Integer;
Begin
    sum := 0;

    diff := a.R - b.R;
    sum := sum + ((1 + diff * diff) * a.A) Div 256;
//    sum := sum + (1 + diff * diff) * a.A / 256;

    diff := a.G - b.G;
    sum := sum + ((1 + diff * diff) * a.A) Div 256;
//    sum := sum + (1 + diff * diff) * a.A / 256;

    diff := a.B - b.B;
    sum := sum + ((1 + diff * diff) * a.A) Div 256;
//    sum := sum + (1 + diff * diff) * a.A / 256;

    diff := a.A - b.A;
    sum := sum + diff * diff;

    Result := (sum <= tolerance * tolerance * 4);
End;
{.......................................................}

{.......................................................}
Const stackSize = 16777216;
Var
    stack: Array[0..stackSize - 1] Of Record
        x,y: Integer;
    End;
    stackPointer : Integer;
{.......................................................}

{.......................................................}
Function  pop(Var x,y: Integer): Boolean;
Begin
    if (stackPointer > 0) Then
    Begin
        x := stack[stackPointer].x;
        y := stack[stackPointer].y;
        Dec(stackPointer);
        Result := True;
    End
    Else
    Begin
        Result := False;
    End;
End;
{.......................................................}

{.......................................................}
Function  push(x,y: Integer): Boolean;
Begin
    if(stackPointer < stackSize - 1) Then
    Begin
        Inc(stackPointer);
        stack[stackPointer].x := x;
        stack[stackPointer].y := y;
        Result := True;
    End
    Else
    Begin
        Result := False;
    End;
End;
{.......................................................}

{.......................................................}
Procedure emptyStack;
Begin
    stackPointer := 0;
End;
{.......................................................}

{.......................................................}
Procedure DoFloodFill(Const ABitmap: TBitmap32; x,y: Integer;
NewColour,OldColour: TColorBgra; tolerance: Integer);
Var
    y1        : Integer; //note: if you use y here, we're working
vertically. This goes much faster in this case, because reading and writing
the buffer[x][y] goes faster if y is incremented/decremented
    spanLeft  : Boolean;
    spanRight : Boolean;
    w,h      : Integer;
    Function  ColourMatches(ax,ay: Integer; a: TColorBgra): Boolean;
    Var
        b: TColorBgra;
    Begin
        b.r := PColor32Entry(@ABitmap.Bits[ax + ay * w])^.R;
        b.g := PColor32Entry(@ABitmap.Bits[ax + ay * w])^.G;
        b.b := PColor32Entry(@ABitmap.Bits[ax + ay * w])^.B;
        b.a := PColor32Entry(@ABitmap.Bits[ax + ay * w])^.A;
        Result := CheckColor(a,b,tolerance);
    End;
    Procedure SetColour(ax,ay: Integer; a: TColorBgra);
    Begin
        PColor32Entry(@ABitmap.Bits[ax + ay * w])^.R := a.r;
        PColor32Entry(@ABitmap.Bits[ax + ay * w])^.G := a.g;
        PColor32Entry(@ABitmap.Bits[ax + ay * w])^.B := a.b;
        PColor32Entry(@ABitmap.Bits[ax + ay * w])^.A := a.a;
    End;
Begin
    emptyStack;
    if(Not push(x, y)) Then Exit;

    w := ABitmap.Width;
    h := ABitmap.Height;
    while(pop(x, y)) Do
    Begin
        y1 := y;
        while (y1 >= 0) And ColourMatches(x,y1,OldColour) Do Dec(y1);
        Inc(y1);
        spanLeft  := False;
        spanRight := False;
        while (y1 < h) And ColourMatches(x,y1,OldColour) Do
        Begin
            SetColour(x,y1,NewColour);
            if (Not spanLeft) And (x > 0) And
ColourMatches(x-1,y1,OldColour) Then
            Begin
                if(Not push(x - 1, y1)) Then Exit;
                spanLeft := True;
            End
            Else
            if spanLeft And (x > 0) And (Not ColourMatches(x -
1,y1,OldColour)) Then
            Begin
                spanLeft := False;
            End;
            if (Not spanRight) And (x < w - 1) And
ColourMatches(x+1,y1,OldColour) Then
            Begin
                if(Not push(x + 1, y1)) Then Exit;
                spanRight := True;
            End
            else
            if spanRight And (x < w - 1) And (Not
ColourMatches(x+1,y1,OldColour)) Then
            Begin
                spanRight := False;
            End;
            Inc(y1);
        End;
    End;
End;

cheers,
Paul

Replies

None

In response to

Re: Magic Wand posted by Finn Tolderlund on Thu, 24 Jan 2008