buf2d.inc

将bmf在DOS下显示出来

{$IFNDEF buf2d}
{$DEFINE buf2d}
{$I RECT.INC}
{$I VRAM.INC}
{$IFDEF fw}
 {$I FONT8.INC}
{$ENDIF}
const
  OUT_OF_BUF2D=0; {see getPoint()}
  FLOODFILLSTACKSIZE=64;
var
  floodfillstack:array[0..FLOODFILLSTACKSIZE-1] of TPosition;
  floodfillSP:longint:=0;
type
  PBuf2d=^TBuf2d;
  TBuf2d=object(TRect)
  private
    d:pointer;
    method:longint;
    Procedure flood2(_x,_y:TCoordinate; c1:byte);
  public
    Constructor init0;
    Constructor init(_x,_y,_w,_h:TCoordinate);
    Procedure clear; virtual;
    Procedure free; virtual;
    Procedure dim;
    Procedure redim;
    Procedure resize(_w,_h:TCoordinate); virtual;
    Procedure paint(color:byte); virtual;
    Function  load(var f:TStream):boolean; virtual;
    Function  save(var f:TStream):boolean; virtual;
    Procedure copyToMe(src:PRect); virtual;
    Function  empty:boolean; virtual;
    Function  at(_x,_y:TCoordinate):pointer; virtual;
    Function  atLine(_y:longint):pointer; virtual;
    Function  contains(_x,_y:TCoordinate):boolean; virtual;
    Function  getPoint(_x,_y:TCoordinate):byte;
    Procedure setPoint(_x,_y:TCoordinate;point:byte);
    Procedure xorPoint(_x,_y:TCoordinate;point:byte);
    Procedure addPoint(_x,_y:TCoordinate;point:byte);
    Procedure paintRow(_x,_y,_w:TCoordinate; c:byte);
    Procedure paintColumn(_x,_y,_h:TCoordinate; c:byte);
    Procedure quad(_x,_y,_w,_h:TCoordinate; c:byte);
    Procedure quad_(_x,_y,_w,_h:TCoordinate; c:byte);
    Procedure border(thickness,c1,c2:byte);
    Procedure line(x0,y0,x1,y1:TCoordinate; c:byte);
    Procedure turnRight; virtual;
    Procedure flipH;
    Procedure flipV;
    Procedure pasteInMe(_x,_y:TCoordinate;host:PBuf2d);
    Procedure pasteMeTo(dest:PBuf2d;_x,_y:TCoordinate);
    Procedure paste; virtual;
    Procedure cycleH(rel:longint);
    Procedure cycleV(rel:longint);
    Procedure shiftH(rel:longint);
    Procedure shiftV(rel:longint);
    Procedure replace(old,new:byte;swap:boolean);
    Procedure neg(n:byte);
    Procedure zoom2x;
    Procedure flood(_x,_y:TCoordinate; c1:byte);
    Procedure flashLine; virtual;
    {$IFDEF fw}
    Procedure fw(_x,_y:TCoordinate;s:string;color,f:byte);
    {$ENDIF}
    Destructor done; virtual;
  end;  {TBuf2d}

Constructor TBuf2d.init0;
begin
  x:=0; y:=0;
  w:=0; h:=0;
  d:=nil;
  method:=mtMovsd;
end;  {TBuf2d.init0}

Constructor TBuf2d.init(_x,_y,_w,_h:TCoordinate);
begin
  inherited init(_x,_y,_w,_h);
  dim;
  method:=mtMovsd;
end;  {TBuf2d.init}

Procedure TBuf2d.clear;
begin
  inherited clear;
  d:=nil;
end;  {TBuf2d.clear}

Procedure TBuf2d.free;
begin
  if not empty then freemem(d,contentSize);
  clear;
end;  {TBuf2d.free}

Procedure TBuf2d.dim;
begin
  if (w=0) or (h=0) then begin
    clear;
    exit;
  end;
  getmem(d,contentSize);
  if d=nil then clear else paint(0);
end;  {TBuf2d.dim}

