{***************************************************************}
{***               FVision Unit Version1.0                   ***}
{***                    蓝蚂蚁工作室                         ***}
{***************************************************************}
{***                      工具单元                           ***}
{***************************************************************}
{$O+,F+,X+,I-}
Unit FTool;
Interface
Uses Dos,Crt;

Type
  St5=string[5];

Function  FName(S:PathStr):PathStr;
Function  FPath(S:PathStr):PathStr;
Function  ExePath: PathStr;
Function  ExeName: NameStr;
Function  Ch_Name(S:PathStr;E:ExtStr):PathStr;
Procedure ChangePath(PathName:PathStr);
Procedure ClearKbBuf;
Function  Int_Str(Int:LongInt;Size:Integer):string;
Function  IntStr(Int:LongInt):string;
Function  StrsInt(S:string):LongInt;
Function  ReaStr(Rea:Real;Wei:Integer):string;
Function  StrReal(S:string):Real;
Function  Hexs(N:Byte):St5;
Function  HexStr(Number: Word): ST5;
Function  StrHex(S:string):LongInt;
Function  GetLength(S:string):Integer;
Function  PosIn(PosX,PosY,X1,Y1,X2,Y2:Integer):Boolean;
Function  UpCases(S:string):string;
Function  UpCaseStr(var S:string):string;
Function  Exist_Fi(FullFileName:string):Boolean;
Procedure ReNameFile(Name,NewName:PathStr);
Procedure DeleteFile(Name:PathStr);
Procedure SetKbRate(Rate,Delay:Byte);
Function  InsSpace(var S:string;Len:Byte):string;
Function  InsNull(var S:string;Len:Byte):string;
Function  InsSpaceFront(var S:string;Len:Byte):string;
Function  DelSpace(var S:string):string;
Function  DelNull(var S:string):string;
Function  DelSpaceTail(var S:string):string;
Function  GetBuMa(Yu:Integer):Integer;
Function  IsImdNum(S:string):Boolean;
Function  Max(X,Y:Longint):Longint;
Function  Min(X,Y:Longint):Longint;
Procedure SwapInt(var X:Integer;var Y:Integer);
Implementation

Const
  Hex : array[0..15] of Char =
   ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');

Function FName(S:PathStr): PathStr;
var
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  FSplit(S, Dir, Name, Ext);
  FName := Name + Ext;
end;

Function FPath(S:PathStr): PathStr;
var
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  FSplit(S, Dir, Name, Ext);
  if Dir[Length(Dir)] <> '\' then Dir:=Dir+'\';
  FPath := Dir;
end;

Function ExePath: PathStr;
var
  EXEName: PathStr;
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  if Lo(DosVersion) >= 3 then EXEName := ParamStr(0);
  FSplit(EXEName, Dir, Name, Ext);
  if Dir[Length(Dir)] <> '\' then Dir:=Dir+'\';
  ExePath := Dir;
end;

Function ExeName: NameStr;
var
  EXEName: PathStr;
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  if Lo(DosVersion) >= 3 then EXEName := ParamStr(0);
  FSplit(EXEName, Dir, Name, Ext);
  ExeName := Name;
end;

Function Ch_Name(S:PathStr;E:ExtStr): PathStr;
var
  Dir: DirStr;
  Name: NameStr;
  Ext: ExtStr;
begin
  FSplit(S, Dir, Name, Ext);
  Ch_Name:=Dir+Name+'.'+E;
end;

Procedure ChangePath(PathName:PathStr);
var
  D: DirStr;
  N: NameStr;
  E: ExtStr;
begin
  PathName := FExpand(PathName);
  FSplit(PathName, D, N, E);
  if D[Length(D)]='\' then Dec(D[0]);
  Chdir(D);
end;

Procedure  ClearKbBuf;
begin
  while KeyPressed do Readkey;
end;

Function  Int_Str(Int:LongInt;Size:Integer):string;
var
  Cha:LongInt;
  StrI:string;
  Fu:Boolean;
