home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / graphics.swg / 0070_Flood Filling.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-01-27  |  1.5 KB  |  52 lines
  1. {
  2. > Does anyone have any code to flood fill an area? I need the code to do
  3. > both, a fill to a certain border colour, or a fill to ANY
  4. > colour other then the one the fill started on.
  5. }
  6.  
  7. var fillVal:byte;
  8. {This routine only called by fill}
  9. function lineFill(x,y,d,prevXL,prevXR:integer):integer;
  10.  var xl,xr,i:integer;
  11. begin
  12.  xl:=x;xr:=x;
  13.  repeat dec(xl); until(scrn(xl,y)<>fillVal)or(xl<0); inc(xl);
  14.  repeat inc(xr); until(scrn(xr,y)<>fillVal)or(xr>xMax); dec(xr);
  15.  hLin(xl,xr,y);
  16.  inc(y,d);
  17.  if word(y)<=yMax then
  18.   for x:=xl to xr do
  19.    if(scrn(x,y)=fillVal)then begin
  20.     x:=lineFill(x,y,d,xl,xr);
  21.     if word(x)>xr then break;
  22.     end;
  23.  dec(y,d+d); asm neg d;end;
  24.  if word(y)<=yMax then begin
  25.   for x:=xl to prevXL do
  26.    if(scrn(x,y)=fillVal)then begin
  27.     i:=lineFill(x,y,d,xl,xr);
  28.     if word(x)>prevXL then break;
  29.     end;
  30.   for x:=prevXR to xr do
  31.    if(scrn(x,y)=fillVal)then begin
  32.     i:=lineFill(x,y,d,xl,xr);
  33.     if word(x)>xr then break;
  34.     end;
  35.   end;
  36.  lineFill:=xr;
  37.  end;
  38.  
  39. procedure fill(x,y:integer);begin
  40.  fillVal:=scrn(x,y);if fillVal<>color then lineFill(x,y,1,x,x);
  41.  end;
  42.  
  43. {
  44. This one's too recursive for anything really complicated (blows the stack). But
  45. it works. You'll find that making it do a border fill instead isn't hard at
  46. all. You'll need to provide your own hLin and scrn routines.
  47.  
  48. hLin draws a horizontal line from X,to X2,at Y scrn reads the pixel at X,Y and
  49. returns its color color is a global byte variable in this incarnation. The fill
  50. happens in this color.
  51. }
  52.