Procedure TBuf2d.redim;
var _w,_h:TCoordinate;
begin
  _w:=w;
  _h:=h;
  free;
  init(x,y,_w,_h);
end;  {TBuf2d.redim}

Procedure TBuf2d.copyToMe(src:PRect);
begin
  free;
  if src=nil then exit;
  init(src^.x,src^.y,src^.w,src^.h);
  if typeof(src^)=typeof(TBuf2d) then
    if not PBuf2d(src)^.empty then move(PBuf2d(src)^.d^,d^,w*h);
end;  {TBuf2d.copyToMe}

Procedure TBuf2d.resize(_w,_h:TCoordinate);
var
  _d:pointer;
  j:longint;
begin
  if (_w=0) or (_h=0) then begin free; exit; end;
  getmem(_d,_w*_h);
  if _d=nil then die(errGetmem) else fillchar(_d^,_w*_h,0);
  if d<>nil then
    for j:=0 to Min(h,_h)-1 do
      move(atline(j)^,ptr(ofs(_d^)+j*_w)^,Min(w,_w));
  free;
  d:=_d;
  w:=_w;
  h:=_h;
end;  {TBuf2d.resize}

Procedure TBuf2d.paint(color:byte);
begin
  if not empty then fillchar(d^,contentSize,color);
end;  {TBuf2d.paint}

Function  TBuf2d.load(var f:TStream):boolean;
begin
  free;
  result:=true;
  f.readOrSkip(w,sizeof(w),result);
  f.readOrSkip(h,sizeof(h),result);
  dim;
  if not empty then result:=f.read(d^,contentSize) and result;
end;  {TBuf2d.load}

Function  TBuf2d.save(var f:TStream):boolean;
begin
  result:=true;
  f.writeOrSkip(w,sizeof(w),result);
  f.writeOrSkip(h,sizeof(h),result);
  if not empty then result:=f.write(d^,contentSize) and result;
end;  {TBuf2d.save}

Function  TBuf2d.empty:boolean;
begin
  if inherited empty then d:=nil;
  result:=(d=nil);
end;  {TBuf2d.empty}

Function  TBuf2d.contains(_x,_y:longint):boolean;
begin
  result:=inherited contains(_x,_y) and not empty;
end;  {TBuf2d.contains}

Function  TBuf2d.at(_x,_y:TCoordinate):pointer;
begin
  result:=nil;
  if empty or (_x<0) or (_x>=w) or (_y<0) or (_y>=h) then exit;
  result:=d;
  inc(result,_y*w+_x);
end;  {TBuf2d.at}

Function  TBuf2d.atLine(_y:TCoordinate):pointer;
begin
  if empty or (_y<0) or (_y>=h) then result:=nil
  else begin
    result:=d;
    inc(result,_y*w);
  end;
end;  {TBuf2d.atline}

Function  TBuf2d.getPoint(_x,_y:TCoordinate):byte;
var where:pointer;
begin
  where:=at(_x,_y);
  if where=nil then result:=OUT_OF_BUF2D else result:=byte(where^);
end;  {TBuf2d.getpoint}

Procedure TBuf2d.setPoint(_x,_y:TCoordinate; point:byte);
var where:pointer;
begin
  where:=at(_x,_y);
  if where<>nil then byte(where^):=point;
end;  {TBuf2d.setpoint}

Procedure TBuf2d.xorPoint(_x,_y:TCoordinate; point:byte);
var where:pointer;
begin
  where:=at(_x,_y);
  if where<>nil then byte(where^):=byte(where^) xor point;
end;  {TBuf2d.xorpoint}

Procedure TBuf2d.addPoint(_x,_y:TCoordinate; point:byte);
var where:pointer;
begin
  where:=at(_x,_y);
  if where<>nil then byte(where^):=byte(byte(where^)+point);
end;  {TBuf2d.addpoint}