begin
  StrI:='';
  Fu:=False;
  if Int<0 then
  begin
    Int:=(-Int);
    Fu:=True;
  end;
  while Int>9 do
  begin
    Cha:=Int mod 10;
    StrI:=Chr(Cha+Ord('0'))+StrI;
    Int:=Int div 10;
  end;
  StrI:=Chr(Int+Ord('0'))+StrI;
  while (Byte(StrI[0])<Size) do
    StrI:='0'+StrI;
  if Fu then StrI:='-'+StrI;
  Int_Str:=StrI;
end;

Function  IntStr(Int:LongInt):string;
var
  Cha:LongInt;
  StrI:string;
  Fu:Boolean;
begin
  StrI:='';
  Fu:=False;
  if Int<0 then
  begin
    Int:=(-Int);
    Fu:=True;
  end;
  while Int>9 do
  begin
    Cha:=Int mod 10;
    StrI:=Chr(Cha+Ord('0'))+StrI;
    Int:=Int div 10;
  end;
  StrI:=Chr(Int+Ord('0'))+StrI;
  if Fu then StrI:='-'+StrI;
  IntStr:=StrI;
end;

Function  UpCases(S:string):string;
var
  i:Byte;Ss:string;
begin
  Ss:='';
  for i:=1 to Length(S) do
  Ss:=Ss+UpCase(S[i]);
  UpCases:=Ss;
end;

Function UpCaseStr(var S:string):string;
var
  i:Byte;
begin
  for i:=1 to Length(S) do
  S[i]:=UpCase(S[i]);
  UpCaseStr:=S;
end;

Function StrsInt(S:string):LongInt;
var
  i,Wei:Integer;
  Int:LongInt;
  HexFlag,MinusFlag:Boolean;
begin
  Int:=0;
  HexFlag:=False;
  MinusFlag:=False;
  UpCaseStr(S);
  if S[1]='-' then MinusFlag:=True;
  if S[Length(S)]='H' then HexFlag:=True;
  if HexFlag then Wei:=16 else Wei:=10;
  for i:=1 to Byte(S[0]) do
  if S[i] in ['0'..'9'] then
    Int:=Int*Wei+Ord(S[i])-Ord('0')
  else if (S[i] in ['A'..'F']) and HexFlag then
         Int:=Int*Wei+Ord(S[i])-Ord('A')+10;
  if MinusFlag then Int:=-Int;
  StrsInt:=Int;
end;

Function  ReaStr(Rea:Real;Wei:Integer):string;
var
  St1,St2:string;
begin
  St1:=IntStr(Trunc(Rea));
  St2:=IntStr(Trunc((Rea-Trunc(Rea))*Wei));
  ReaStr:=St1+'.'+St2;
end;

Function StrReal(S:string):Real;
var
  Temp:Real;
  Code:Integer;
begin
  Val(S,Temp,Code);
  StrReal:=Temp;
end;

Function HexStr(Number: Word): ST5;
    Function Hex_Char(Number: Word): Char;
    Begin
      If Number<10 then
        Hex_Char:=Char(Number+48)
      else
        Hex_Char:=Char(Number+55);
    end; { Function Hex_Char }

Var
  S: ST5;
Begin
    S:='';
    S:=Hex_Char( (Number shr 1) div 2048);
    Number:=( ((Number shr 1) mod 2048) shl 1)+
            (Number and 1) ;
    S:=S+Hex_Char(Number div 256);
    Number:=Number mod 256;
    S:=S+Hex_Char(Number div 16);
    Number:=Number mod 16;
    S:=S+Hex_Char(Number);
    HexStr:=S+'H';
end; { Function Hex_string }

Function  StrHex(S:string):LongInt;
var
  i,j:Byte;
  He:LongInt;
begin
  if UpCase(S[Length(S)])<>'H' then
  begin
    StrHex:=StrsInt(S);
    Exit;
  end;
  He:=0;
  for j:=1 to Length(S)-1 do
  for i:=0 to 15 do
  if UpCase(S[j])=Hex[i] then He:=He shl 4 + i;
  StrHex:=He;
end;

Function GetLength(S:string):Integer;
var
  Len,i:Integer;
begin
  Len:=0;
  for i:=1 to Length(S) do
  if S[i]<>'~' then Inc(Len);
  GetLength:=Len;
end;

