Canvas (Канва) - заливка фигуры произвольной формы

[Albenous]

Работаю с канвой (canvas) - не могу сделать нормальную заливку. Стандартный объект (прямоугольник, круг) заливает нормально, а фигуру произвольной формы - не хочет. Что мне делать? Заливать эту фигуру частями или есть какая-то функция, мне в помощь?
И вообще, тема про канву достаточно интересная, а в литературе раскрыта поверхностно. Обидно.

[BOBAH13]

наверное придется, писать алгоритм основываясь на массиве TPoint )) даже незнаю ) ...

хотя я точно сказать не могу, такого не делал, но посмотри на TCanvas.PolyBezier и TCanvas.PolyBezierTo ! чтот похожее нарно, хотя...

[Albenous]

ну неужели никто не рисовал на канве и с таким не сталкивался? Не верю. Заливка площали произвольной формы встречается довольно часто.

но посмотри на TCanvas.PolyBezier и TCanvas.PolyBezierTo

Что за оно? Поясни, пожалуйста.

[BOBAH13]

ну я не разбирался, просто посмотрел в книге ))) там описан единственный параметр это массив TPoint )) так что возможно оно, потестируй !

[Alar]

Самостоятельные функции пробовал писать? Мне кажеться это довольно интересно. запомнить место клика, если пиксели, которые рядом того же цвета, то закрасить и т.д. Также можно заливать и похожие цвета.

[zetrix]

Хм.. я думал что я не понял темы, но чем Вам не нравится процедура ?!

procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);

[Umen]

Вот попробуй эти методы если FloodFill не нравится.
параметры функций Flood и LineFlood:
X, Y - координаты начала заливки
Color - цвет заливки

function InRect(X, Y: integer): boolean;
begin
  if InRange(X, 0, Self.Width) and InRange(Y, 0, Self.Height) then
    result := true
  else
    result := false;
end;

// Простой но не очень корректный метод - 
// при большой оласти заливки вызывает переполнение стека
procedure Flood(X, Y: integer; Color: TColor);
begin
  if InRect(X, Y) then
    Self.Canvas.Pixels[x,y] := Color;
  if InRect(X + 1, Y) and (Self.Canvas.Pixels[X + 1, Y] <> Color) then
    Flood(X + 1, Y);
  if InRect(X - 1, Y) and (Self.Canvas.Pixels[X - 1, Y] <> Color) then
    Flood(X - 1, Y);
  if InRect(X, Y + 1) and (Self.Canvas.Pixels[X, Y + 1] <> Color) then
    Flood(X, Y + 1);
  if InRect(X, Y - 1) and (Self.Canvas.Pixels[X, Y - 1] <> Color) then
    Flood(X, Y-1);
end;

// Хороший, но не очень простой метод
// кстати он используеться в моей программе 
// JCEditor которая участвует на конкурсе программистов
procedure LineFlood(X, Y: integer; Color: TColor);
var
  J,
  BegX,
  EndX: integer;
  Col: integer;
  BColor: TColor;
begin
  BColor := Self.Canvas.Pixels[X, Y];
  Col := BColor;
  if Color = BColor then
    Exit;
  //Эти строчки нужно написать перед вызовом этой процедуры
  //чтобы они не повторялись каждый раз при рекурсивном вызове
  //Self.Canvas.Pen.Color := Color;
  //Self.Canvas.Brush.Color := Color;
  BegX := X;
  While (Col = BColor) and (BegX >= 0) do begin
    dec(BegX);
    if BegX >= 0 then
      Col := Self.Canvas.Pixels[BegX, Y];
    else
      Col := BColor + 1;
  end;
  Inc(BegX);
  EndX := X + 1;
  Col := Self.Canvas.Pixels[EndX, Y];
  While (Col = BColor) and (EndX <= Self.Width) do begin
    inc(EndX);
    if EndX <= Self.Width then
      Col := Self.Canvas.Pixels[EndX, Y]
    else
      Col := BColor + 1;
  end;
  Dec(EndX);

  //собственно рисование
  Self.Canvas.MoveTo(BegX, Y);
  Self.Canvas.LineTo(EndX, Y);
  if (Y > 0) then begin
    J := BegX;
    While J <= EndX do begin
      Col := Self.Canvas.Pixels[J, Y - 1];
      if (Col = BColor) then
        LineFlood(J, Y - 1);
      inc(J);
    end;
  end;
  if (Y > 0) and (Y < Self.Height) then begin
    J := BegX;
    While J <= EndX do begin
      Col := Self.Canvas.Pixels[J, Y + 1];
      if (Col = BColor) then
        LineFlood(J, Y + 1);
      inc(J);
    end;
  end;
end;

использование:

 Flood(10, 10, clBlack);

   Self.Canvas.Pen.Color := clBlack;
   Self.Canvas.Brush.Color := clBlack;
 LineFlood(10, 10, clBlack);

[Albenous]

Сообщение от zetrix

Хм.. я думал что я не понял темы, но чем Вам не нравится процедура ?!
procedure FloodFill(X, Y: Integer; Color: TColor; FillStyle: TFillStyle);

Да кто говорил, что не нравится? Я не знал о ее существовании, поэтому и создал тему.
пасиба, то, что нужно.
Тему не закраывайте - сюда еще много чего дописать можно.
P.S. Очень оценил старания umen`а. Тоже хорошо написано.

[Albenous]

Люди, подскажите, в чем может быть проблема: Закинул анимацию в dll и она перестала работать (В смысле рисунк стоит на месте).

{Анимация не gif, а то, что я рисовал на канве.}

[BOBAH13]

т.е. анимацию закинул ?! и что перестало работать ?