Алгоритм заливки

From

Yura Schapov (2:5012/28.18)

To

Alexey Syschikov

Date

2000-02-28T18:40:58Z

Area

RU.ALGORITHMS

Как поживаете, Alexey ?

 Мои бортовые системы запеленговали, что в Суббота Февраль 26 2000 16:57, Alexey Syschikov писал All:
 AS>     Кто-нить может чем-либо помочь с алгоритмом заливки? Т.е. нужен
 AS> алгоритм или хотя-бы идеи по этому поводу. Все равно, в виде алгоритма
 AS> или даже примера на каком-нить языке.
 AS>     Под заливкой подразумевается то, что делает Windows Paint. Он
 AS> закрашивает нужным цветом _одноцветную_ область.

Недавно пролетал и алгоритм и сорцы.
А вот еще один вариант... ;)

─── Тут начинается файл Floodfil.Pas ───
Program Flood_fill;
{Ничего не USES}
const
  MaxX=320;
  MaxY=200;
Procedure PutPixel(x,y:integer;color:byte); {PutPixel in 13h mode}
  begin mem[$A000:320*y+x]:=color; end;

Function GetPixel(x,y:integer):byte; {GetPixel in 13h mode}
 begin GetPixel:=mem[$A000:320*y+x]; end;

{> Algorithm from Shurik Maksimov 2:5030/601.19 }
{> Pseudocode ;) by Yura Schapov 2:5012/33.14 }
Procedure Fill(x,y:integer; empty, color:byte);
label 1,2,21,22,23,24,25,26,27,3;
{ buffer of 8k points cause to be more than enough for 320x200 }
const BufSize=8192;
var
  Buf : Record  { Initializing stack simulator ;) }
    n : Word; x,y : Array [0..BufSize] Of Word;
  End;
Procedure PushPoint (px, py : Integer);
Begin
  If (Buf.n<BufSize)
  and (px<MaxX) and (px>=0) and (py<MaxY) and (py>=0)
    then with Buf do begin x[n]:=px; y[n]:=py; Inc (n); end;
End;
Procedure PopPoint (Var px, py : Integer);
Begin
  If (Buf.n>0) then with Buf do begin Dec (n); px:=x[n]; py:=y[n]; end
  else begin px:=-1; py:=-1; End;
End;
Begin
{>1. Инициализация. Заносим точкy (x0,y0) в бyфеp Buf}
 1: Buf.n:=0; PushPoint(x,y);
{>2. Общий алгоpитм.}
{>2.1. Если Buf пyст, то пеpейти к 3.}
21:if (Buf.n=0) then goto 3;
{>2.2. Извлекаем точкy из Buf (x,y)}
22:PopPoint(x,y);
{>2.3. Если точка закpашена, то 2.1.}
23:if GetPixel(x,y)<>empty then goto 21;
{>2.4. Холостой пpобег до левой гpаницы (x0,y)}
24:while (x>0) and (GetPixel(x-1,y)=empty) do dec(x);
{>2.5. Помещаем точки (x0,y-1) и (x0,y+1) в Buf если они не закpашены}
25:if GetPixel(x,y-1)=empty then PushPoint(x,y-1);
   if GetPixel(x,y+1)=empty then PushPoint(x,y+1);
{>2.6. Движемся от левой гpаницы (x0,y) до пpавой гpаницы (x1,y) }
26:while (x<MaxX) and (GetPixel(x,y)=empty) do
   begin
{> пpи этом:
   >1) закpашиваем точки }
   PutPixel(x,y,color);
{>  2) помещаем в Buf точки (x,y+1) и (x,y-1) если они не закpашены, а
 > соседняя слева закpашена.}
   if (GetPixel(x,y+1)=empty) and (GetPixel(x-1,y+1)<>empty)
     then PushPoint (x,y+1);
   if (GetPixel(x,y-1)=empty) and (GetPixel(x-1,y-1)<>empty)
     then PushPoint (x,y-1);
   inc(x);
   end;
{>2.7. Пеpейти к 2.1.}
27:goto 21;
3:{>3. Завеpшение. Полyчили закpашеннyю область, конец.}
end;

Procedure Circle (xc, yc, r: Integer; c:byte);
{ Draw a circle with center (x_center,y_center) and radius 'radius' }
Var x, y, d : Integer;
Begin { bressenham circle algorithm using integer-only arithmetic }
  x:=0; y:=r; d:=2*(1-r);
  While y>=0 Do Begin
    PutPixel (xc+x,yc+y,c); PutPixel (xc+x,yc-y,c);
    PutPixel (xc-x,yc+y,c); PutPixel (xc-x,yc-y,c);
    If d+y>0 then Begin Dec (y); Dec (d,2*y+1); End;
    If x>d then Begin Inc (x); Inc (d,2*x+1); End;
  End;
End;

var i:integer;
BEGIN
  asm mov ax,13h; int 10h; end; {320x200x256 mode}

  {Area test}
  Circle(80,100,50,15);
  Circle(240,100,50,15);
  Fill(160,100,0,7);

  asm mov ax, 0c08h; int 21h; end; {readkey}
  fillchar(ptr($0a000,0)^,64000,0); {cls}

  for i:=0 to 20000 do PutPixel(Random(320),Random(200),15);{stack test}
  Fill(10,100,0,11);

  asm mov ax, 0c08h; int 21h; end; {readkey}
  asm mov ax,3; int 10h; end; {text mode}
END.




─── А здесь Floodfil.Pas кончается ───

                C уважением, Yura Schapov.
---
 * Origin: А если я нажму на эту кнопку?! (2:5012/28.18)