PPlib.pas

Un article de Wikipedia.

{          PPlib
Version 7 - November 24, 2004
 
PPlib is a set of common
functions for the Palm OS
Pascal Compiler
 
Made by Laurent Duveau 
      & Philippe Guillot
  web site = www.aldweb.com
  web site = http://ppcompiler.free.fr
  e-Mail   = info@aldweb.com
  e-Mail   = ph.guillot@wanadoo.fr
 
Use: insert {$i PPlib.pas}
     in your PP source code
 
Functions:
  BoolToInt(B:boolean):integer;
  IntToBool(N:integer):boolean;
  IntToHexChar(H:integer):char;
  IntToString(N:integer):string;
  Max(A,B:integer):integer;
  Min(A,B:integer):integer;
  RealToFix(X:real;D:integer):string;
  RealToString(R:real):string;
  Spc(N:integer):string;
  StringToInt(const S:string):integer;
  StringToReal(S:string):real;
  SubString(const S:String;iStart,iEnd:integer):string;
}
 
 
function BoolToInt(B:boolean):integer;
begin
 BoolToInt:=Ord(B);
end;
 
 
function IntToBool(N:integer):boolean;
begin
 IntToBool:=N>0;
end;
 
 
function IntToHexChar(H:integer):char;
begin
 if H in [0..9] then
  IntToHexChar:=chr(H+ord('0'))
 else 
  if H in [10..15] then
   IntToHexChar:=chr(H-10+ord('A'))
  else
   IntToHexChar:=chr(0);
end;
 
 
function IntToString(N:integer):string;
var
 S:string;
procedure StrIToA(var S:string;N:integer); inline($4E4F,$A0C9);
begin
 StrIToA(S,N);
 IntToString:=S;
end;
 
 
function Max(A,B:integer):integer;
begin
 if A>B then 
  Max:=A
 else
  Max:=B;
end;
 
 
function Min(A,B:integer):integer;
begin
 if A<B then 
  Min:=A
 else
  Min:=B;
end;
 
 
function RealToFix(X:real;D:integer):string;
var
 I,K:integer;
 S:string;
function Pow10(N:integer):real;
 var
  Mask:Integer;
  Y:real;
 begin
  if N=0 then
   Y:=1
  else begin
   Mask:=$8000000;
   Y:=10;
   while Mask>N do 
    Mask:=Mask div 2;
   Mask:=Mask div 2;
   while mask<>0 do begin
    Y:=sqr(Y);
    if (N and Mask)<>0 then 
     Y:=Y*10;
    Mask:=Mask div 2;
   end
  end;
  Pow10:=Y;
 end;
begin
 if X>=0 then begin
  X:=X+5/Pow10(D+1);
  I:=trunc(X);
  X:=X-I;
 end
 else begin
  X:=-X+5/Pow10(D+1);
  I:=trunc(X);
  X:=X-I;
  I:=-I;
 end;
 S:=IntToString(I)+'.';
 for K:=D downto 1 do begin
  X:=X*10;
  I:=trunc(X);
  S:=S+chr(ord('0')+I);
  X:=X-i;
 end;
 RealToFix:=S;
end;
 
 
function RealToString(R:real):string;
type
 FlpDouble = record
              Hi,Lo:integer;
             end;
procedure f_ftod(var Y:FlpDouble;x:real); inline($7400+11,$4E4F,$0306);
procedure FlpFToA(X:FlpDouble;var st:string); inline($7400+1,$4E4F,$0305);
var
 D:FlpDouble;
 S:string;
begin
 f_ftod(D,R);
 FlpFToA(D,S);
 RealToString:=S;
end;
 
 
function Spc(N:integer):string;
var
 I:integer;
 S:string;
begin
 S:='';
 for I:=1 to N do
  S:=S+' ';
 Spc:=S;
end;
 
 
function StringToInt(const S:string):integer;
function StrAToI(const S:string):integer; inline($4e4f,$a0ce);
begin
 StringToInt:=StrAToI(S);
end;
 
 
function StringToReal(S:string):real;
type
  FlpDouble = record
               Hi,Lo:integer;
              end;
procedure FlpAToF(var X:FlpDouble;var St:string); inline($7400+2,$4E4F,$0305);
function d_dtof(X:FlpDouble):real; inline($7400+12,$4E4F,$0306);
var
 D:FlpDouble;
begin
 FlpAToF(D,S);
 StringToReal:=d_dtof(D);
end;
 
 
function SubString(const S:String;iStart,iEnd:integer):string;
var
 SubS:String;
 i:integer;
begin
 SubS:='';
 for i:=Max(iStart,1) to Min(iEnd,Length(S)) do
  SubS:=SubS+S[i];
 SubString:=SubS;
end;