freepascal.compiler/rtl/dos/ppi/fill.ppi

{
    $Id$
    This file is part of the Free Pascal run time library.
    Copyright (c) 1993,97 by the Free Pascal development team.

    See the file COPYING.FPC, included in this distribution,
    for details about the copyright.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.

 **********************************************************************}

procedure floodfill(x,y:integer; border:longint);

var bordercol     : longint;
    fillcol       : longint;
    viewport      : viewporttype;
    offset        : longint;
    
procedure fill(x,y:integer);
var start,ende,xx : integer;
    col           : longint;
 
begin  
  xx:=x; col:=getpixel(xx,y);
  if col=bordercol then exit;
  while (col<>bordercol) and (xx > viewport.x1) and (col<>fillcol)
    do begin
      xx:=xx-1; col:=getpixel(xx,y);
    end;
  start:=xx+1; 

  xx:=x+1; col:=getpixel(xx,y);
  while (col<>bordercol) and (xx < viewport.x2) and (col<>fillcol)
    do begin
      xx:=xx+1; col:=getpixel(xx,y);
    end;
  ende:=xx-1;

  patternline(start,ende,y);
  offset:=(y * _maxy + start) shr 8;
  
  if (y > viewport.y1)
  then begin
    xx:=start;
    repeat
      col:=getpixel(xx,y-1);
      if (col<>bordercol) and (col<>fillcol)
      then begin
        fill(xx,y-1);
        break;
      end;
      xx:=xx+1;
    until xx > ende;
  end;

  if (y > viewport.y1) 
  then begin
    xx:=start;
    repeat
      col:=getpixel(xx,y+1);
      if (col<>bordercol) and (col<>fillcol) then fill(xx,y+1);
      xx:=xx+1;
    until xx > ende;
  end;

end;

begin
  fillchar(buffermem^,buffersize,0);
  if aktviewport.clip then viewport:=aktviewport else viewport:=aktscreen;
  viewport.x2:=viewport.x2-viewport.x1;
  viewport.y2:=viewport.y2-viewport.y1;
  viewport.x1:=0;
  viewport.y1:=0;
  bordercol:=convert(border);            
  if BytesPerPixel=1
  then begin
    bordercol:=bordercol and $FF;
    fillcol:=aktfillsettings.color and $FF;
  end
  else begin
    bordercol:=bordercol and $FFFF;
    fillcol:=aktfillsettings.color and $FFFF;
  end;
  fill(x,y);
end;

procedure GetFillSettings(var Fillinfo:Fillsettingstype);
begin
  _graphresult:=grOk;
  if not isgraphmode then
    begin
      _graphresult:=grnoinitgraph;
      exit;
    end;
  Fillinfo:=aktfillsettings;
end;

procedure GetFillPattern(var FillPattern:FillPatternType);
begin
  _graphresult:=grOk;
  if not isgraphmode then
    begin
      _graphresult:=grnoinitgraph;
      exit;
    end;
  FillPattern:=aktfillpattern;
end;

procedure SetFillPattern(pattern : FillPatternType;color : longint);
begin
  _graphresult:=grOk;
  if not isgraphmode then
    begin
      _graphresult:=grnoinitgraph;
      exit;
    end;
  fillpattern[12]:=pattern;
  SetFillStyle(12,color);
end;

procedure SetFillStyle(pattern : word ;color : longint);
var i,j:Integer;
    mask:Byte;
begin
  _graphresult:=grOk;
  if not isgraphmode then
    begin
      _graphresult:=grnoinitgraph;
      exit;
    end;
    { g�ltige Paramter ? }
  if (pattern<0) or (pattern>12) then
    begin
      _graphresult:=grError;
      exit;
    end;
    { Muster laden }
  aktfillpattern:=fillpattern[pattern];
  aktfillsettings.pattern:=pattern;
  aktfillsettings.color:=convert(color);
  i:=1; j:=0;
  repeat
    mask:=$80;
      repeat
        if (aktfillpattern[i] and mask) = 0
          then PatternBuffer[j]:=aktbackcolor else PatternBuffer[j]:=aktfillsettings.color;
           mask:=mask shr 1;
           j:=j+1;
      until mask=0;
      i:=i+1;
  until i > 8;
end;

procedure GetLineSettings(var LineInfo : LineSettingsType);
begin
  _graphresult:=grOk;
  if not isgraphmode then
    begin
      _graphresult:=grnoinitgraph;
      exit;
    end;
  lineinfo:=aktlineinfo;
end;
{
  $Log$
  Revision 1.1  1998-03-25 11:18:42  root
  Initial revision

  Revision 1.3  1998/01/26 11:57:57  michael
  + Added log at the end


  
  Working file: rtl/dos/ppi/fill.ppi
  description:
  ----------------------------
  revision 1.2
  date: 1997/12/01 12:21:29;  author: michael;  state: Exp;  lines: +13 -1
  + added copyright reference in header.
  ----------------------------
  revision 1.1
  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;
  Initial revision
  ----------------------------
  revision 1.1.1.1
  date: 1997/11/27 08:33:51;  author: michael;  state: Exp;  lines: +0 -0
  FPC RTL CVS start
  =============================================================================
}