david
111d889bc6
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.DevExpressVCL@32 05c56307-c608-d34a-929d-697000501d7a
135 lines
6.2 KiB
ObjectPascal
135 lines
6.2 KiB
ObjectPascal
unit ifps3lib_std;
|
|
{
|
|
|
|
Innerfuse Pascal Script III
|
|
Copyright (C) 2000-2002 by Carlo Kok (ck@carlo-kok.com)
|
|
|
|
}
|
|
{$I ifps3_def.inc}
|
|
interface
|
|
uses
|
|
ifps3utl, ifpscomp;
|
|
|
|
{
|
|
In your Compilers OnUses proc:
|
|
RegisterStandardLibrary_C registers the standard library.
|
|
|
|
function floattostr(e: extended): string;
|
|
function inttostr(i: Longint): string;
|
|
function strtoint(s: string): Longint;
|
|
function strtointdef(s: string; def: Longint): Longint;
|
|
function copy(s: string; ifrom, icount: Longint): string;
|
|
function pos(substr, s: string): Longint;
|
|
procedure delete(var s: string; ifrom, icount: Longint);
|
|
procedure insert(s: string; var s2: string; ipos: Longint);
|
|
function getarraylength(var v: array): Integer;
|
|
procedure setarraylength(var v: array; i: Integer);
|
|
|
|
Function StrGet(var S : String; I : Integer) : Char;
|
|
procedure StrSet(c : Char; I : Integer; var s : String);
|
|
Function Uppercase(s : string) : string;
|
|
Function Lowercase(s : string) : string;
|
|
Function Trim(s : string) : string;
|
|
Function Length(s : String) : Longint;
|
|
procedure SetLength(var S: String; L: Longint);
|
|
Function Sin(e : Extended) : Extended;
|
|
Function Cos(e : Extended) : Extended;
|
|
Function Sqrt(e : Extended) : Extended;
|
|
Function Round(e : Extended) : Longint;
|
|
Function Trunc(e : Extended) : Longint;
|
|
Function Int(e : Extended) : Extended;
|
|
Function Pi : Extended;
|
|
Function Abs(e : Extended) : Extended;
|
|
function StrToFloat(s: string): Extended;
|
|
Function FloatToStr(e : Extended) : String;
|
|
Function Padl(s : string;I : longInt) : string;
|
|
Function Padr(s : string;I : longInt) : string;
|
|
Function Padz(s : string;I : longInt) : string;
|
|
Function Replicate(c : char;I : longInt) : string;
|
|
Function StringOfChar(c : char;I : longInt) : string;
|
|
|
|
type
|
|
TVarType = (vtNull, vtString, vtU64, vtS32, vtU32, vtS16, vtU16, vtS8, vtU8, vtSingle, vtDouble, vtExtended, vtResourcePointer, vtArray, vtRecord, vtChar, vtWideString, vtWideChar);
|
|
|
|
function VarGetType(x: Variant): TVarType;
|
|
function Null: Variant;
|
|
|
|
type
|
|
TIFException = (ErNoError, erCannotImport, erInvalidType, ErInternalError,
|
|
erInvalidHeader, erInvalidOpcode, erInvalidOpcodeParameter, erNoMainProc,
|
|
erOutOfGlobalVarsRange, erOutOfProcRange, ErOutOfRange, erOutOfStackRange,
|
|
ErTypeMismatch, erUnexpectedEof, erVersionError, ErDivideByZero, ErMathError,
|
|
erCouldNotCallProc, erOutofRecordRange, erOutOfMemory, erException,
|
|
erNullPointerException, erNullVariantError, erCustomError);
|
|
|
|
|
|
procedure RaiseLastException;
|
|
procedure RaiseException(Ex: TIFException; Param: string);
|
|
function ExceptionType: TIFException;
|
|
function ExceptionParam: string;
|
|
function ExceptionProc: Cardinal;
|
|
function ExceptionPos: Cardinal;
|
|
function ExceptionToString(er: TIFException; Param: string): string;
|
|
}
|
|
procedure RegisterStandardLibrary_C(S: TIFPSPascalCompiler);
|
|
|
|
implementation
|
|
|
|
procedure RegisterStandardLibrary_C(S: TIFPSPascalCompiler);
|
|
var
|
|
p: TIFPSRegProc;
|
|
begin
|
|
s.AddFunction('function inttostr(i: Longint): string;');
|
|
s.AddFunction('function strtoint(s: string): Longint;');
|
|
s.AddFunction('function strtointdef(s: string; def: Longint): Longint;');
|
|
s.AddFunction('function copy(s: string; ifrom, icount: Longint): string;');
|
|
s.AddFunction('function pos(substr, s: string): Longint;');
|
|
s.AddFunction('procedure delete(var s: string; ifrom, icount: Longint);');
|
|
s.AddFunction('procedure insert(s: string; var s2: string; ipos: Longint);');
|
|
p := s.Addfunction('function getarraylength: integer;');
|
|
p.Decl := p.Decl + ' !V -1';
|
|
p := s.Addfunction('procedure setarraylength;');
|
|
p.Decl := p.Decl + ' !V -1 @LENGTH '+IntToStr(Longint(s.FindType('INTEGER')));
|
|
s.AddFunction('Function StrGet(var S : String; I : Integer) : Char;');
|
|
s.AddFunction('procedure StrSet(c : Char; I : Integer; var s : String);');
|
|
s.AddFunction('Function Uppercase(s : string) : string;');
|
|
s.AddFunction('Function Lowercase(s : string) : string;');
|
|
s.AddFunction('Function Trim(s : string) : string;');
|
|
s.AddFunction('Function Length(s : String) : Longint;');
|
|
s.AddFunction('procedure SetLength(var S: String; L: Longint);');
|
|
s.AddFunction('Function Sin(e : Extended) : Extended;');
|
|
s.AddFunction('Function Cos(e : Extended) : Extended;');
|
|
s.AddFunction('Function Sqrt(e : Extended) : Extended;');
|
|
s.AddFunction('Function Round(e : Extended) : Longint;');
|
|
s.AddFunction('Function Trunc(e : Extended) : Longint;');
|
|
s.AddFunction('Function Int(e : Extended) : Extended;');
|
|
s.AddFunction('Function Pi : Extended;');
|
|
s.AddFunction('Function Abs(e : Extended) : Extended;');
|
|
s.AddFunction('function StrToFloat(s: string): Extended;');
|
|
s.AddFunction('Function FloatToStr(e : Extended) : String;');
|
|
s.AddFunction('Function Padl(s : string;I : longInt) : string;');
|
|
s.AddFunction('Function Padr(s : string;I : longInt) : string;');
|
|
s.AddFunction('Function Padz(s : string;I : longInt) : string;');
|
|
s.AddFunction('Function Replicate(c : char;I : longInt) : string;');
|
|
s.AddFunction('Function StringOfChar(c : char;I : longInt) : string;');
|
|
s.AddTypeS('TVarType', '(vtNull, vtString, vtU64, vtS32, vtU32, vtS16, vtU16, vtS8, vtU8, vtSingle, vtDouble, vtExtended, vtResourcePointer, vtArray, vtRecord, vtChar, vtWideString, vtWideChar)');
|
|
S.AddFunction('function VarGetType(x: Variant): TVarType;');
|
|
s.AddFunction('function Null: Variant;');
|
|
|
|
s.addTypeS('TIFException', '(ErNoError, erCannotImport, erInvalidType, ErInternalError, erInvalidHeader, erInvalidOpcode, erInvalidOpcodeParameter, erNoMainProc, erOutOfGlobalVarsRange, erOutOfProcRange, ErOutOfRange, erOutOfStackRange, '+
|
|
'ErTypeMismatch, erUnexpectedEof, erVersionError, ErDivideByZero, ErMathError,erCouldNotCallProc, erOutofRecordRange, erOutOfMemory, erException, erNullPointerException, erNullVariantError, erCustomError)');
|
|
|
|
s.AddFunction('procedure RaiseLastException;');
|
|
s.AddFunction('procedure RaiseException(Ex: TIFException; Param: string);');
|
|
s.AddFunction('function ExceptionType: TIFException;');
|
|
s.AddFunction('function ExceptionParam: string;');
|
|
s.AddFunction('function ExceptionProc: Cardinal;');
|
|
s.AddFunction('function ExceptionPos: Cardinal;');
|
|
s.Addfunction('function ExceptionToString(er: TIFException; Param: string): string;');
|
|
|
|
|
|
end;
|
|
|
|
|
|
end.
|