Текущий архив: 2004.08.01;
Скачать: CL | DM;

Вниз

Заливка произвольной области   Найти похожие ветки 

← →
X-Disa ©   (2004-05-12 14:03) [0]

Я делаю заливку произвольной области на Bitmap по такому (рекурсивному)алгоритму:


Procedure FillPlace(Bitmap:TBitmap;X,Y:integer;Color:TColor);
Var OldColor:TCOlor;
Begin
 OldColor:=Bitmap.Canvas.Pixels[X,Y];
 if OldColor<>Color then fillcol(Bitmap,X,Y,Color,OldCOlor);
End;

Procedure FillRow(Bitmap:TBitmap;X,Y:integer;Color,OldColor:TColor);
Begin
 if (Bitmap.Canvas.Pixels[X,Y]=OldColor)and(x<=Bitmap.Width)and(x>=0) then begin
    Bitmap.Canvas.Pixels[X,Y]:=color;
    fillcol(Bitmap,x-1,y,Color,OldCOlor);
    fillcol(Bitmap,x+1,y,Color,OldCOlor);
 end;
End;

Procedure FillCol(Bitmap:TBitmap;X,Y:integer;Color,OldColor:TColor);
Begin
 if (Bitmap.Canvas.Pixels[X,Y]=OldCOlor)and(y>=0)and(y<=Bitmap.Height) then begin
    Bitmap.Canvas.canvas.Pixels[X,Y]:=color;
    fillrow(Bitmap,x,y+1,Color,OldCOlor);
    fillrow(Bitmap,x,y-1,Color,OldCOlor);
 End;
End;
Для заливки в процедуре FillPlace указываются координаты X Y и цвет, которым заливать. Проблема в том, что при заливке больших областей происходит переполнение стека. Может есть какой нибудь другой алгоритм?

---

← →
Думкин ©   (2004-05-12 14:07) [1]

Есть.
Canvas.FloodFill()

---

← →
X-Disa ©   (2004-05-12 14:16) [2]

Нет, это не совсем то. Flood Fill заливает всю область, даже если она не одноцветная. А мне нужно: Если есть например область белого цвета с произвольной границей (не обязательно одноцветной), должна закраситься только белая область.

---

← →
Mihey ©   (2004-05-12 17:35) [3]

FloodFill(X, Y, clWhite, fsSurface);

---

← →
X-Disa ©   (2004-05-13 14:48) [4]

Я поставил это на OnMouseDown в TImage, цвет заливки clRed, но что то не работает. Проверил на разных фигурах (Одноцветная заливка)

---

← →
Mihey ©   (2004-05-13 15:13) [5]

То же самое сделал - работает:


unit Unit1;

interface

uses
 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
 TmainForm = class(TForm)
   procedure FormCreate(Sender: TObject);
   procedure FormDestroy(Sender: TObject);
   procedure FormPaint(Sender: TObject);
   procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
     Shift: TShiftState; X, Y: Integer);
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 mainForm: TmainForm;
 Bmp: TBitmap;

implementation

{$R *.DFM}

procedure TmainForm.FormCreate(Sender: TObject);
begin
 Bmp := TBitmap.Create;
 Bmp.Width := 300;
 Bmp.Height := 200;
 With Bmp.Canvas do
  begin
   Pen.Color := clBlack;
   Brush.Color := clBlue;
   FillRect(Rect(0, 0, Bmp.Width, Bmp.Height));
   Pen.Color := clWhite;
   Brush.Color := clWhite;
   Ellipse(Rect(0+30, 0+30, Bmp.Width-30, Bmp.Height-30));
  end;
end;

procedure TmainForm.FormDestroy(Sender: TObject);
begin
 Bmp.Free;
end;

procedure TmainForm.FormPaint(Sender: TObject);
begin
 BitBlt(Canvas.Handle, 0, 0, Bmp.Width, Bmp.Height, Bmp.Canvas.Handle, 0, 0, SrcCopy);
end;

procedure TmainForm.FormMouseDown(Sender: TObject; Button: TMouseButton;
 Shift: TShiftState; X, Y: Integer);
begin
 If (X < Bmp.Width) and (Y < Bmp.Height) then
  begin
   Bmp.Canvas.Brush.Color := clYellow;
   Bmp.Canvas.FloodFill(X, Y, clWhite, fsSurface);
  end;
 Invalidate;
end;

end.


---

← →
Mihey ©   (2004-05-13 15:15) [6]

Наверное, ты путаешь что-то с параметрами. В FloodFill нужно указывать цвет поверхности, которая будет залита цветом, установленным в Brush.Color.

---

← →
X-Disa ©   (2004-05-13 15:36) [7]

Спасибо, теперь работает!

---

Страницы: 1 вся ветка

Текущий архив: 2004.08.01;
Скачать: CL | DM;

Наверх

Память: 0.48 MB
Время: 0.052 c