1053 lines
35 KiB
ObjectPascal
1053 lines
35 KiB
ObjectPascal
|
|
||
|
|
{******************************************}
|
||
|
|
{ }
|
||
|
|
{ FastScript v1.9 }
|
||
|
|
{ Classes.pas classes and functions }
|
||
|
|
{ }
|
||
|
|
{ (c) 2003-2007 by Alexander Tzyganenko, }
|
||
|
|
{ Fast Reports Inc }
|
||
|
|
{ }
|
||
|
|
{******************************************}
|
||
|
|
|
||
|
|
//VCL uses section
|
||
|
|
{$IFNDEF FMX}
|
||
|
|
unit fs_iclassesrtti;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
{$i fs.inc}
|
||
|
|
|
||
|
|
uses SysUtils, Classes, fs_iinterpreter, fs_xml{$IFDEF DELPHI16}, Controls{$ENDIF}
|
||
|
|
{$IFDEF Delphi16}
|
||
|
|
, System.Types
|
||
|
|
{$ENDIF};
|
||
|
|
//FMX USES
|
||
|
|
{$ELSE}
|
||
|
|
interface
|
||
|
|
|
||
|
|
{$i fs.inc}
|
||
|
|
|
||
|
|
uses System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_xml, System.Types, FMX.Types, System.UITypes
|
||
|
|
{$IFDEF DELPHI20}
|
||
|
|
,System.Math.Vectors
|
||
|
|
{$ENDIF};
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
type
|
||
|
|
{$i frxPlatformsAttribute.inc}
|
||
|
|
TfsClassesRTTI = class(TComponent); // fake component
|
||
|
|
{$IFDEF FMX}
|
||
|
|
{ wrappers for most using structures }
|
||
|
|
TfsRectF = class(TPersistent)
|
||
|
|
private
|
||
|
|
FRectF: TRectF;
|
||
|
|
function GetBottom: Single;
|
||
|
|
function GetLeft: Single;
|
||
|
|
function GetRight: Single;
|
||
|
|
function GetTop: Single;
|
||
|
|
procedure SetBottom(const Value: Single);
|
||
|
|
procedure SetLeft(const Value: Single);
|
||
|
|
procedure SetRight(const Value: Single);
|
||
|
|
procedure SetTop(const Value: Single);
|
||
|
|
public
|
||
|
|
function GetRect: TRectF;
|
||
|
|
function GetRectP: PRectF;
|
||
|
|
constructor Create(aRectF: TRectF);
|
||
|
|
published
|
||
|
|
property Left: Single read GetLeft write SetLeft;
|
||
|
|
property Top: Single read GetTop write SetTop;
|
||
|
|
property Right: Single read GetRight write SetRight;
|
||
|
|
property Bottom: Single read GetBottom write SetBottom;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TfsMatrix = class(TPersistent)
|
||
|
|
private
|
||
|
|
FMatrix: TMatrix;
|
||
|
|
function Getm11: Single;
|
||
|
|
function Getm12: Single;
|
||
|
|
function Getm13: Single;
|
||
|
|
function Getm21: Single;
|
||
|
|
function Getm22: Single;
|
||
|
|
function Getm23: Single;
|
||
|
|
function Getm31: Single;
|
||
|
|
function Getm32: Single;
|
||
|
|
function Getm33: Single;
|
||
|
|
procedure Setm11(const Value: Single);
|
||
|
|
procedure Setm12(const Value: Single);
|
||
|
|
procedure Setm13(const Value: Single);
|
||
|
|
procedure Setm21(const Value: Single);
|
||
|
|
procedure Setm22(const Value: Single);
|
||
|
|
procedure Setm23(const Value: Single);
|
||
|
|
procedure Setm31(const Value: Single);
|
||
|
|
procedure Setm32(const Value: Single);
|
||
|
|
procedure Setm33(const Value: Single);
|
||
|
|
public
|
||
|
|
procedure AssignToRect(var Rect: TMatrix);
|
||
|
|
procedure AssignFromRect(Rect: TMatrix);
|
||
|
|
function GetRect: TMatrix;
|
||
|
|
constructor Create(aMatrix: TMatrix);
|
||
|
|
published
|
||
|
|
property m11: Single read Getm11 write Setm11;
|
||
|
|
property m12: Single read Getm12 write Setm12;
|
||
|
|
property m13: Single read Getm13 write Setm13;
|
||
|
|
property m21: Single read Getm21 write Setm21;
|
||
|
|
property m22: Single read Getm22 write Setm22;
|
||
|
|
property m23: Single read Getm23 write Setm23;
|
||
|
|
property m31: Single read Getm31 write Setm31;
|
||
|
|
property m32: Single read Getm32 write Setm32;
|
||
|
|
property m33: Single read Getm33 write Setm33;
|
||
|
|
end;
|
||
|
|
|
||
|
|
TfsPointF = class(TPersistent)
|
||
|
|
private
|
||
|
|
FPointF: TPointF;
|
||
|
|
function GetX: Single;
|
||
|
|
function GetY: Single;
|
||
|
|
procedure SetX(const Value: Single);
|
||
|
|
procedure SetY(const Value: Single);
|
||
|
|
public
|
||
|
|
function GetRect: TPointF;
|
||
|
|
function GetRectP: PPointF;
|
||
|
|
constructor Create(aPointF: TPointF);
|
||
|
|
published
|
||
|
|
property pX: Single read GetX write SetX;
|
||
|
|
property pY: Single read GetY write SetY;
|
||
|
|
end;
|
||
|
|
|
||
|
|
PVector = ^TVector;
|
||
|
|
TfsVector = class(TPersistent)
|
||
|
|
private
|
||
|
|
FVector: TVector;
|
||
|
|
function GetW: Single;
|
||
|
|
function GetX: Single;
|
||
|
|
function GetY: Single;
|
||
|
|
procedure SetW(const Value: Single);
|
||
|
|
procedure SetX(const Value: Single);
|
||
|
|
procedure SetY(const Value: Single);
|
||
|
|
public
|
||
|
|
function GetRect: TVector;
|
||
|
|
function GetRectP: PVector;
|
||
|
|
constructor Create(aVector: TVector);
|
||
|
|
published
|
||
|
|
property pX: Single read GetX write SetX;
|
||
|
|
property pY: Single read GetY write SetY;
|
||
|
|
property pW: Single read GetW write SetW;
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
|
||
|
|
implementation
|
||
|
|
|
||
|
|
type
|
||
|
|
TFunctions = class(TfsRTTIModule)
|
||
|
|
private
|
||
|
|
function CallMethod(Instance: TObject; ClassType: TClass;
|
||
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
||
|
|
function GetProp(Instance: TObject; ClassType: TClass;
|
||
|
|
const PropName: String): Variant;
|
||
|
|
procedure SetProp(Instance: TObject; ClassType: TClass;
|
||
|
|
const PropName: String; Value: Variant);
|
||
|
|
public
|
||
|
|
constructor Create(AScript: TfsScript); override;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$IFDEF FMX}
|
||
|
|
{ TFrxRectF }
|
||
|
|
|
||
|
|
constructor TfsRectF.Create(aRectF: TRectF);
|
||
|
|
begin
|
||
|
|
FRectF.Left := aRectF.Left;
|
||
|
|
FRectF.Top := aRectF.Top;
|
||
|
|
FRectF.Right := aRectF.Right;
|
||
|
|
FRectF.Bottom := aRectF.Bottom;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsRectF.GetBottom: Single;
|
||
|
|
begin
|
||
|
|
Result := FRectF.Bottom;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsRectF.GetLeft: Single;
|
||
|
|
begin
|
||
|
|
Result := FRectF.Left;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsRectF.GetRect: TRectF;
|
||
|
|
begin
|
||
|
|
Result := FRectF;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsRectF.GetRectP: PRectF;
|
||
|
|
begin
|
||
|
|
Result := @FRectF;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsRectF.GetRight: Single;
|
||
|
|
begin
|
||
|
|
Result := FRectF.Right;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsRectF.GetTop: Single;
|
||
|
|
begin
|
||
|
|
Result := FRectF.Top;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsRectF.SetBottom(const Value: Single);
|
||
|
|
begin
|
||
|
|
FRectF.Bottom := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsRectF.SetLeft(const Value: Single);
|
||
|
|
begin
|
||
|
|
FRectF.Left := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsRectF.SetRight(const Value: Single);
|
||
|
|
begin
|
||
|
|
FRectF.Right := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsRectF.SetTop(const Value: Single);
|
||
|
|
begin
|
||
|
|
FRectF.Top := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TfsMatrix }
|
||
|
|
|
||
|
|
procedure TfsMatrix.AssignFromRect(Rect: TMatrix);
|
||
|
|
begin
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsMatrix.AssignToRect(var Rect: TMatrix);
|
||
|
|
begin
|
||
|
|
|
||
|
|
end;
|
||
|
|
|
||
|
|
constructor TfsMatrix.Create(aMatrix: TMatrix);
|
||
|
|
begin
|
||
|
|
FMatrix.m11 := aMatrix.m11;
|
||
|
|
FMatrix.m12 := aMatrix.m12;
|
||
|
|
FMatrix.m13 := aMatrix.m13;
|
||
|
|
FMatrix.m21 := aMatrix.m21;
|
||
|
|
FMatrix.m22 := aMatrix.m22;
|
||
|
|
FMatrix.m23 := aMatrix.m23;
|
||
|
|
FMatrix.m31 := aMatrix.m31;
|
||
|
|
FMatrix.m32 := aMatrix.m32;
|
||
|
|
FMatrix.m33 := aMatrix.m33;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsMatrix.Getm11: Single;
|
||
|
|
begin
|
||
|
|
Result := FMatrix.m11;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsMatrix.Getm12: Single;
|
||
|
|
begin
|
||
|
|
Result := FMatrix.m12;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsMatrix.Getm13: Single;
|
||
|
|
begin
|
||
|
|
Result := FMatrix.m13;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsMatrix.Getm21: Single;
|
||
|
|
begin
|
||
|
|
Result := FMatrix.m21;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsMatrix.Getm22: Single;
|
||
|
|
begin
|
||
|
|
Result := FMatrix.m22;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsMatrix.Getm23: Single;
|
||
|
|
begin
|
||
|
|
Result := FMatrix.m23;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsMatrix.Getm31: Single;
|
||
|
|
begin
|
||
|
|
Result := FMatrix.m31;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsMatrix.Getm32: Single;
|
||
|
|
begin
|
||
|
|
Result := FMatrix.m32;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsMatrix.Getm33: Single;
|
||
|
|
begin
|
||
|
|
Result := FMatrix.m33;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsMatrix.GetRect: TMatrix;
|
||
|
|
begin
|
||
|
|
Result := FMatrix;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsMatrix.Setm11(const Value: Single);
|
||
|
|
begin
|
||
|
|
FMatrix.m11 := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsMatrix.Setm12(const Value: Single);
|
||
|
|
begin
|
||
|
|
FMatrix.m12 := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsMatrix.Setm13(const Value: Single);
|
||
|
|
begin
|
||
|
|
FMatrix.m13 := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsMatrix.Setm21(const Value: Single);
|
||
|
|
begin
|
||
|
|
FMatrix.m21 := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsMatrix.Setm22(const Value: Single);
|
||
|
|
begin
|
||
|
|
FMatrix.m22 := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsMatrix.Setm23(const Value: Single);
|
||
|
|
begin
|
||
|
|
FMatrix.m23 := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsMatrix.Setm31(const Value: Single);
|
||
|
|
begin
|
||
|
|
FMatrix.m31 := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsMatrix.Setm32(const Value: Single);
|
||
|
|
begin
|
||
|
|
FMatrix.m32 := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsMatrix.Setm33(const Value: Single);
|
||
|
|
begin
|
||
|
|
FMatrix.m33 := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TfsPointF }
|
||
|
|
|
||
|
|
constructor TfsPointF.Create(aPointF: TPointF);
|
||
|
|
begin
|
||
|
|
FPointF.X := aPointF.X;
|
||
|
|
FPointF.Y := aPointF.Y;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsPointF.GetRect: TPointF;
|
||
|
|
begin
|
||
|
|
Result := FPointF;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsPointF.GetRectP: PPointF;
|
||
|
|
begin
|
||
|
|
Result := @FPointF;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsPointF.GetX: Single;
|
||
|
|
begin
|
||
|
|
Result := FPointF.X;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsPointF.GetY: Single;
|
||
|
|
begin
|
||
|
|
Result := FPointF.Y;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsPointF.SetX(const Value: Single);
|
||
|
|
begin
|
||
|
|
FPointF.X := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsPointF.SetY(const Value: Single);
|
||
|
|
begin
|
||
|
|
FPointF.Y := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ TfsVector }
|
||
|
|
|
||
|
|
constructor TfsVector.Create(aVector: TVector);
|
||
|
|
begin
|
||
|
|
FVector.X := aVector.X;
|
||
|
|
FVector.Y := aVector.Y;
|
||
|
|
FVector.W := aVector.W;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsVector.GetRect: TVector;
|
||
|
|
begin
|
||
|
|
Result := FVector;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsVector.GetRectP: PVector;
|
||
|
|
begin
|
||
|
|
Result := @FVector;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsVector.GetW: Single;
|
||
|
|
begin
|
||
|
|
Result := FVector.W;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsVector.GetX: Single;
|
||
|
|
begin
|
||
|
|
Result := FVector.X;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TfsVector.GetY: Single;
|
||
|
|
begin
|
||
|
|
Result := FVector.Y;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsVector.SetW(const Value: Single);
|
||
|
|
begin
|
||
|
|
FVector.W := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsVector.SetX(const Value: Single);
|
||
|
|
begin
|
||
|
|
FVector.X := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TfsVector.SetY(const Value: Single);
|
||
|
|
begin
|
||
|
|
FVector.Y := Value;
|
||
|
|
end;
|
||
|
|
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
|
||
|
|
{ TFunctions }
|
||
|
|
|
||
|
|
constructor TFunctions.Create(AScript: TfsScript);
|
||
|
|
begin
|
||
|
|
inherited Create(AScript);
|
||
|
|
with AScript do
|
||
|
|
begin
|
||
|
|
AddConst('fmCreate', 'Integer', fmCreate);
|
||
|
|
AddConst('fmOpenRead', 'Integer', fmOpenRead);
|
||
|
|
AddConst('fmOpenWrite', 'Integer', fmOpenWrite);
|
||
|
|
AddConst('fmOpenReadWrite', 'Integer', fmOpenReadWrite);
|
||
|
|
AddConst('fmShareExclusive', 'Integer', fmShareExclusive);
|
||
|
|
AddConst('fmShareDenyWrite', 'Integer', fmShareDenyWrite);
|
||
|
|
AddConst('fmShareDenyNone', 'Integer', fmShareDenyNone);
|
||
|
|
AddConst('soFromBeginning', 'Integer', soFromBeginning);
|
||
|
|
AddConst('soFromCurrent', 'Integer', soFromCurrent);
|
||
|
|
AddConst('soFromEnd', 'Integer', soFromEnd);
|
||
|
|
AddEnum('TDuplicates', 'dupIgnore, dupAccept, dupError');
|
||
|
|
AddEnum('TPrinterOrientation', 'poPortrait, poLandscape');
|
||
|
|
|
||
|
|
with AddClass(TObject, '') do
|
||
|
|
begin
|
||
|
|
AddConstructor('constructor Create', CallMethod);
|
||
|
|
AddMethod('procedure Free', CallMethod);
|
||
|
|
AddMethod('function ClassName: String', CallMethod);
|
||
|
|
end;
|
||
|
|
with AddClass(TPersistent, 'TObject') do
|
||
|
|
AddMethod('procedure Assign(Source: TPersistent)', CallMethod);
|
||
|
|
AddClass(TCollectionItem, 'TPersistent');
|
||
|
|
with AddClass(TCollection, 'TPersistent') do
|
||
|
|
begin
|
||
|
|
AddMethod('procedure Clear', CallMethod);
|
||
|
|
AddProperty('Count', 'Integer', GetProp, nil);
|
||
|
|
AddDefaultProperty('Items', 'Integer', 'TCollectionItem', CallMethod, True);
|
||
|
|
end;
|
||
|
|
with AddClass(TList, 'TObject') do
|
||
|
|
begin
|
||
|
|
AddMethod('function Add(Item: TObject): Integer', CallMethod);
|
||
|
|
AddMethod('procedure Clear', CallMethod);
|
||
|
|
AddMethod('procedure Delete(Index: Integer)', CallMethod);
|
||
|
|
AddMethod('function IndexOf(Item: TObject): Integer', CallMethod);
|
||
|
|
AddMethod('procedure Insert(Index: Integer; Item: TObject)', CallMethod);
|
||
|
|
AddMethod('function Remove(Item: TObject): Integer', CallMethod);
|
||
|
|
AddProperty('Count', 'Integer', GetProp, nil);
|
||
|
|
AddDefaultProperty('Items', 'Integer', 'TObject', CallMethod);
|
||
|
|
end;
|
||
|
|
with AddClass(TStrings, 'TPersistent') do
|
||
|
|
begin
|
||
|
|
AddConstructor('constructor Create', CallMethod);
|
||
|
|
AddMethod('function Add(const S: string): Integer', CallMethod);
|
||
|
|
AddMethod('function AddObject(const S: string; AObject: TObject): Integer', CallMethod);
|
||
|
|
AddMethod('procedure Clear', CallMethod);
|
||
|
|
AddMethod('procedure Delete(Index: Integer)', CallMethod);
|
||
|
|
AddMethod('function IndexOf(const S: string): Integer', CallMethod);
|
||
|
|
AddMethod('function IndexOfName(const Name: string): Integer', CallMethod);
|
||
|
|
AddMethod('function IndexOfObject(AObject: TObject): Integer', CallMethod);
|
||
|
|
AddMethod('procedure Insert(Index: Integer; const S: string)', CallMethod);
|
||
|
|
AddMethod('procedure InsertObject(Index: Integer; const S: string; AObject: TObject)', CallMethod);
|
||
|
|
AddMethod('procedure LoadFromFile(const FileName: string)', CallMethod);
|
||
|
|
AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
|
||
|
|
AddMethod('procedure SaveToFile(const FileName: string)', CallMethod);
|
||
|
|
AddMethod('procedure Move(CurIndex, NewIndex: Integer)', CallMethod);
|
||
|
|
AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
|
||
|
|
|
||
|
|
AddProperty('CommaText', 'string', GetProp, SetProp);
|
||
|
|
AddProperty('Count', 'Integer', GetProp, nil);
|
||
|
|
AddIndexProperty('Names', 'Integer', 'string', CallMethod, True);
|
||
|
|
AddIndexProperty('Objects', 'Integer', 'TObject', CallMethod);
|
||
|
|
AddIndexProperty('Values', 'String', 'string', CallMethod);
|
||
|
|
AddDefaultProperty('Strings', 'Integer', 'string', CallMethod);
|
||
|
|
AddProperty('Text', 'string', GetProp, SetProp);
|
||
|
|
end;
|
||
|
|
with AddClass(TStringList, 'TStrings') do
|
||
|
|
begin
|
||
|
|
AddMethod('function Find(s: String; var Index: Integer): Boolean', CallMethod);
|
||
|
|
AddMethod('procedure Sort', CallMethod);
|
||
|
|
AddProperty('Duplicates', 'TDuplicates', GetProp, SetProp);
|
||
|
|
AddProperty('Sorted', 'Boolean', GetProp, SetProp);
|
||
|
|
end;
|
||
|
|
with AddClass(TStream, 'TObject') do
|
||
|
|
begin
|
||
|
|
AddMethod('function Read(var Buffer: string; Count: Longint): Longint', CallMethod);
|
||
|
|
AddMethod('function Write(Buffer: string; Count: Longint): Longint', CallMethod);
|
||
|
|
AddMethod('function Seek(Offset: Longint; Origin: Word): Longint', CallMethod);
|
||
|
|
AddMethod('function CopyFrom(Source: TStream; Count: Longint): Longint', CallMethod);
|
||
|
|
AddProperty('Position', 'Longint', GetProp, SetProp);
|
||
|
|
AddProperty('Size', 'Longint', GetProp, nil);
|
||
|
|
end;
|
||
|
|
with AddClass(TFileStream, 'TStream') do
|
||
|
|
AddConstructor('constructor Create(Filename: String; Mode: Word)', CallMethod);
|
||
|
|
with AddClass(TMemoryStream, 'TStream') do
|
||
|
|
begin
|
||
|
|
AddMethod('procedure Clear', CallMethod);
|
||
|
|
AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
|
||
|
|
AddMethod('procedure LoadFromFile(Filename: String)', CallMethod);
|
||
|
|
AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
|
||
|
|
AddMethod('procedure SaveToFile(Filename: String)', CallMethod);
|
||
|
|
end;
|
||
|
|
with AddClass(TComponent, 'TPersistent') do
|
||
|
|
begin
|
||
|
|
AddConstructor('constructor Create(AOwner: TComponent)', CallMethod);
|
||
|
|
AddProperty('Owner', 'TComponent', GetProp, nil);
|
||
|
|
end;
|
||
|
|
{$IFDEF FMX}
|
||
|
|
AddClass(TfsRectF, 'TPersistent');
|
||
|
|
AddClass(TfsMatrix, 'TPersistent');
|
||
|
|
AddClass(TfsPointF, 'TPersistent');
|
||
|
|
AddClass(TfsVector, 'TPersistent');
|
||
|
|
with AddClass(TFmxObject, 'TComponent') do
|
||
|
|
begin
|
||
|
|
AddMethod('function Clone(AOwner: TComponent): TFmxObject', CallMethod);
|
||
|
|
AddMethod('procedure CloneChildFromStream(AStream: TStream)', CallMethod);
|
||
|
|
AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
|
||
|
|
AddMethod('procedure InsertObject(Index: Integer; AObject: TFmxObject)', CallMethod);
|
||
|
|
AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
|
||
|
|
AddMethod('procedure RemoveObject(Index: Integer)', CallMethod);
|
||
|
|
AddMethod('procedure Exchange(AObject1: TFmxObject; AObject2: TFmxObject)', CallMethod);
|
||
|
|
AddMethod('procedure DeleteChildren()', CallMethod);
|
||
|
|
AddMethod('procedure BringToFront()', CallMethod);
|
||
|
|
AddMethod('procedure SendToBack()', CallMethod);
|
||
|
|
AddMethod('procedure AddObjectsToList(AList: TList)', CallMethod);
|
||
|
|
{$IFNDEF DELPHI18}
|
||
|
|
AddMethod('procedure AddControlsToList(AList: TList)', CallMethod);
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFNDEF DELPHI20}
|
||
|
|
AddMethod('procedure GetTabOrderList(List: TList; AChildren: Boolean)', CallMethod);
|
||
|
|
{$ENDIF}
|
||
|
|
AddMethod('procedure LoadFromStream(AStream: TStream)', CallMethod);
|
||
|
|
AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
|
||
|
|
AddMethod('procedure LoadFromBinStream(AStream: TStream)', CallMethod);
|
||
|
|
AddMethod('procedure SaveToBinStream(AStream: TStream)', CallMethod);
|
||
|
|
AddMethod('function FindStyleResource(AStyleLookup: string): TFmxObject', CallMethod);
|
||
|
|
{$IFNDEF DELPHI18}
|
||
|
|
AddMethod('procedure UpdateStyle()', CallMethod);
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFNDEF DELPHI21}
|
||
|
|
AddMethod('procedure StartAnimation(AName: string)', CallMethod);
|
||
|
|
AddMethod('procedure StopAnimation(AName: string)', CallMethod);
|
||
|
|
AddMethod('procedure StartTriggerAnimation(AInstance: TFmxObject; ATrigger: string)', CallMethod);
|
||
|
|
AddMethod('procedure StartTriggerAnimationWait(AInstance: TFmxObject; ATrigger: string)', CallMethod);
|
||
|
|
{$IFDEF DELPHI17}
|
||
|
|
AddMethod('procedure StopTriggerAnimation(AInstance: TFmxObject; ATrigger: string)', CallMethod);
|
||
|
|
{$ELSE}
|
||
|
|
AddMethod('procedure StopTriggerAnimation(AInstance: TFmxObject)', CallMethod);
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
AddMethod('procedure ApplyTriggerEffect(AInstance: TFmxObject; ATrigger: string)', CallMethod);
|
||
|
|
{$ENDIF}
|
||
|
|
AddMethod('procedure AnimateFloat(APropertyName: string; NewValue: Single; Duration: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
|
||
|
|
AddMethod('procedure AnimateColor(APropertyName: string; NewValue: TAlphaColor; Duration: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
|
||
|
|
AddMethod('procedure AnimateFloatDelay(APropertyName: string; NewValue: Single; Duration: Single; Delay: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
|
||
|
|
AddMethod('procedure AnimateFloatWait(APropertyName: string; NewValue: Single; Duration: Single; AType: TAnimationType; AInterpolation: TInterpolationType)', CallMethod);
|
||
|
|
AddMethod('procedure StopPropertyAnimation(APropertyName: string)', CallMethod);
|
||
|
|
AddProperty('Parent', 'TFmxObject', GetProp, SetProp);
|
||
|
|
AddProperty('Index', 'Integer', GetProp, SetProp);
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
with AddClass(TfsXMLItem, 'TObject') do
|
||
|
|
begin
|
||
|
|
AddConstructor('constructor Create', CallMethod);
|
||
|
|
AddMethod('procedure AddItem(Item: TfsXMLItem)', CallMethod);
|
||
|
|
AddMethod('procedure Clear', CallMethod);
|
||
|
|
AddMethod('procedure InsertItem(Index: Integer; Item: TfsXMLItem)', CallMethod);
|
||
|
|
AddMethod('function Add: TfsXMLItem', CallMethod);
|
||
|
|
AddMethod('function Find(const Name: String): Integer', CallMethod);
|
||
|
|
AddMethod('function FindItem(const Name: String): TfsXMLItem', CallMethod);
|
||
|
|
AddMethod('function Root: TfsXMLItem', CallMethod);
|
||
|
|
AddProperty('Data', 'Integer', GetProp, SetProp);
|
||
|
|
AddProperty('Count', 'Integer', GetProp, nil);
|
||
|
|
AddDefaultProperty('Items', 'Integer', 'TfsXMLItem', CallMethod, True);
|
||
|
|
AddIndexProperty('Prop', 'String', 'String', CallMethod);
|
||
|
|
AddProperty('Name', 'String', GetProp, SetProp);
|
||
|
|
AddProperty('Parent', 'TfsXMLItem', GetProp, nil);
|
||
|
|
AddProperty('Text', 'String', GetProp, SetProp);
|
||
|
|
end;
|
||
|
|
with AddClass(TfsXMLDocument, 'TObject') do
|
||
|
|
begin
|
||
|
|
AddConstructor('constructor Create', CallMethod);
|
||
|
|
AddMethod('procedure SaveToStream(Stream: TStream)', CallMethod);
|
||
|
|
AddMethod('procedure LoadFromStream(Stream: TStream)', CallMethod);
|
||
|
|
AddMethod('procedure SaveToFile(const FileName: String)', CallMethod);
|
||
|
|
AddMethod('procedure LoadFromFile(const FileName: String)', CallMethod);
|
||
|
|
AddProperty('Root', 'TfsXMLItem', GetProp, nil);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
|
||
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
||
|
|
var
|
||
|
|
i: Integer;
|
||
|
|
s: String;
|
||
|
|
_TList: TList;
|
||
|
|
_TStrings: TStrings;
|
||
|
|
_TStream: TStream;
|
||
|
|
_TMemoryStream: TMemoryStream;
|
||
|
|
_TfsXMLItem: TfsXMLItem;
|
||
|
|
_TfsXMLDocument: TfsXMLDocument;
|
||
|
|
{$IFDEF FMX}
|
||
|
|
_fmxObj: TFmxObject;
|
||
|
|
{$ENDIF}
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
|
||
|
|
if ClassType = TObject then
|
||
|
|
begin
|
||
|
|
if MethodName = 'CREATE' then
|
||
|
|
{$IFDEF FPC}
|
||
|
|
begin
|
||
|
|
if Instance is TList then
|
||
|
|
Result := frxInteger(TList.Create)
|
||
|
|
else
|
||
|
|
Result := frxInteger(Instance.Create);
|
||
|
|
end
|
||
|
|
{$ELSE}
|
||
|
|
Result := frxInteger(Instance.Create)
|
||
|
|
{$ENDIF}
|
||
|
|
else if MethodName = 'FREE' then
|
||
|
|
Instance.Free
|
||
|
|
else if MethodName = 'CLASSNAME' then
|
||
|
|
Result := Instance.ClassName
|
||
|
|
end
|
||
|
|
else if ClassType = TPersistent then
|
||
|
|
begin
|
||
|
|
if MethodName = 'ASSIGN' then
|
||
|
|
TPersistent(Instance).Assign(TPersistent(frxInteger(Caller.Params[0])));
|
||
|
|
end
|
||
|
|
else if ClassType = TCollection then
|
||
|
|
begin
|
||
|
|
if MethodName = 'CLEAR' then
|
||
|
|
TCollection(Instance).Clear
|
||
|
|
else if MethodName = 'ITEMS.GET' then
|
||
|
|
Result := frxInteger(TCollection(Instance).Items[Caller.Params[0]])
|
||
|
|
end
|
||
|
|
else if ClassType = TList then
|
||
|
|
begin
|
||
|
|
_TList := TList(Instance);
|
||
|
|
if MethodName = 'ADD' then
|
||
|
|
_TList.Add(Pointer(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'CLEAR' then
|
||
|
|
_TList.Clear
|
||
|
|
else if MethodName = 'DELETE' then
|
||
|
|
_TList.Delete(Caller.Params[0])
|
||
|
|
else if MethodName = 'INDEXOF' then
|
||
|
|
Result := _TList.IndexOf(Pointer(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'INSERT' then
|
||
|
|
_TList.Insert(Caller.Params[0], Pointer(frxInteger(Caller.Params[1])))
|
||
|
|
else if MethodName = 'REMOVE' then
|
||
|
|
_TList.Remove(Pointer(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'ITEMS.GET' then
|
||
|
|
Result := frxInteger(_TList.Items[Caller.Params[0]])
|
||
|
|
else if MethodName = 'ITEMS.SET' then
|
||
|
|
_TList.Items[Caller.Params[0]] := Pointer(frxInteger(Caller.Params[1]))
|
||
|
|
end
|
||
|
|
else if ClassType = TStrings then
|
||
|
|
begin
|
||
|
|
_TStrings := TStrings(Instance);
|
||
|
|
if MethodName = 'CREATE' then
|
||
|
|
Result := frxInteger(_TStrings.Create)
|
||
|
|
else if MethodName = 'ADD' then
|
||
|
|
Result := _TStrings.Add(Caller.Params[0])
|
||
|
|
else if MethodName = 'ADDOBJECT' then
|
||
|
|
Result := _TStrings.AddObject(Caller.Params[0], TObject(frxInteger(Caller.Params[1])))
|
||
|
|
else if MethodName = 'CLEAR' then
|
||
|
|
_TStrings.Clear
|
||
|
|
else if MethodName = 'DELETE' then
|
||
|
|
_TStrings.Delete(Caller.Params[0])
|
||
|
|
else if MethodName = 'INDEXOF' then
|
||
|
|
Result := _TStrings.IndexOf(Caller.Params[0])
|
||
|
|
else if MethodName = 'INDEXOFNAME' then
|
||
|
|
Result := _TStrings.IndexOfName(Caller.Params[0])
|
||
|
|
else if MethodName = 'INDEXOFOBJECT' then
|
||
|
|
Result := _TStrings.IndexOfObject(TObject(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'INSERT' then
|
||
|
|
_TStrings.Insert(Caller.Params[0], Caller.Params[1])
|
||
|
|
else if MethodName = 'INSERTOBJECT' then
|
||
|
|
_TStrings.InsertObject(Caller.Params[0], Caller.Params[1], TObject(frxInteger(Caller.Params[2])))
|
||
|
|
else if MethodName = 'LOADFROMFILE' then
|
||
|
|
_TStrings.LoadFromFile(Caller.Params[0])
|
||
|
|
else if MethodName = 'LOADFROMSTREAM' then
|
||
|
|
_TStrings.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'MOVE' then
|
||
|
|
_TStrings.Move(Caller.Params[0], Caller.Params[1])
|
||
|
|
else if MethodName = 'SAVETOFILE' then
|
||
|
|
_TStrings.SaveToFile(Caller.Params[0])
|
||
|
|
else if MethodName = 'SAVETOSTREAM' then
|
||
|
|
_TStrings.SaveToStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'NAMES.GET' then
|
||
|
|
Result := _TStrings.Names[Caller.Params[0]]
|
||
|
|
else if MethodName = 'OBJECTS.GET' then
|
||
|
|
Result := frxInteger(_TStrings.Objects[Caller.Params[0]])
|
||
|
|
else if MethodName = 'OBJECTS.SET' then
|
||
|
|
_TStrings.Objects[Caller.Params[0]] := TObject(frxInteger(Caller.Params[1]))
|
||
|
|
else if MethodName = 'VALUES.GET' then
|
||
|
|
Result := _TStrings.Values[Caller.Params[0]]
|
||
|
|
else if MethodName = 'VALUES.SET' then
|
||
|
|
_TStrings.Values[Caller.Params[0]] := Caller.Params[1]
|
||
|
|
else if MethodName = 'STRINGS.GET' then
|
||
|
|
Result := _TStrings.Strings[Caller.Params[0]]
|
||
|
|
else if MethodName = 'STRINGS.SET' then
|
||
|
|
_TStrings.Strings[Caller.Params[0]] := Caller.Params[1]
|
||
|
|
end
|
||
|
|
else if ClassType = TStringList then
|
||
|
|
begin
|
||
|
|
if MethodName = 'FIND' then
|
||
|
|
begin
|
||
|
|
Result := TStringList(Instance).Find(Caller.Params[0], i);
|
||
|
|
Caller.Params[1] := i;
|
||
|
|
end
|
||
|
|
else if MethodName = 'SORT' then
|
||
|
|
TStringList(Instance).Sort
|
||
|
|
end
|
||
|
|
else if ClassType = TStream then
|
||
|
|
begin
|
||
|
|
_TStream := TStream(Instance);
|
||
|
|
if MethodName = 'READ' then
|
||
|
|
begin
|
||
|
|
SetLength(s, Integer(Caller.Params[1]));
|
||
|
|
Result := _TStream.Read(s[1], Caller.Params[1]);
|
||
|
|
SetLength(s, Integer(Result));
|
||
|
|
Caller.Params[0] := s;
|
||
|
|
end
|
||
|
|
else if MethodName = 'WRITE' then
|
||
|
|
begin
|
||
|
|
s := Caller.Params[0];
|
||
|
|
Result := _TStream.Write(s[1], Caller.Params[1]);
|
||
|
|
end
|
||
|
|
else if MethodName = 'SEEK' then
|
||
|
|
{$IFDEF DELPHI18}
|
||
|
|
Result := _TStream.Seek(Int64(Caller.Params[0]), Word(Caller.Params[1]))
|
||
|
|
{$ELSE}
|
||
|
|
{$IFDEF FPC}
|
||
|
|
Result := _TStream.Seek(Int64(Caller.Params[0]), Word(Caller.Params[1]))
|
||
|
|
{$ELSE}
|
||
|
|
Result := _TStream.Seek(Caller.Params[0], Caller.Params[1])
|
||
|
|
{$ENDIF}
|
||
|
|
{$ENDIF}
|
||
|
|
else if MethodName = 'COPYFROM' then
|
||
|
|
Result := _TStream.CopyFrom(TStream(frxInteger(Caller.Params[0])), Caller.Params[1])
|
||
|
|
end
|
||
|
|
else if ClassType = TFileStream then
|
||
|
|
begin
|
||
|
|
if MethodName = 'CREATE' then
|
||
|
|
Result := frxInteger(TFileStream(Instance).Create(Caller.Params[0], Caller.Params[1]))
|
||
|
|
end
|
||
|
|
else if ClassType = TMemoryStream then
|
||
|
|
begin
|
||
|
|
_TMemoryStream := TMemoryStream(Instance);
|
||
|
|
if MethodName = 'CLEAR' then
|
||
|
|
_TMemoryStream.Clear
|
||
|
|
else if MethodName = 'LOADFROMSTREAM' then
|
||
|
|
_TMemoryStream.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'LOADFROMFILE' then
|
||
|
|
_TMemoryStream.LoadFromFile(Caller.Params[0])
|
||
|
|
else if MethodName = 'SAVETOSTREAM' then
|
||
|
|
_TMemoryStream.SaveToStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'SAVETOFILE' then
|
||
|
|
_TMemoryStream.SaveToFile(Caller.Params[0])
|
||
|
|
end
|
||
|
|
else if ClassType = TComponent then
|
||
|
|
begin
|
||
|
|
if MethodName = 'CREATE' then
|
||
|
|
Result := frxInteger(TComponent(Instance).Create(TComponent(frxInteger(Caller.Params[0]))))
|
||
|
|
end
|
||
|
|
else if ClassType = TfsXMLItem then
|
||
|
|
begin
|
||
|
|
_TfsXMLItem := TfsXMLItem(Instance);
|
||
|
|
if MethodName = 'CREATE' then
|
||
|
|
Result := frxInteger(_TfsXMLItem.Create)
|
||
|
|
else if MethodName = 'ADDITEM' then
|
||
|
|
_TfsXMLItem.AddItem(TfsXMLItem(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'CLEAR' then
|
||
|
|
_TfsXMLItem.Clear
|
||
|
|
else if MethodName = 'INSERTITEM' then
|
||
|
|
_TfsXMLItem.InsertItem(Caller.Params[0], TfsXMLItem(frxInteger(Caller.Params[1])))
|
||
|
|
else if MethodName = 'ADD' then
|
||
|
|
Result := frxInteger(_TfsXMLItem.Add)
|
||
|
|
else if MethodName = 'FIND' then
|
||
|
|
Result := _TfsXMLItem.Find(Caller.Params[0])
|
||
|
|
else if MethodName = 'FINDITEM' then
|
||
|
|
Result := frxInteger(_TfsXMLItem.FindItem(Caller.Params[0]))
|
||
|
|
else if MethodName = 'PROP.GET' then
|
||
|
|
Result := _TfsXMLItem.Prop[Caller.Params[0]]
|
||
|
|
else if MethodName = 'PROP.SET' then
|
||
|
|
_TfsXMLItem.Prop[Caller.Params[0]] := Caller.Params[1]
|
||
|
|
else if MethodName = 'ROOT' then
|
||
|
|
Result := frxInteger(_TfsXMLItem.Root)
|
||
|
|
else if MethodName = 'ROOT' then
|
||
|
|
Result := frxInteger(_TfsXMLItem.Root)
|
||
|
|
else if MethodName = 'ITEMS.GET' then
|
||
|
|
Result := frxInteger(_TfsXMLItem[Caller.Params[0]])
|
||
|
|
end
|
||
|
|
else if ClassType = TfsXMLDocument then
|
||
|
|
begin
|
||
|
|
_TfsXMLDocument := TfsXMLDocument(Instance);
|
||
|
|
if MethodName = 'CREATE' then
|
||
|
|
Result := frxInteger(_TfsXMLDocument.Create)
|
||
|
|
else if MethodName = 'SAVETOSTREAM' then
|
||
|
|
_TfsXMLDocument.SaveToStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'LOADFROMSTREAM' then
|
||
|
|
_TfsXMLDocument.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'SAVETOFILE' then
|
||
|
|
_TfsXMLDocument.SaveToFile(Caller.Params[0])
|
||
|
|
else if MethodName = 'LOADFROMFILE' then
|
||
|
|
_TfsXMLDocument.LoadFromFile(Caller.Params[0])
|
||
|
|
end
|
||
|
|
{$IFDEF FMX}
|
||
|
|
else if ClassType = TFmxObject then
|
||
|
|
begin
|
||
|
|
_fmxObj := TFmxObject(Instance);
|
||
|
|
if MethodName = 'CLONE' then
|
||
|
|
Result := frxInteger(_fmxObj.Clone(TComponent(frxInteger(Caller.Params[0]))))
|
||
|
|
// else if MethodName = 'CLONECHILDFROMSTREAM' then
|
||
|
|
// _fmxObj.CloneChildFromStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'ADDOBJECT' then
|
||
|
|
_fmxObj.AddObject(TFmxObject(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'INSERTOBJECT' then
|
||
|
|
_fmxObj.InsertObject(Integer(Caller.Params[0]), TFmxObject(frxInteger(Caller.Params[1])))
|
||
|
|
else if MethodName = 'REMOVEOBJECT' then
|
||
|
|
_fmxObj.RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'REMOVEOBJECT' then
|
||
|
|
_fmxObj.RemoveObject(Integer(Caller.Params[0]))
|
||
|
|
else if MethodName = 'EXCHANGE' then
|
||
|
|
_fmxObj.Exchange(TFmxObject(frxInteger(Caller.Params[0])), TFmxObject(frxInteger(Caller.Params[1])))
|
||
|
|
else if MethodName = 'DELETECHILDREN' then
|
||
|
|
_fmxObj.DeleteChildren()
|
||
|
|
else if MethodName = 'BRINGTOFRONT' then
|
||
|
|
_fmxObj.BringToFront()
|
||
|
|
else if MethodName = 'SENDTOBACK' then
|
||
|
|
_fmxObj.SendToBack()
|
||
|
|
{$IFDEF DELPHI17}
|
||
|
|
else if MethodName = 'ADDOBJECTSTOLIST' then
|
||
|
|
_fmxObj.AddObjectsToList(TFmxObjectList(frxInteger(Caller.Params[0])))
|
||
|
|
{$IFNDEF DELPHI18}
|
||
|
|
else if MethodName = 'ADDCONTROLSTOLIST' then
|
||
|
|
_fmxObj.AddControlsToList(TFmxObjectList(frxInteger(Caller.Params[0])))
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFNDEF DELPHI20}
|
||
|
|
else if MethodName = 'GETTABORDERLIST' then
|
||
|
|
_fmxObj.GetTabOrderList(TInterfaceList(frxInteger(Caller.Params[0])), Boolean(Caller.Params[1]))
|
||
|
|
{$ENDIF}
|
||
|
|
{$ELSE}
|
||
|
|
else if MethodName = 'ADDOBJECTSTOLIST' then
|
||
|
|
_fmxObj.AddObjectsToList(TList(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'ADDCONTROLSTOLIST' then
|
||
|
|
_fmxObj.AddControlsToList(TList(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'GETTABORDERLIST' then
|
||
|
|
_fmxObj.GetTabOrderList(TList(frxInteger(Caller.Params[0])), Boolean(Caller.Params[1]))
|
||
|
|
else if MethodName = 'LOADFROMSTREAM' then
|
||
|
|
_fmxObj.LoadFromStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'SAVETOSTREAM' then
|
||
|
|
_fmxObj.SaveToStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'LOADFROMBINSTREAM' then
|
||
|
|
_fmxObj.LoadFromBinStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'SAVETOBINSTREAM' then
|
||
|
|
_fmxObj.SaveToBinStream(TStream(frxInteger(Caller.Params[0])))
|
||
|
|
{$ENDIF}
|
||
|
|
else if MethodName = 'FINDSTYLERESOURCE' then
|
||
|
|
Result := frxInteger(_fmxObj.FindStyleResource(string(Caller.Params[0])))
|
||
|
|
{$IFNDEF DELPHI18}
|
||
|
|
else if MethodName = 'UPDATESTYLE' then
|
||
|
|
_fmxObj.UpdateStyle()
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFNDEF DELPHI21}
|
||
|
|
else if MethodName = 'STARTANIMATION' then
|
||
|
|
_fmxObj.StartAnimation(string(Caller.Params[0]))
|
||
|
|
else if MethodName = 'STOPANIMATION' then
|
||
|
|
_fmxObj.StopAnimation(string(Caller.Params[0]))
|
||
|
|
else if MethodName = 'STARTTRIGGERANIMATION' then
|
||
|
|
_fmxObj.StartTriggerAnimation(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
|
||
|
|
else if MethodName = 'STARTTRIGGERANIMATIONWAIT' then
|
||
|
|
_fmxObj.StartTriggerAnimationWait(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
|
||
|
|
else if MethodName = 'STOPTRIGGERANIMATION' then
|
||
|
|
{$IFDEF DELPHI17}
|
||
|
|
_fmxObj.StopTriggerAnimation(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
|
||
|
|
{$ELSE}
|
||
|
|
_fmxObj.StopTriggerAnimation(TFmxObject(frxInteger(Caller.Params[0])))
|
||
|
|
{$ENDIF}
|
||
|
|
else if MethodName = 'APPLYTRIGGEREFFECT' then
|
||
|
|
_fmxObj.ApplyTriggerEffect(TFmxObject(frxInteger(Caller.Params[0])), string(Caller.Params[1]))
|
||
|
|
{$ENDIF}
|
||
|
|
else if MethodName = 'ANIMATEFLOAT' then
|
||
|
|
_fmxObj.AnimateFloat(string(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), TAnimationType(Caller.Params[3]), TInterpolationType(Caller.Params[4]))
|
||
|
|
else if MethodName = 'ANIMATECOLOR' then
|
||
|
|
_fmxObj.AnimateColor(string(Caller.Params[0]), TAlphaColor(Caller.Params[1]), Single(Caller.Params[2]), TAnimationType(Caller.Params[3]), TInterpolationType(Caller.Params[4]))
|
||
|
|
else if MethodName = 'ANIMATEFLOATDELAY' then
|
||
|
|
_fmxObj.AnimateFloatDelay(string(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), Single(Caller.Params[3]), TAnimationType(Caller.Params[4]), TInterpolationType(Caller.Params[5]))
|
||
|
|
else if MethodName = 'ANIMATEFLOATWAIT' then
|
||
|
|
_fmxObj.AnimateFloatWait(string(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), TAnimationType(Caller.Params[3]), TInterpolationType(Caller.Params[4]))
|
||
|
|
else if MethodName = 'STOPPROPERTYANIMATION' then
|
||
|
|
_fmxObj.StopPropertyAnimation(string(Caller.Params[0]))
|
||
|
|
end;
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
|
||
|
|
const PropName: String): Variant;
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
|
||
|
|
if ClassType = TCollection then
|
||
|
|
begin
|
||
|
|
if PropName = 'COUNT' then
|
||
|
|
Result := TCollection(Instance).Count
|
||
|
|
end
|
||
|
|
else if ClassType = TList then
|
||
|
|
begin
|
||
|
|
if PropName = 'COUNT' then
|
||
|
|
Result := TList(Instance).Count
|
||
|
|
end
|
||
|
|
else if ClassType = TStrings then
|
||
|
|
begin
|
||
|
|
if PropName = 'COMMATEXT' then
|
||
|
|
Result := TStrings(Instance).CommaText
|
||
|
|
else if PropName = 'COUNT' then
|
||
|
|
Result := TStrings(Instance).Count
|
||
|
|
else if PropName = 'TEXT' then
|
||
|
|
Result := TStrings(Instance).Text
|
||
|
|
end
|
||
|
|
else if ClassType = TStringList then
|
||
|
|
begin
|
||
|
|
if PropName = 'DUPLICATES' then
|
||
|
|
Result := TStringList(Instance).Duplicates
|
||
|
|
else if PropName = 'SORTED' then
|
||
|
|
Result := TStringList(Instance).Sorted
|
||
|
|
end
|
||
|
|
else if ClassType = TStream then
|
||
|
|
begin
|
||
|
|
if PropName = 'POSITION' then
|
||
|
|
Result := TStream(Instance).Position
|
||
|
|
else if PropName = 'SIZE' then
|
||
|
|
Result := TStream(Instance).Size
|
||
|
|
end
|
||
|
|
else if ClassType = TComponent then
|
||
|
|
begin
|
||
|
|
if PropName = 'OWNER' then
|
||
|
|
Result := frxInteger(TComponent(Instance).Owner)
|
||
|
|
end
|
||
|
|
else if ClassType = TfsXMLItem then
|
||
|
|
begin
|
||
|
|
if PropName = 'DATA' then
|
||
|
|
Result := frxInteger(TfsXMLItem(Instance).Data)
|
||
|
|
else if PropName = 'COUNT' then
|
||
|
|
Result := TfsXMLItem(Instance).Count
|
||
|
|
else if PropName = 'NAME' then
|
||
|
|
Result := TfsXMLItem(Instance).Name
|
||
|
|
else if PropName = 'PARENT' then
|
||
|
|
Result := frxInteger(TfsXMLItem(Instance).Parent)
|
||
|
|
else if PropName = 'TEXT' then
|
||
|
|
Result := TfsXMLItem(Instance).Text
|
||
|
|
end
|
||
|
|
else if ClassType = TfsXMLDocument then
|
||
|
|
begin
|
||
|
|
if PropName = 'ROOT' then
|
||
|
|
Result := frxInteger(TfsXMLDocument(Instance).Root)
|
||
|
|
end
|
||
|
|
{$IFDEF FMX}
|
||
|
|
else if ClassType = TFmxObject then
|
||
|
|
begin
|
||
|
|
if PropName = 'PARENT' then
|
||
|
|
Result := frxInteger(TFmxObject(Instance).Parent)
|
||
|
|
else if PropName = 'INDEX' then
|
||
|
|
Result := TFmxObject(Instance).Index
|
||
|
|
end
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
|
||
|
|
const PropName: String; Value: Variant);
|
||
|
|
begin
|
||
|
|
if ClassType = TStrings then
|
||
|
|
begin
|
||
|
|
if PropName = 'COMMATEXT' then
|
||
|
|
TStrings(Instance).CommaText := Value
|
||
|
|
else if PropName = 'TEXT' then
|
||
|
|
TStrings(Instance).Text := Value
|
||
|
|
end
|
||
|
|
else if ClassType = TStringList then
|
||
|
|
begin
|
||
|
|
if PropName = 'DUPLICATES' then
|
||
|
|
TStringList(Instance).Duplicates := Value
|
||
|
|
else if PropName = 'SORTED' then
|
||
|
|
TStringList(Instance).Sorted := Value
|
||
|
|
end
|
||
|
|
else if ClassType = TStream then
|
||
|
|
begin
|
||
|
|
if PropName = 'POSITION' then
|
||
|
|
TStream(Instance).Position := Value
|
||
|
|
end
|
||
|
|
else if ClassType = TfsXMLItem then
|
||
|
|
begin
|
||
|
|
if PropName = 'DATA' then
|
||
|
|
TfsXMLItem(Instance).Data := Pointer(frxInteger(Value))
|
||
|
|
else if PropName = 'NAME' then
|
||
|
|
TfsXMLItem(Instance).Name := Value
|
||
|
|
else if PropName = 'TEXT' then
|
||
|
|
TfsXMLItem(Instance).Text := Value
|
||
|
|
end
|
||
|
|
{$IFDEF FMX}
|
||
|
|
else if ClassType = TFmxObject then
|
||
|
|
begin
|
||
|
|
if PropName = 'PARENT' then
|
||
|
|
TFmxObject(Instance).Parent := TFmxObject(frxInteger(Value))
|
||
|
|
else if PropName = 'INDEX' then
|
||
|
|
TFmxObject(Instance).Index := Value
|
||
|
|
end
|
||
|
|
{$ENDIF}
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
initialization
|
||
|
|
{$IFDEF DELPHI16}
|
||
|
|
{$IFDEF FMX}
|
||
|
|
StartClassGroup(TFmxObject);
|
||
|
|
ActivateClassGroup(TFmxObject);
|
||
|
|
GroupDescendentsWith(TfsClassesRTTI, TFmxObject);
|
||
|
|
{$ELSE}
|
||
|
|
StartClassGroup(TControl);
|
||
|
|
ActivateClassGroup(TControl);
|
||
|
|
GroupDescendentsWith(TfsClassesRTTI, TControl);
|
||
|
|
{$ENDIF}
|
||
|
|
{$ENDIF}
|
||
|
|
fsRTTIModules.Add(TFunctions);
|
||
|
|
|
||
|
|
finalization
|
||
|
|
fsRTTIModules.Remove(TFunctions);
|
||
|
|
|
||
|
|
end.
|