console.inc

bmf汉字预览显示

{$IFNDEF bboard}
{$DEFINE bboard}
{$I BUF2D.INC}
{$I BMFONT.INC}
type
  TConsole=object(TBuf2d)
    curx,cury:longint;
    font:PBMFont;
    fontmethod:dword;
    delay,flashing,toscroll:longint;
    Constructor init(_x,_y,_w,_h:longint; _font:PBMFont; _fontmethod:dword; _delay,_flashing:longint);
    Procedure gotoxy(_x,_y:longint);
    Procedure paint(color:byte); virtual;
    Procedure write(const s:string);
    Procedure writeln(const s:string);
    Procedure writexy(_x,_y:longint; const s:string);
    Procedure writec(c:dword;const s:string);
    Procedure hr;
    Procedure flashline; virtual;
  end;  {TConsole}

Constructor TConsole.init(_x,_y,_w,_h:longint; _font:PBMFont; _fontmethod:dword; _delay,_flashing:longint);
begin
  inherited init(_x,_y,_w,_h);
  gotoxy(0,0);
  font:=_font;
  fontmethod:=_fontmethod;
  delay:=_delay;
  flashing:=_flashing;
  toscroll:=0;
end;  {TConsole.init}

Procedure TConsole.gotoxy(_x,_y:longint);
begin
  curx:=_x;
  cury:=_y;
end;  {TConsole.gotoxy}

Procedure TConsole.paint(color:byte);
begin
  inherited paint(color);
  gotoxy(0,0);
end;  {TConsole.paint}

Procedure TConsole.write(const s:string);
begin
  if font=nil then exit;
  font^.gotoxy(curx,cury);
  font^.setup(@self,fontmethod,delay);
  font^.write(s);
  curx:=font^.curx;
  cury:=font^.cury;
end;  {TConsole.write}

Procedure TConsole.writeln(const s:string);
begin
  write(s);
  write(CRLF);
end;  {TConsole.writeln}

Procedure TConsole.writexy(_x,_y:longint; const s:string);
begin
  gotoxy(_x,_y);
  write(s);
end;  {TConsole.writexy}

Procedure TConsole.writec(c:dword;const s:string);
var oldc:dword;
begin
  oldc:=fontmethod;
  fontmethod:=c;
  write(s);
  fontmethod:=oldc;
end;  {TConsole.writec}

Procedure TConsole.hr;
begin
  if font=nil then exit;
  font^.gotoxy(curx,cury);
  font^.setup(@self,fontmethod,delay);
  flashline;
  quad(0,cury+font^.lineheight div 2,w,1,byte(ptr(fontmethod+4)^));
  font^.write(CRLF);
  curx:=font^.curx;
  cury:=font^.cury;
end;  {TConsole.hr}

Procedure TConsole.flashline;
const flashacc:longint=0;
var i:longint;
begin
  if font=nil then exit else if font^.lineheight<1 then exit;
  inc(toscroll);
  if toscroll>h div font^.lineheight then begin
    readkey;
    toscroll:=0;
  end;
  if flashing=0 then exit;
  for i:=0 to font^.lineheight shr 1 do begin
    quad(0,font^.cury,w,font^.lineheight,0);
    quad(0,font^.cury+i,w,font^.lineheight-i shl 1,byte(ptr(fontmethod+i shl 4 div font^.lineheight)^));
    pasteMeTo(@screen,x,y);
    if (memw[ROM_KEYFLAGS] and kfSCROLLLOCK=0) and (flashacc mod flashing=0) then waitticks(1);
    inc(flashacc);
  end;
  quad(0,font^.cury+font^.lineheight shr 1,w,1,0);
end;  {TConsole.flashline}
{$ENDIF}