syst.inc

bmf汉字预览显示

{TMT Pascal version}
{$IFNDEF syst}
{$DEFINE syst}
type
  string8 =string[8];
  string11=string[11];
  string20=string[20];
  string80=string[80];
const
  ROM_TICKS    =$046C;
  ROM_KEYFLAGS =$0417;
  ROM_KEYSTATE =$0418;
  FLAGS_CARRY  =1 shl 0;
  FLAGS_ZERO   =1 shl 6;
  BUFSIZE      =4096;
  faREADONLY   =$01;
  faHIDDEN     =$02;
  faSYSTEM     =$04;
  faVOLUMEID   =$08;
  faDIRECTORY  =$10;
  faARCHIVE    =$20;
  faANYFILE    =faREADONLY or faHIDDEN or faSYSTEM or faVOLUMEID or faDIRECTORY or faARCHIVE;
  kfRIGHTSHIFT =1 shl 0;
  kfLEFTSHIFT  =1 shl 1;
  kfCTRL       =1 shl 2;
  kfALT        =1 shl 3;
  kfSCROLLLOCK =1 shl 4;
  kfNUMLOCK    =1 shl 5;
  kfCAPSLOCK   =1 shl 6;
  kfINSERT     =1 shl 7;
  kfLEFTCTRL   =1 shl 0;
  kfLEFTALT    =1 shl 1;
  kfSYSREQ     =1 shl 2;
  kfPAUSE      =1 shl 3;
  kfSCROLLHIT  =1 shl 4;
  kfNUMHIT     =1 shl 5;
  kfCAPSHIT    =1 shl 6;
  kfINSERTHIT  =1 shl 7;
  kfANYSHIFT   =kfRIGHTSHIFT or kfLEFTSHIFT;
  kfANYCTRL    =kfCTRL or kfLEFTCTRL;
  kfANYALT     =kfALT or kfLEFTALT;
  CR           =#13;
  LF           =#10;
  CRLF         =CR+LF;
  svga         :boolean=false;
  {$IFDEF useGFX}actGFX:boolean=false;{$ENDIF}
  {$IFDEF useUSS}actUSS:boolean=false;{$ENDIF}
  {$IFDEF usePCK}actPCK:boolean=false;{$ENDIF}
  {Error Codes}
  errOk                  =0;
  errVGANotSupported     =20;
  errVGAModeSet          =21;
  errVBENotDetected      =22;
  errVBE20Needed         =23;
  errVBECardMemory       =24;
  errVBEModeNotSupported =25;
  errVBEModeSet          =26;
  errUSSLoad             =30;
  errUSSInit             =31;
  errGIFImageOk          =0;
  errGIFBadFile          =41;
  errGIFBadGIFCode       =42;
  errGIFNotAGIFFile      =43;
  errGIFInvalidBlockSize =44;
  errGIFBadSymbolSize    =45;
  errGIFBadFirstGIFCode  =46;
  errGIFBadSeek          =47;
  errGIFBufferError      =48;
  errGIFImageTooBig      =49;
  errGIFUnknownError     =99;
  errPCKOpen             =60;
  errPCKLoad             =61;
  errPCKSeek             =62;
  errDPMI800             =50;
  errGetmem              =51;
  errBMFLoad             =52;
  errCycleH              =53;
  errModeByRes           =54;
  errParamsNeeded        =55;
  errFileNotExists       =56;
  errUnknownFormat       =57;
  errUnexpectedEOF       =58;
  errAbstractMethod      =211;
  errUserBreak           =255;
  WORDBREAKERS:set of char=[LF,CR,' ','$','%','&','(',')','*','+',',','-','.','/',':',';','<','=','>','[','\',']','{','|','}','~'];
  onoff:array[boolean] of string[3]=('Off','On');
{$IFNDEF __TMT__}
type smallint=integer;
{$ENDIF}

{$IFDEF useUSS}procedure CloseUSS; forward;{$ENDIF}
{$IFDEF usePCK}procedure ClosePCK; forward;{$ENDIF}
{$IFDEF useGFX}procedure CloseGFX; forward;{$ENDIF}
{$IFDEF usershutdown}procedure UserShutdown; forward;{$ENDIF}

procedure SetText;
var r:TRmRegs;
begin
  ClearRmRegs(r);
  with r do begin
    AX:=$1202;
    BL:=$30;
  end;
  RealModeInt($10,r);
  ClearRmRegs(r);
  r.AL:=$3;
  RealModeInt($10,r);
  ClearRmRegs(r);
  r.AX:=$1112;
  RealModeInt($10,r);
end;  {SetText}

function  keyPressed:boolean;
var r:TRmRegs;
begin
  ClearRmRegs(r);
  r.AH:=$0B;
  RealModeInt($21,r);
end;  {keyPressed}

function  readKey:char;
var r:TRmRegs;
begin
  ClearRmRegs(r);
  r.AH:=8;
  RealModeInt($21,r);
  result:=chr(r.AL);
end;  {readKey}

FUNCTION  hiWord(n:dword):word; assembler;
asm
  mov  eax,n
  shr  eax,16
end;  {hiWord}

FUNCTION  minW(x,y:word):word;assembler;
asm
  mov  bx,y
  mov  ax,x
  cmp  ax,bx
  jbe  @end
  xchg ax,bx
