624 lines
22 KiB
ObjectPascal
624 lines
22 KiB
ObjectPascal
|
|
{******************************************}
|
|
{ }
|
|
{ FastScript v1.9 }
|
|
{ Standard functions }
|
|
{ }
|
|
{ (c) 2003-2007 by Alexander Tzyganenko, }
|
|
{ Fast Reports Inc }
|
|
{ }
|
|
{******************************************}
|
|
|
|
//VCL uses section
|
|
{$IFNDEF FMX}
|
|
unit fs_isysrtti;
|
|
|
|
interface
|
|
|
|
{$i fs.inc}
|
|
|
|
uses
|
|
SysUtils, Classes, fs_iinterpreter, fs_itools
|
|
{$IFDEF CLX}
|
|
, QDialogs, MaskUtils, Variants
|
|
{$ELSE}
|
|
{$IFNDEF NOFORMS}
|
|
, Dialogs
|
|
{$ENDIF}
|
|
{$IFDEF FPC}
|
|
{, Mask}, Variants
|
|
{$ELSE}
|
|
{$IFDEF Delphi6}
|
|
, MaskUtils, Variants, Windows
|
|
{$ELSE}
|
|
, Mask
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$ENDIF}
|
|
{$IFDEF OLE}
|
|
, ComObj
|
|
{$ENDIF};
|
|
{$ELSE}
|
|
interface
|
|
|
|
{$i fs.inc}
|
|
|
|
uses
|
|
System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_itools
|
|
{$IFNDEF NOFORMS}
|
|
, FMX.Dialogs
|
|
{$ENDIF}
|
|
, System.MaskUtils, System.Variants, FMX.Types
|
|
{$IFDEF OLE}
|
|
, System.Win.ComObj
|
|
{$ENDIF};
|
|
{$ENDIF}
|
|
|
|
type
|
|
TfsSysFunctions = class(TfsRTTIModule)
|
|
private
|
|
FCatConv: String;
|
|
FCatDate: String;
|
|
FCatFormat: String;
|
|
FCatMath: String;
|
|
FCatOther: String;
|
|
FCatStr: String;
|
|
function CallMethod1(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
function CallMethod2(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
function CallMethod3(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
function CallMethod4(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
function CallMethod5(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
function CallMethod6(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
function CallMethod7(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
public
|
|
constructor Create(AScript: TfsScript); override;
|
|
end;
|
|
|
|
|
|
implementation
|
|
|
|
{$IFDEF FPC}
|
|
uses lazutf8;
|
|
{$ENDIF}
|
|
|
|
|
|
function FormatV(const Fmt: String; Args: Variant): String;
|
|
var
|
|
ar: TVarRecArray;
|
|
sPtrList: TList;
|
|
begin
|
|
VariantToVarRec(Args, ar, sPtrList);
|
|
try
|
|
Result := Format(Fmt, ar);
|
|
finally
|
|
ClearVarRec(ar, sPtrList);
|
|
end;
|
|
end;
|
|
|
|
function VArrayCreate(Args: Variant; Typ: Integer): Variant;
|
|
var
|
|
i, n: Integer;
|
|
ar: array of {$IFDEF FPC}SizeInt{$ELSE}Integer{$ENDIF};
|
|
begin
|
|
n := VarArrayHighBound(Args, 1) + 1;
|
|
SetLength(ar, n);
|
|
for i := 0 to n - 1 do
|
|
ar[i] := Args[i];
|
|
|
|
Result := VarArrayCreate(ar, Typ);
|
|
ar := nil;
|
|
end;
|
|
|
|
function NameCase(const s: String): String;
|
|
var
|
|
i: Integer;
|
|
begin
|
|
{$IFDEF FPC}
|
|
Result := UTF8LowerString(s);
|
|
for i := 1 to UTF8Length(s) do
|
|
if i = 1 then
|
|
begin
|
|
UTF8Insert(UTF8UpperString(UTF8Copy(s, i, 1)), Result, i + 1);
|
|
UTF8Delete(Result, i, 1);
|
|
end
|
|
else if i < UTF8Length(s) then
|
|
if UTF8Copy(s, i, 1)[1] = ' ' then
|
|
begin
|
|
UTF8Insert(UTF8UpperString(UTF8Copy(s, i + 1, 1)), Result, i + 2);
|
|
UTF8Delete(Result, i + 1, 1);
|
|
end;
|
|
{$ELSE}
|
|
Result := AnsiLowercase(s);
|
|
for i := 1 to Length(s) do
|
|
if i = 1 then
|
|
Result[i] := AnsiUpperCase(s[i])[1]
|
|
else if i < Length(s) then
|
|
if s[i] = ' ' then
|
|
Result[i + 1] := AnsiUpperCase(s[i + 1])[1];
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function ValidInt(cInt: String): Boolean;
|
|
begin
|
|
Result := True;
|
|
try
|
|
StrToInt(cInt);
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function ValidFloat(cFlt: String): Boolean;
|
|
begin
|
|
Result := True;
|
|
try
|
|
StrToFloat(cFlt);
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function ValidDate(cDate: String) :Boolean;
|
|
begin
|
|
Result := True;
|
|
try
|
|
StrToDate(cDate);
|
|
except
|
|
Result := False;
|
|
end;
|
|
end;
|
|
|
|
function DaysInMonth(nYear, nMonth: Integer): Integer;
|
|
const
|
|
Days: array[1..12] of Integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
|
|
begin
|
|
Result := Days[nMonth];
|
|
if (nMonth = 2) and IsLeapYear(nYear) then Inc(Result);
|
|
end;
|
|
|
|
|
|
{ TfsSysFunctions }
|
|
|
|
constructor TfsSysFunctions.Create(AScript: TfsScript);
|
|
begin
|
|
inherited Create(AScript);
|
|
FCatStr := 'ctString';
|
|
FCatDate := 'ctDate';
|
|
FCatConv := 'ctConv';
|
|
FCatFormat := 'ctFormat';
|
|
FCatMath := 'ctMath';
|
|
FCatOther := 'ctOther';
|
|
|
|
with AScript do
|
|
begin
|
|
AddType('Byte', fvtInt);
|
|
AddType('Word', fvtInt);
|
|
AddType('Integer', fvtInt);
|
|
{$IFDEF FS_INT64}
|
|
AddType('Int64', fvtInt64);
|
|
{$ENDIF}
|
|
AddType('Longint', fvtInt);
|
|
AddType('Cardinal', fvtInt);
|
|
AddType('TColor', fvtInt);
|
|
AddType('TAlphaColor', fvtInt);
|
|
AddType('Boolean', fvtBool);
|
|
AddType('Real', fvtFloat);
|
|
AddType('Single', fvtFloat);
|
|
AddType('Double', fvtFloat);
|
|
AddType('Extended', fvtFloat);
|
|
AddType('Currency', fvtFloat);
|
|
AddType('TDate', fvtFloat);
|
|
AddType('TTime', fvtFloat);
|
|
AddType('TDateTime', fvtFloat);
|
|
AddType('Char', fvtChar);
|
|
AddType('String', fvtString);
|
|
AddType('Variant', fvtVariant);
|
|
AddType('Pointer', fvtVariant);
|
|
AddType('Array', fvtArray);
|
|
AddType('Constructor', fvtConstructor);
|
|
|
|
AddConst('True', 'Boolean', True);
|
|
AddConst('False', 'Boolean', False);
|
|
AddConst('nil', 'Variant', 0);
|
|
AddConst('Null', 'Variant', Null);
|
|
|
|
Add('__StringHelper', TfsStringHelper.Create);
|
|
Add('__ArrayHelper', TfsArrayHelper.Create('__ArrayHelper', -1, fvtVariant, ''));
|
|
AddVariable('ExceptionClassName', 'String', '');
|
|
AddVariable('ExceptionMessage', 'String', '');
|
|
|
|
AddMethod('function IntToStr(i: Integer): String', CallMethod1, FCatConv);
|
|
AddMethod('function FloatToStr(e: Extended): String', CallMethod1, FCatConv);
|
|
AddMethod('function DateToStr(e: Extended): String', CallMethod1, FCatConv);
|
|
AddMethod('function TimeToStr(e: Extended): String', CallMethod1, FCatConv);
|
|
AddMethod('function DateTimeToStr(e: Extended): String', CallMethod1, FCatConv);
|
|
{$IFDEF Delphi6}
|
|
AddMethod('function BoolToStr(B: Boolean): string;', CallMethod1, FCatConv);
|
|
{$ENDIF}
|
|
AddMethod('function VarToStr(v: Variant): String', CallMethod7, FCatConv);
|
|
|
|
AddMethod('function StrToInt(s: String): Integer', CallMethod2, FCatConv);
|
|
{$IFDEF FS_INT64}
|
|
AddMethod('function StrToInt64(s: String): Int64', CallMethod2, FCatConv);
|
|
{$ENDIF}
|
|
AddMethod('function StrToFloat(s: String): Extended', CallMethod2, FCatConv);
|
|
AddMethod('function StrToDate(s: String): Extended', CallMethod2, FCatConv);
|
|
AddMethod('function StrToTime(s: String): Extended', CallMethod2, FCatConv);
|
|
AddMethod('function StrToDateTime(s: String): Extended', CallMethod2, FCatConv);
|
|
{$IFDEF Delphi6}
|
|
AddMethod('function StrToBool(const S: string): Boolean;', CallMethod2, FCatConv);
|
|
{$ENDIF}
|
|
|
|
AddMethod('function Format(Fmt: String; Args: array): String', CallMethod3, FCatFormat);
|
|
AddMethod('function FormatFloat(Fmt: String; Value: Extended): String', CallMethod3, FCatFormat);
|
|
AddMethod('function FormatDateTime(Fmt: String; DateTime: TDateTime): String', CallMethod3, FCatFormat);
|
|
AddMethod('function FormatMaskText(EditMask: string; Value: string): string', CallMethod3, FCatFormat);
|
|
|
|
AddMethod('function EncodeDate(Year, Month, Day: Word): TDateTime', CallMethod4, FCatDate);
|
|
AddMethod('procedure DecodeDate(Date: TDateTime; var Year, Month, Day: Word)', CallMethod4, FCatDate);
|
|
AddMethod('function EncodeTime(Hour, Min, Sec, MSec: Word): TDateTime', CallMethod4, FCatDate);
|
|
AddMethod('procedure DecodeTime(Time: TDateTime; var Hour, Min, Sec, MSec: Word)', CallMethod4, FCatDate);
|
|
AddMethod('function Date: TDateTime', CallMethod4, FCatDate);
|
|
AddMethod('function Time: TDateTime', CallMethod4, FCatDate);
|
|
AddMethod('function Now: TDateTime', CallMethod4, FCatDate);
|
|
AddMethod('function DayOfWeek(aDate: TDateTime): Integer', CallMethod4, FCatDate);
|
|
AddMethod('function IsLeapYear(Year: Word): Boolean', CallMethod4, FCatDate);
|
|
AddMethod('function DaysInMonth(nYear, nMonth: Integer): Integer', CallMethod4, FCatDate);
|
|
|
|
AddMethod('function Length(s: Variant): Integer', CallMethod5, FCatStr);
|
|
AddMethod('function Copy(s: String; from, count: Integer): String', CallMethod5, FCatStr);
|
|
AddMethod('function Pos(substr, s: String): Integer', CallMethod5, FCatStr);
|
|
AddMethod('procedure Delete(var s: String; from, count: Integer)', CallMethod5, FCatStr);
|
|
AddMethod('procedure DeleteStr(var s: String; from, count: Integer)', CallMethod5, FCatStr);
|
|
AddMethod('procedure Insert(s: String; var s2: String; pos: Integer)', CallMethod5, FCatStr);
|
|
AddMethod('function Uppercase(s: String): String', CallMethod5, FCatStr);
|
|
AddMethod('function Lowercase(s: String): String', CallMethod5, FCatStr);
|
|
AddMethod('function Trim(s: String): String', CallMethod5, FCatStr);
|
|
AddMethod('function NameCase(s: String): String', CallMethod5, FCatStr);
|
|
AddMethod('function CompareText(s, s1: String): Integer', CallMethod5, FCatStr);
|
|
AddMethod('function Chr(i: Integer): Char', CallMethod5, FCatStr);
|
|
AddMethod('function Ord(ch: Char): Integer', CallMethod5, FCatStr);
|
|
AddMethod('procedure SetLength(var S: Variant; L: Integer)', CallMethod5, FCatStr);
|
|
|
|
AddMethod('function Round(e: Extended): Integer', CallMethod6, FCatMath);
|
|
AddMethod('function Trunc(e: Extended): Integer', CallMethod6, FCatMath);
|
|
AddMethod('function Int(e: Extended): Integer', CallMethod6, FCatMath);
|
|
AddMethod('function Frac(X: Extended): Extended', CallMethod6, FCatMath);
|
|
AddMethod('function Sqrt(e: Extended): Extended', CallMethod6, FCatMath);
|
|
AddMethod('function Abs(e: Extended): Extended', CallMethod6, FCatMath);
|
|
AddMethod('function Sin(e: Extended): Extended', CallMethod6, FCatMath);
|
|
AddMethod('function Cos(e: Extended): Extended', CallMethod6, FCatMath);
|
|
AddMethod('function ArcTan(X: Extended): Extended', CallMethod6, FCatMath);
|
|
AddMethod('function Tan(X: Extended): Extended', CallMethod6, FCatMath);
|
|
AddMethod('function Exp(X: Extended): Extended', CallMethod6, FCatMath);
|
|
AddMethod('function Ln(X: Extended): Extended', CallMethod6, FCatMath);
|
|
AddMethod('function Pi: Extended', CallMethod6, FCatMath);
|
|
|
|
AddMethod('procedure Inc(var i: Integer; incr: Integer = 1)', CallMethod7, FCatOther);
|
|
AddMethod('procedure Dec(var i: Integer; decr: Integer = 1)', CallMethod7, FCatOther);
|
|
AddMethod('procedure RaiseException(Param: String)', CallMethod7, FCatOther);
|
|
AddMethod('procedure ShowMessage(Msg: Variant)', CallMethod7, FCatOther);
|
|
AddMethod('procedure Randomize', CallMethod7, FCatOther);
|
|
AddMethod('function Random: Extended', CallMethod7, FCatOther);
|
|
AddMethod('function ValidInt(cInt: String): Boolean', CallMethod7, FCatOther);
|
|
AddMethod('function ValidFloat(cFlt: String): Boolean', CallMethod7, FCatOther);
|
|
AddMethod('function ValidDate(cDate: String): Boolean', CallMethod7, FCatOther);
|
|
AddMethod('function ExtractFilePath(const FileName: string): string;', CallMethod7, FCatOther);
|
|
{$IFDEF OLE}
|
|
AddMethod('function CreateOleObject(ClassName: String): Variant', CallMethod7, FCatOther);
|
|
{$ENDIF};
|
|
AddMethod('function VarArrayCreate(Bounds: Array; Typ: Integer): Variant', CallMethod7, FCatOther);
|
|
AddMethod('function VarType(V: Variant): Integer', CallMethod7, FCatOther);
|
|
|
|
AddConst('varEmpty', 'Integer', 0);
|
|
AddConst('varNull', 'Integer', 1);
|
|
AddConst('varSmallint', 'Integer', 2);
|
|
AddConst('varInteger', 'Integer', 3);
|
|
AddConst('varSingle', 'Integer', 4);
|
|
AddConst('varDouble', 'Integer', 5);
|
|
AddConst('varCurrency', 'Integer', 6);
|
|
AddConst('varDate', 'Integer', 7);
|
|
AddConst('varOleStr', 'Integer', 8);
|
|
AddConst('varDispatch', 'Integer', 9);
|
|
AddConst('varError', 'Integer', $000A);
|
|
AddConst('varBoolean', 'Integer', $000B);
|
|
AddConst('varVariant', 'Integer', $000C);
|
|
AddConst('varUnknown', 'Integer', $000D);
|
|
AddConst('varShortInt', 'Integer', $0010);
|
|
AddConst('varByte', 'Integer', $0011);
|
|
AddConst('varWord', 'Integer', $0012);
|
|
AddConst('varLongWord', 'Integer', $0013);
|
|
AddConst('varInt64', 'Integer', $0014);
|
|
AddConst('varStrArg', 'Integer', $0048);
|
|
AddConst('varString', 'Integer', $0100);
|
|
AddConst('varAny', 'Integer', $0101);
|
|
AddConst('varTypeMask', 'Integer', $0FFF);
|
|
AddConst('varArray', 'Integer', $2000);
|
|
AddConst('varByRef', 'Integer', $4000);
|
|
end;
|
|
end;
|
|
|
|
function TfsSysFunctions.CallMethod1(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
var
|
|
{$IFDEF DELPHI6}
|
|
i: Int64;
|
|
{$ELSE}
|
|
i: Integer;
|
|
{$ENDIF}
|
|
begin
|
|
if MethodName = 'INTTOSTR' then
|
|
begin
|
|
i := Caller.Params[0];
|
|
Result := IntToStr(i)
|
|
end
|
|
else if MethodName = 'FLOATTOSTR' then
|
|
Result := FloatToStr(Caller.Params[0])
|
|
else if MethodName = 'DATETOSTR' then
|
|
Result := DateToStr(Caller.Params[0])
|
|
else if MethodName = 'TIMETOSTR' then
|
|
Result := TimeToStr(Caller.Params[0])
|
|
else if MethodName = 'DATETIMETOSTR' then
|
|
Result := DateTimeToStr(Caller.Params[0])
|
|
{$IFDEF Delphi6}
|
|
else if MethodName = 'BOOLTOSTR' then
|
|
Result := BoolToStr(Caller.Params[0])
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TfsSysFunctions.CallMethod2(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
begin
|
|
if MethodName = 'STRTOINT' then
|
|
Result := StrToInt(Caller.Params[0])
|
|
{$IFDEF DELPHI6}
|
|
else if MethodName = 'STRTOINT64' then
|
|
Result := StrToInt64(Caller.Params[0])
|
|
{$ENDIF}
|
|
else if MethodName = 'STRTOFLOAT' then
|
|
Result := StrToFloat(Caller.Params[0])
|
|
else if MethodName = 'STRTODATE' then
|
|
Result := StrToDate(Caller.Params[0])
|
|
else if MethodName = 'STRTOTIME' then
|
|
Result := StrToTime(Caller.Params[0])
|
|
else if MethodName = 'STRTODATETIME' then
|
|
Result := StrToDateTime(Caller.Params[0])
|
|
{$IFDEF Delphi6}
|
|
else if MethodName = 'STRTOBOOL' then
|
|
Result := BoolToStr(Caller.Params[0])
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TfsSysFunctions.CallMethod3(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
begin
|
|
if MethodName = 'FORMAT' then
|
|
Result := FormatV(Caller.Params[0], Caller.Params[1])
|
|
else if MethodName = 'FORMATFLOAT' then
|
|
Result := FormatFloat(Caller.Params[0], Caller.Params[1] * 1.00000)
|
|
else if MethodName = 'FORMATDATETIME' then
|
|
Result := FormatDateTime(Caller.Params[0], Caller.Params[1])
|
|
{$IFNDEF FPC}
|
|
// fpc still have no maskedit
|
|
else if MethodName = 'FORMATMASKTEXT' then
|
|
Result := FormatMaskText(Caller.Params[0], Caller.Params[1])
|
|
{$ENDIF}
|
|
end;
|
|
|
|
function TfsSysFunctions.CallMethod4(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
var
|
|
w1, w2, w3, w4: Word;
|
|
begin
|
|
if MethodName = 'ENCODEDATE' then
|
|
Result := EncodeDate(Caller.Params[0], Caller.Params[1], Caller.Params[2])
|
|
else if MethodName = 'ENCODETIME' then
|
|
Result := EncodeTime(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
|
|
else if MethodName = 'DECODEDATE' then
|
|
begin
|
|
DecodeDate(Caller.Params[0], w1, w2, w3);
|
|
Caller.Params[1] := w1;
|
|
Caller.Params[2] := w2;
|
|
Caller.Params[3] := w3;
|
|
end
|
|
else if MethodName = 'DECODETIME' then
|
|
begin
|
|
DecodeTime(Caller.Params[0], w1, w2, w3, w4);
|
|
Caller.Params[1] := w1;
|
|
Caller.Params[2] := w2;
|
|
Caller.Params[3] := w3;
|
|
Caller.Params[4] := w4;
|
|
end
|
|
else if MethodName = 'DATE' then
|
|
Result := Date
|
|
else if MethodName = 'TIME' then
|
|
Result := Time
|
|
else if MethodName = 'NOW' then
|
|
Result := Now
|
|
else if MethodName = 'DAYOFWEEK' then
|
|
Result := DayOfWeek(Caller.Params[0])
|
|
else if MethodName = 'ISLEAPYEAR' then
|
|
Result := IsLeapYear(Caller.Params[0])
|
|
else if MethodName = 'DAYSINMONTH' then
|
|
Result := DaysInMonth(Caller.Params[0], Caller.Params[1])
|
|
end;
|
|
|
|
function TfsSysFunctions.CallMethod5(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
var
|
|
s: String;
|
|
v: Variant;
|
|
begin
|
|
if MethodName = 'LENGTH' then
|
|
begin
|
|
v := Caller.Params[0];
|
|
if VarIsArray(v) then
|
|
Result := VarArrayHighBound(v, 1) - VarArrayLowBound(v, 1) + 1
|
|
else
|
|
{$IFDEF FPC}
|
|
Result := UTF8Length(v)
|
|
{$ELSE}
|
|
Result := Length(v)
|
|
{$ENDIF}
|
|
end
|
|
else if MethodName = 'COPY' then
|
|
{$IFDEF FPC}
|
|
Result := UTF8Copy(Caller.Params[0], frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]))
|
|
{$ELSE}
|
|
Result := Copy(Caller.Params[0], frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]))
|
|
{$ENDIF}
|
|
else if MethodName = 'POS' then
|
|
{$IFNDEF FPC}
|
|
Result := Pos(Caller.Params[0], Caller.Params[1])
|
|
{$ELSE}
|
|
Result := UTF8Pos(AnsiString(Caller.Params[0]), AnsiString(Caller.Params[1]))
|
|
{$ENDIF}
|
|
else if (MethodName = 'DELETE') or (MethodName = 'DELETESTR') then
|
|
begin
|
|
s := Caller.Params[0];
|
|
{$IFNDEF FPC}
|
|
Delete(s, frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]));
|
|
{$ELSE}
|
|
UTF8Delete(s, frxInteger(Caller.Params[1]), frxInteger(Caller.Params[2]));
|
|
{$ENDIF}
|
|
Caller.Params[0] := s;
|
|
end
|
|
else if MethodName = 'INSERT' then
|
|
begin
|
|
s := Caller.Params[1];
|
|
{$IFNDEF FPC}
|
|
Insert(Caller.Params[0], s, Integer(Caller.Params[2]));
|
|
{$ELSE}
|
|
UTF8Insert(AnsiString(Caller.Params[0]), s, Integer(Caller.Params[2]));
|
|
{$ENDIF}
|
|
Caller.Params[1] := s;
|
|
end
|
|
else if MethodName = 'UPPERCASE' then
|
|
Result := {$IFDEF FPC}UTF8UpperString(Caller.Params[0]){$ELSE}AnsiUppercase(Caller.Params[0]){$ENDIF}
|
|
else if MethodName = 'LOWERCASE' then
|
|
Result := {$IFDEF FPC}UTF8LowerString(Caller.Params[0]){$ELSE}AnsiLowercase(Caller.Params[0]){$ENDIF}
|
|
else if MethodName = 'TRIM' then
|
|
Result := {$IFDEF FPC}UTF8Trim(Caller.Params[0]){$ELSE}Trim(Caller.Params[0]){$ENDIF}
|
|
else if MethodName = 'NAMECASE' then
|
|
Result := NameCase(Caller.Params[0])
|
|
else if MethodName = 'COMPARETEXT' then
|
|
Result := {$IFDEF FPC}UTF8CompareText(Caller.Params[0], Caller.Params[1]){$ELSE}AnsiCompareText(Caller.Params[0], Caller.Params[1]){$ENDIF}
|
|
else if MethodName = 'CHR' then
|
|
Result := Chr(Integer(Caller.Params[0]))
|
|
else if MethodName = 'ORD' then
|
|
Result := Ord(String(Caller.Params[0])[1])
|
|
else if MethodName = 'SETLENGTH' then
|
|
begin
|
|
if (TVarData(Caller.Params[0]).VType = varString) or
|
|
{$IFDEF Delphi12}
|
|
(TVarData(Caller.Params[0]).VType = varUString) or
|
|
{$ENDIF}
|
|
(TVarData(Caller.Params[0]).VType = varOleStr) then
|
|
begin
|
|
s := Caller.Params[0];
|
|
SetLength(s, Integer(Caller.Params[1]));
|
|
Caller.Params[0] := s;
|
|
end
|
|
else
|
|
begin
|
|
v := Caller.Params[0];
|
|
VarArrayRedim(v, Integer(Caller.Params[1]) - 1);
|
|
Caller.Params[0] := v;
|
|
end;
|
|
end
|
|
end;
|
|
|
|
function TfsSysFunctions.CallMethod6(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
begin
|
|
if MethodName = 'ROUND' then
|
|
{$IFNDEF FPC}
|
|
Result := frxInteger(Round(Caller.Params[0] * 1.00000))
|
|
{$ELSE}
|
|
Result := frxInteger(Round(Extended(Caller.Params[0]) * 1.00000))
|
|
{$ENDIF}
|
|
else if MethodName = 'TRUNC' then
|
|
{$IFNDEF FPC}
|
|
Result := frxInteger(Trunc(Caller.Params[0] * 1.00000))
|
|
{$ELSE}
|
|
Result := frxInteger(Trunc(Extended(Caller.Params[0]) * 1.00000))
|
|
{$ENDIF}
|
|
else if MethodName = 'INT' then
|
|
Result := Int(Caller.Params[0] * 1.00000)
|
|
else if MethodName = 'FRAC' then
|
|
Result := Frac(Caller.Params[0] * 1.00000)
|
|
else if MethodName = 'SQRT' then
|
|
Result := Sqrt(Caller.Params[0] * 1.00000)
|
|
else if MethodName = 'ABS' then
|
|
Result := Abs(Caller.Params[0] * 1.00000)
|
|
else if MethodName = 'SIN' then
|
|
Result := Sin(Caller.Params[0] * 1.00000)
|
|
else if MethodName = 'COS' then
|
|
Result := Cos(Caller.Params[0] * 1.00000)
|
|
else if MethodName = 'ARCTAN' then
|
|
Result := ArcTan(Caller.Params[0] * 1.00000)
|
|
else if MethodName = 'TAN' then
|
|
Result := Sin(Caller.Params[0] * 1.00000) / Cos(Caller.Params[0] * 1.00000)
|
|
else if MethodName = 'EXP' then
|
|
Result := Exp(Caller.Params[0] * 1.00000)
|
|
else if MethodName = 'LN' then
|
|
Result := Ln(Caller.Params[0] * 1.00000)
|
|
else if MethodName = 'PI' then
|
|
Result := Pi
|
|
end;
|
|
|
|
function TfsSysFunctions.CallMethod7(Instance: TObject; ClassType: TClass;
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
|
begin
|
|
if MethodName = 'INC' then
|
|
begin
|
|
Caller.Params[0] := Caller.Params[0] + Caller.Params[1];
|
|
end
|
|
else if MethodName = 'DEC' then
|
|
begin
|
|
Caller.Params[0] := Caller.Params[0] - Caller.Params[1];
|
|
end
|
|
else if MethodName = 'RAISEEXCEPTION' then
|
|
raise Exception.Create(Caller.Params[0])
|
|
{$IFNDEF NOFORMS}
|
|
else if MethodName = 'SHOWMESSAGE' then
|
|
ShowMessage(Caller.Params[0])
|
|
{$ENDIF}
|
|
else if MethodName = 'RANDOMIZE' then
|
|
Randomize
|
|
else if MethodName = 'RANDOM' then
|
|
Result := Random
|
|
else if MethodName = 'VALIDINT' then
|
|
Result := ValidInt(Caller.Params[0])
|
|
else if MethodName = 'VALIDFLOAT' then
|
|
Result := ValidFloat(Caller.Params[0])
|
|
else if MethodName = 'VALIDDATE' then
|
|
begin
|
|
if VarType(Caller.Params[0]) = varDate then
|
|
Result := ValidDate(DateToStr(Caller.Params[0]))
|
|
else Result := ValidDate(Caller.Params[0]);
|
|
end
|
|
{$IFDEF OLE}
|
|
else if MethodName = 'CREATEOLEOBJECT' then
|
|
Result := CreateOleObject(Caller.Params[0])
|
|
{$ENDIF}
|
|
else if MethodName = 'VARARRAYCREATE' then
|
|
Result := VArrayCreate(Caller.Params[0], Caller.Params[1])
|
|
else if MethodName = 'VARTOSTR' then
|
|
Result := VarToStr(Caller.Params[0])
|
|
else if MethodName = 'VARTYPE' then
|
|
Result := VarType(Caller.Params[0])
|
|
else if MethodName = 'EXTRACTFILEPATH' then
|
|
Result := ExtractFilePath(Caller.Params[0])
|
|
end;
|
|
|
|
|
|
end.
|