Procedure TBuf2d.paintRow(_x,_y,_w:TCoordinate; c:byte);
var p:pointer;
begin
  if empty then exit;
  if (_y<0) or (_y>=h) or (_w<=0) or (_x+_w<=0) or (_x>=w) then exit;
  if _x<0 then begin
    inc(_w,_x);
    _x:=0;
  end;
  if _x+_w>w then _w:=w-_x;
  p:=at(_x,_y);
  if p<>nil then fillchar(p^,_w,c);
end;  {TBuf2d.paintRow}

Procedure TBuf2d.paintColumn(_x,_y,_h:TCoordinate; c:byte);
var
  p:pointer;
  j:integer;
begin
  if empty then exit;
  if (_x<0) or (_x>w) or (_h<=0) or (_y+_h<=0) or (_y>=h) then exit;
  if _y<0 then begin
    inc(_h,_y);
    _y:=0;
  end;
  if _y+_h>h then _h:=h-_y;
  p:=at(_x,_y);
  if p<>nil then
    for j:=0 to pred(_h) do begin
      byte(p^):=c;
      inc(p,w);
    end;
end;  {TBuf2d.paintColumn}

Procedure TBuf2d.quad(_x,_y,_w,_h:TCoordinate; c:byte);
var j:longint;
begin
  if empty then exit;
  if (_w<=0) or (_h<=0) or (_x+_w<=0) or (_y+_h<=0) or (_x>=w) or (_y>=h) then exit;
  for j:=Max(_y,0) to _y+pred(Min(h,_h)) do
    paintRow(_x,j,_w,c);
end;  {TBuf2d.quad}

Procedure TBuf2d.quad_(_x,_y,_w,_h:TCoordinate; c:byte);
begin
  paintRow(_x,_y,_w,c);
  paintRow(_x,pred(_y+_h),_w,c);
  paintColumn(_x,succ(_y),pred(pred(_h)),c);
  paintColumn(pred(_x+_w),succ(_y),pred(pred(_h)),c);
end;  {TBuf2d.quad_}

Procedure TBuf2d.border(thickness,c1,c2:byte);
var i:integer;
begin
  if empty or (thickness=0) then exit;
  i:=h; if w<h then i:=w;
  if thickness>i shr 1 then thickness:=i shr 1;
  quad(0,0,w,thickness,c1);
  quad(w-thickness,0,thickness,h,c2);
  quad(0,h-thickness,w,thickness,c2);
  quad(0,0,thickness,h,c1);
  if c1=c2 then exit;
  for i:=0 to thickness-1 do begin
    paintRow(i,pred(h)-i,thickness-i,c2);
    paintRow(w-thickness,i,thickness-i,c1);
  end;
end;  {TBuf2d.border}

procedure TBuf2d.line(x0,y0,x1,y1:TCoordinate; c:byte); {just the basic routine - no clipping}
var p,dx,dy,iy,ry,acc:TCoordinate;
begin
  if x1<x0 then begin
    dx:=x0; x0:=x1; x1:=dx;
    dy:=y0; y0:=y1; y1:=dy;
  end;
  if (x1<0) or (x0>=w) then exit;
  p:=y0*w+x0;
  dx:=y0; dy:=y1; if y1<y0 then begin dx:=y1; dy:=y0; end;
  if (dy<0) or (dx>=h) then exit;
  dx:=x1-x0; dy:=abs(y1-y0);
  iy:=1; ry:=w;
  if y1<y0 then begin iy:=-iy; ry:=-ry; end;
  acc:=dy; if dx>dy then acc:=dx; acc:=acc shr 1;
  if dx>dy then
    repeat
      if (x0>=0) and (x0<w) and (y0>=0) and (y0<h) then mem[ofs(d^)+p]:=c;
      if x0=x1 then break;
      inc(acc,dy);
      if acc>=dx then begin
        dec(acc,dx);
        inc(y0,iy);
        inc(p,ry);
      end;
      inc(x0); inc(p);
    until false
  else
    repeat
      if (x0>=0) and (x0<w) and (y0>=0) and (y0<h) then mem[ofs(d^)+p]:=c;
      if y0=y1 then break;
      inc(acc,dx);
      if acc>=dy then begin
        dec(acc,dy);
        inc(x0);