Function PosIn(Posx,Posy,x1,y1,x2,y2:Integer):Boolean;
begin
  PosIn:=False;
  if (Posx>=x1)and(Posx<=x2)and(Posy>=y1)and(Posy<=y2) then PosIn:=True;
end;

Function Exist_Fi(FullFileName:string):Boolean;
var
  FileInfor:SearchRec;
  Attr:Byte;
begin
  Attr:=ReadOnly+Hidden+SysFile+Archive;
  FindFirst(FullFileName,Attr,FileInfor);
  Exist_Fi:=DosError=0;
end;

Procedure ReNameFile(Name,NewName:PathStr);
var
  F:file;
begin
  if not Exist_Fi(Name) then Exit;
  if Exist_Fi(NewName) then
  begin
    Assign(F,NewName);
    Erase(F);
  end;
  Assign(F,Name);
  ReName(F,NewName);
end;

Procedure DeleteFile(Name:PathStr);
var
  F:file;
begin
  if Exist_Fi(Name) then
  begin
    Assign(F,Name);
    Erase(F);
  end;
end;

Procedure SetKbRate(Rate,Delay:Byte);
var
  R:Registers;
begin
  R.ax:=$0305;
  R.bh:=rate;
  R.bl:=delay;
  Intr($16,R);
end;

Function Hexs(N:Byte):St5;
begin
  Hexs:=Hex[N div 16]+Hex[N mod 16];
end;

Function InsSpace(var S:string;Len:Byte):string;
var
  i:Integer;
begin
  for i:=Length(S)+1 to Len do
  S:=S+' ';
  InsSpace:=S;
end;

Function InsNull(var S:string;Len:Byte):string;
var
  i:Integer;
begin
  for i:=Length(S)+1 to Len do
  S:=S+#0;
  InsNull:=S;
end;

Function InsSpaceFront(var S:string;Len:Byte):string;
var
  i:Integer;
begin
  for i:=Length(S)+1 to Len do
  S:=' '+S;
  InsSpaceFront:=S;
end;

Function DelSpace(var S:string):string;
var
  i:Integer;
begin
  i:=0;
  while (i<Length(S))and(S[i+1]=' ') do Inc(i);
  Delete(S,1,i);
  i:=Length(S)+1;
  while (i>1)and(S[i-1]=' ') do Dec(i);
  Delete(S,i,Length(S)-i+1);
  DelSpace:=S;
end;

Function DelNull(var S:string):string;
var
  Temp:Integer;
begin
  Temp:=Pos(#0,S);
  if Temp<>0 then Delete(S,Temp,Length(S)-Temp+1);
  DelNull:=S;
end;

Function DelSpaceTail(var S:string):string;
var
  i:Integer;
begin
  i:=Length(S)+1;
  while (i>1)and(S[i-1]=' ') do Dec(i);
  Delete(S,i,Length(S)-i+1);
  DelSpaceTail:=S;
end;

Function GetBuMa(Yu:Integer):Integer;
begin
  Yu:=Yu mod 256;
  if Yu>=0 then
    GetBuMa:=Yu
  else
    GetBuMa:=Yu+256;
end;

Function IsImdNum(S:string):Boolean;
var
  i:Integer;
begin
  IsImdNum:=True;
  if S='' then Exit;
  if not (S[1] in ['0'..'9']) then
  begin
    IsImdNum:=False;
    Exit;
  end;
  for i:=1 to Length(S)-1 do
  if not (S[i] in ['0'..'9','a'..'f','A'..'F']) then
  begin
    IsImdNum:=False;
    Exit;
  end;
  if Length(S)>1 then
  if not (S[Length(S)] in ['0'..'9','a'..'f','A'..'F','h','H']) then
  begin
    IsImdNum:=False;
    Exit;
  end;
end;

Function Max(X,Y:Longint):Longint;
begin
  if X>Y then
    Max:=X
  else
    Max:=Y;
end;

Function Min(X,Y:Longint):Longint;
begin
  if X<Y then
    Min:=X
  else
    Min:=Y;
end;

Procedure SwapInt(var X:Integer;var Y:Integer);
var
  Temp:Integer;
begin
  Temp:=X;
  X:=Y;
  Y:=Temp;
end;

end.