@end:
end;  {minW}

FUNCTION  maxW(x,y:word):word;assembler;
asm
  mov  bx,y
  mov  ax,x
  cmp  ax,bx
  jae  @end
  xchg ax,bx
@end:
end;  {maxW}

FUNCTION  minI(x,y:smallint):integer;assembler;
asm
  mov  bx,y
  mov  ax,x
  cmp  ax,bx
  jle  @end
  xchg ax,bx
@end:
end;  {minI}

FUNCTION  maxI(x,y:smallint):integer;assembler;
asm
  mov  bx,y
  mov  ax,x
  cmp  ax,bx
  jge  @end
  xchg ax,bx
@end:
end;  {maxI}

FUNCTION  minD(x,y:dword):longint;assembler;
asm
  mov  ebx,y
  mov  eax,x
  cmp  eax,ebx
  jbe  @end
  xchg eax,ebx
@end:
end;  {minD}

FUNCTION  maxD(x,y:dword):longint;assembler;
asm
  mov  ebx,y
  mov  eax,x
  cmp  eax,ebx
  jae  @end
  xchg eax,ebx
@end:
end;  {maxD}

FUNCTION  min(x,y:longint):longint;assembler;
asm
  mov  ebx,y
  mov  eax,x
  cmp  eax,ebx
  jle  @end
  xchg eax,ebx
@end:
end;  {min}

FUNCTION  max(x,y:longint):longint;assembler;
asm
  mov  ebx,y
  mov  eax,x
  cmp  eax,ebx
  jge  @end
  xchg eax,ebx
@end:
end;  {max}

FUNCTION  bi2By(w:word):word;inline($58/5/7/0/$c1/$e8/3);

FUNCTION  isIn(n,min,max:longint):boolean; assembler;
asm
  xor  edx,edx
  mov  eax,n
  cmp  eax,min
  jl   @false
  cmp  eax,max
  jg   @false
  inc  edx
@false:
  xchg eax,edx
end;  {isIn}

FUNCTION  bounded(n,min,max:longint):longint; assembler;
asm
  mov  eax,n
  cmp  eax,min
  jge  @1
  mov  eax,min
@1:
  cmp  eax,max
  jle  @2
  mov  eax,max
@2:
end;  {bounded}

FUNCTION  wrapped(n,min,max:longint):longint;
begin
 n:=(n-min) mod (max-min+1);
 if n<0 then wrapped:=n+max+1 else wrapped:=n+min;
end;  {wrapped}

FUNCTION  either(cond:boolean; res1,res2:longint):longint; assembler;
asm
  mov  al,cond
  cmp  al,false
  je   @res2
  mov  eax,res1
  jmp  @end
@res2:
  mov  eax,res2
@end:
end;  {either}

FUNCTION  eitherS(cond:boolean; const res1,res2:string):string; assembler;
asm
  mov  esi,res2
  mov  al,cond
  cmp  al,false
  je   @res2
  mov  esi,res1
@res2:
  mov  edi,result
  xor  eax,eax
  lodsb
  stosb
  xchg eax,ecx
  jecxz @end
  rep  movsb
@end:
end;  {eitherS}

FUNCTION  strToInt(st:string11):longint;
var check:word;
begin
  result:=0;
  val(st,result,check);
end;  {strToInt}

FUNCTION  strToIntDefault(st:string11;default:longint):longint;
var l:longint; check:word;
begin
  val(st,l,check);
  if check=0 then result:=l else result:=default;
end;  {strToIntDefault}

FUNCTION  intToStr(num:longint):string11;
begin
  str(num,result);
end;  {intToStr}

FUNCTION  rep(c:char;howmanytimes:byte):string; 
begin
  fillchar(result[1],howmanytimes,c);
  result[0]:=char(howmanytimes);
end;  {rep}

FUNCTION  pad(padchar:char;const what:string;len:integer):string;
begin
  result:='';
  if length(what)>len then exit;
  result:=rep(padchar,len-length(what))+what;
end;  {pad}

const PAD0CHAR:char='0';
FUNCTION  pad0(value:longint; digits:byte):string11;
var st:string11;
begin
  result:=Rep(PAD0CHAR,digits);
  if digits=0 then exit;
  str(Abs(value),st);
  if length(st)+byte(value<0)>digits then begin
    result:=Rep('#',digits);
    exit;
  end;
  move(st[1],result[1+digits-length(st)],length(st));
  if value<0 then result[1]:='-';
  if result='-' then result:='#';
end;  {pad0}

FUNCTION  lcased(s:string):string; assembler;
asm
  mov  esi,s
  mov  edi,@result
  xor  ecx,ecx
  mov  cl,[esi]
  movsb
  jecxz @end
@1:
  lodsb
  cmp  al,'A'
  jl   @2
  cmp  al,'Z'
  jg   @2
  add  al,'a'-'A'
@2:
  stosb
  loop @1
@end:
end;  {lcased}

function  hex(n:dword):string8; assembler;
asm
  mov  eax,8
  mov  ecx,n
  mov  edi,result
  stosb
  add  edi,eax
  dec  edi
  xchg eax,ecx
  sti
  std
@1:
  push ax
  and  al,0Fh
  cmp  al,9
  jbe  @2
  add  al,'A'-'9'-1
@2: