Własny FloodFill nie wypełnia całej figury

0

Witam.

Niby prosty algorytm, ale wypełnia mi tylko fragment figury.
Zaczynam od punktu 15,12, który jest wewnątrz prostokąta o narożnikach (10,10) i (20,20).

procedure flood_fill(pozycja: TPoint);
begin
     if (Form1.Canvas.Pixels[pozycja.X, pozycja.Y] <> clBlack) then
     begin
          Form1.Canvas.Pixels[pozycja.X, pozycja.Y] := clBlack;
          flood_fill(stos2.lewo(pozycja));
          flood_fill(stos2.prawo(pozycja));
          flood_fill(stos2.gora(pozycja));
          flood_fill(stos2.dol(pozycja));
     end;
end; 

 punkt.X := 15;
 punkt.Y := 12;

 flood_fill(punkt); 

Funkcje:

function TStos.lewo(element : TPoint):Tpoint;
begin
  element.X := element.X-1;
  element.Y := element.Y;
  Result := element;
end;

function TStos.prawo(element : TPoint):Tpoint;
begin
  element.X := element.X+1;
  element.Y := element.Y;
  Result := element;
end;

function TStos.gora(element : TPoint):Tpoint;
begin
  element.X := element.X;
  element.Y := element.Y-1;
  Result := element;
end;

function TStos.dol(element : TPoint):Tpoint;
begin
  element.X := element.X;
  element.Y := element.Y+1;
  Result := element;
end;   

Jak poprawić ten algorytm?

2

Nie wiem dlaczego u Ciebie nie działa prawidłowo - sprawdziłem poniższy kod u siebie pod Delphi7 i wszystko gra:

procedure TForm1.FloodFill(APosition: TPoint);
begin
  if Form1.Canvas.Pixels[APosition.X, APosition.Y] <> clBlack then
  begin
    Form1.Canvas.Pixels[APosition.X, APosition.Y] := clBlack;

    FloodFill(Point(APosition.X - 1, APosition.Y));
    FloodFill(Point(APosition.X + 1, APosition.Y));
    FloodFill(Point(APosition.X, APosition.Y - 1));
    FloodFill(Point(APosition.X, APosition.Y + 1));
  end;
end;

procedure TForm1.btnFloodFillClick(Sender: TObject);
begin
  FloodFill(Point(15, 12));
end;

Nie wiem po co Ci ten stos - przecież ta klasa robi zupełnie co innego; Poza tym niepotrzebnie używasz parametru jako TPoint - wygodniej będzie użyć dwóch parametrów liczbowych i wykluczyć przerzucanie obliczeń do innej klasy:

procedure TForm1.FloodFill(AX, AY: Integer);
begin
  if Form1.Canvas.Pixels[AX, AY] <> clBlack then
  begin
    Form1.Canvas.Pixels[AX, AY] := clBlack;

    FloodFill(AX - 1, AY);
    FloodFill(AX + 1, AY);
    FloodFill(AX, AY - 1);
    FloodFill(AX, AY + 1);
  end;
end;

procedure TForm1.btnFloodFillClick(Sender: TObject);
begin
  FloodFill(15, 12);
end;

Pamiętaj też, że taki algorytm jest niebezpieczny - nie wykonuje sprawdzenia, czy punkt faktycznie należy do kanwy formularza; No i trzeba też wspomnieć, że to najgorszy z możliwych algorytmów rozrostu ziarna - bardzo łatwo przepełnić stos, poza tym zabiera zbyt dużo pamięci, dlatego nie używa się go w praktyce;

No i zmiany wprowadzane za pomocą właściwości Pixels też są cholernie powolne - po każdym przypisaniu co najmniej zmieniony fragment zostaje odmalowany, co powoduje u mnie animację wypełniania.

0

"Bardzo łatwo przepełnić stos" - ale w którym miejscu wlasnie jest ten stos? U Ciebie wypelnia całą figurę?:) Zaraz przetestuję Twój kod.

3

"Bardzo łatwo przepełnić stos" - ale w którym miejscu wlasnie jest ten stos?

Przepełnienie stosu związane jest ze zbyt dużą liczbą wywołań rekurencyjnych metody wypełniającej; Każde wywołanie alokuje pamięć na stosie programu, a ten zbyt duży nie jest, więc wielkiej figury nie da się wypełnić bo dostaniesz wyjątek; Choć sam rozmiar stosu można ustawić we właściwościach projektu, to i tak ten algorytm jest do bani;

Istnieje kilka lepszych i nieco bardziej skomplikowanych implementacji, które nie używają rekurencji - wzamian korzystają z kolejki; One potrafią wypełnić bardzo duże powierzchnie, bo kolejka budowana jest na stercie, która ma nieporównywalnie większy rozmiar;

Tutaj są opisane różne sposoby wypełniania, są też gify ilustrujące techniki wypełniania obszarów - można poczytać;

U Ciebie wypelnia całą figurę?:)

Tak - wypełnia elegancko :]

0

Aha, dzieki za wyjasnienie:) Ja myslalam ze musze tworzyć stos :D Moja figura jest bardzo malutka, więc o przepełnieniu stosu nie ma mowy :D

Działa :D Dzięki!!!!!!!!!!:D

0

Funkcja Point zawarta jest w module Types - masz ten moduł dodany do listy w Uses?

1 użytkowników online, w tym zalogowanych: 0, gości: 1