865 lines
38 KiB
ObjectPascal
865 lines
38 KiB
ObjectPascal
|
|
||
|
|
{******************************************}
|
||
|
|
{ }
|
||
|
|
{ FastScript v1.9 }
|
||
|
|
{ Forms and StdCtrls }
|
||
|
|
{ }
|
||
|
|
{ (c) 2003-2007 by Alexander Tzyganenko, }
|
||
|
|
{ Fast Reports Inc }
|
||
|
|
{ }
|
||
|
|
{******************************************}
|
||
|
|
|
||
|
|
unit FMX.fs_iformsrtti;
|
||
|
|
|
||
|
|
interface
|
||
|
|
|
||
|
|
{$i fs.inc}
|
||
|
|
|
||
|
|
uses
|
||
|
|
System.SysUtils, System.Classes, FMX.fs_iinterpreter, FMX.fs_ievents, FMX.fs_iclassesrtti,
|
||
|
|
FMX.fs_igraphicsrtti, FMX.Types, FMX.Controls, FMX.Forms, System.UITypes, System.Types,
|
||
|
|
FMX.Edit, FMX.Memo, FMX.ListBox, FMX.Layouts
|
||
|
|
{$IFDEF DELPHI18}
|
||
|
|
, FMX.StdCtrls
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFDEF DELPHI19}
|
||
|
|
, FMX.Graphics
|
||
|
|
{$ENDIF}
|
||
|
|
{$IFDEF DELPHI28}
|
||
|
|
, FMX.BaseTypeAliases, FMX.FormTypeAliases
|
||
|
|
{$ENDIF}
|
||
|
|
;
|
||
|
|
|
||
|
|
type
|
||
|
|
{$i frxPlatformsAttribute.inc}
|
||
|
|
TfsFormsRTTI = class(TComponent); // fake component
|
||
|
|
|
||
|
|
|
||
|
|
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;
|
||
|
|
|
||
|
|
|
||
|
|
|
||
|
|
{ TFunctions }
|
||
|
|
|
||
|
|
constructor TFunctions.Create(AScript: TfsScript);
|
||
|
|
begin
|
||
|
|
inherited Create(AScript);
|
||
|
|
with AScript do
|
||
|
|
begin
|
||
|
|
AddConst('mrNone', 'Integer', mrNone);
|
||
|
|
AddConst('mrOk', 'Integer', mrOk);
|
||
|
|
AddConst('mrCancel', 'Integer', mrCancel);
|
||
|
|
AddConst('mrAbort', 'Integer', mrAbort);
|
||
|
|
AddConst('mrRetry', 'Integer', mrRetry);
|
||
|
|
AddConst('mrIgnore', 'Integer', mrIgnore);
|
||
|
|
AddConst('mrYes', 'Integer', mrYes);
|
||
|
|
AddConst('mrNo', 'Integer', mrNo);
|
||
|
|
AddConst('mrAll', 'Integer', mrAll);
|
||
|
|
AddConst('mrNoToAll', 'Integer', mrNoToAll);
|
||
|
|
AddConst('mrYesToAll', 'Integer', mrYesToAll);
|
||
|
|
|
||
|
|
AddConst('crDefault', 'Integer', crDefault);
|
||
|
|
AddConst('crNone', 'Integer', crNone);
|
||
|
|
AddConst('crArrow', 'Integer', crArrow);
|
||
|
|
AddConst('crCross', 'Integer', crCross);
|
||
|
|
AddConst('crIBeam', 'Integer', crIBeam);
|
||
|
|
AddConst('crSize', 'Integer', crSize);
|
||
|
|
AddConst('crSizeNESW', 'Integer', crSizeNESW);
|
||
|
|
AddConst('crSizeNS', 'Integer', crSizeNS);
|
||
|
|
AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
|
||
|
|
AddConst('crSizeWE', 'Integer', crSizeWE);
|
||
|
|
AddConst('crUpArrow', 'Integer', crUpArrow);
|
||
|
|
AddConst('crHourGlass', 'Integer', crHourGlass);
|
||
|
|
AddConst('crDrag', 'Integer', crDrag);
|
||
|
|
AddConst('crNoDrop', 'Integer', crNoDrop);
|
||
|
|
AddConst('crHSplit', 'Integer', crHSplit);
|
||
|
|
AddConst('crVSplit', 'Integer', crVSplit);
|
||
|
|
AddConst('crMultiDrag', 'Integer', crMultiDrag);
|
||
|
|
AddConst('crSQLWait', 'Integer', crSQLWait);
|
||
|
|
AddConst('crNo', 'Integer', crNo);
|
||
|
|
AddConst('crAppStart', 'Integer', crAppStart);
|
||
|
|
AddConst('crHelp', 'Integer', crHelp);
|
||
|
|
AddConst('crHandPoint', 'Integer', crHandPoint);
|
||
|
|
AddConst('crSizeAll', 'Integer', crSizeAll);
|
||
|
|
|
||
|
|
{$IFDEF CLX}
|
||
|
|
AddConst('bsNone', 'Integer', fbsNone);
|
||
|
|
AddConst('bsSingle', 'Integer', fbsSingle);
|
||
|
|
AddConst('bsSizeable', 'Integer', fbsSizeable);
|
||
|
|
AddConst('bsDialog', 'Integer', fbsDialog);
|
||
|
|
AddConst('bsToolWindow', 'Integer', fbsToolWindow);
|
||
|
|
AddConst('bsSizeToolWin', 'Integer', fbsSizeToolWin);
|
||
|
|
{$ELSE}
|
||
|
|
AddConst('bsNone', 'Integer', TFmxFormBorderStyle.bsNone);
|
||
|
|
AddConst('bsSingle', 'Integer', TFmxFormBorderStyle.bsSingle);
|
||
|
|
AddConst('bsSizeable', 'Integer', TFmxFormBorderStyle.bsSizeable);
|
||
|
|
AddConst('bsToolWindow', 'Integer', TFmxFormBorderStyle.bsToolWindow);
|
||
|
|
AddConst('bsSizeToolWin', 'Integer', TFmxFormBorderStyle.bsSizeToolWin);
|
||
|
|
{$ENDIF}
|
||
|
|
|
||
|
|
AddConst('VK_RBUTTON', 'Integer', VKRBUTTON);
|
||
|
|
AddConst('VKCANCEL', 'Integer', VKCANCEL);
|
||
|
|
AddConst('VKMBUTTON', 'Integer', VKMBUTTON);
|
||
|
|
AddConst('VKBACK', 'Integer', VKBACK);//Backspace key
|
||
|
|
AddConst('VKTAB', 'Integer', VKTAB);//Tab key
|
||
|
|
AddConst('VKRETURN', 'Integer', VKRETURN);//Enter key
|
||
|
|
AddConst('VKSHIFT', 'Integer', VKSHIFT);//Shift key
|
||
|
|
AddConst('VKCONTROL', 'Integer', VKCONTROL);//Ctrl key
|
||
|
|
AddConst('VKMENU', 'Integer', VKMENU);//Alt key
|
||
|
|
AddConst('VKPAUSE', 'Integer', VKPAUSE);//Pause key
|
||
|
|
AddConst('VKCAPITAL', 'Integer', VKCAPITAL);//Caps Lock key
|
||
|
|
AddConst('VKESCAPE', 'Integer', VKESCAPE);//Esc key
|
||
|
|
AddConst('VKSPACE', 'Integer', VKSPACE);//Space bar
|
||
|
|
AddConst('VKPRIOR', 'Integer', VKPRIOR);//Page Up key
|
||
|
|
AddConst('VKNEXT', 'Integer', VKNEXT);// Page Down key
|
||
|
|
AddConst('VKEND', 'Integer', VKEND);// End key
|
||
|
|
AddConst('VKHOME', 'Integer', VKHOME);// Home key
|
||
|
|
AddConst('VKLEFT', 'Integer', VKLEFT);// Left Arrow key
|
||
|
|
AddConst('VKUP', 'Integer', VKUP);// Up Arrow key
|
||
|
|
AddConst('VKRIGHT', 'Integer', VKRIGHT);// Right Arrow key
|
||
|
|
AddConst('VKDOWN', 'Integer', VKDOWN);// Down Arrow key
|
||
|
|
AddConst('VKINSERT', 'Integer', VKINSERT);// Insert key
|
||
|
|
AddConst('VKDELETE', 'Integer', VKDELETE);// Delete key
|
||
|
|
AddConst('VKHELP', 'Integer', VKHELP);// Help key
|
||
|
|
AddConst('VKLWIN', 'Integer', VKLWIN);// Left Windows key (Microsoft keyboard)
|
||
|
|
AddConst('VKRWIN', 'Integer', VKRWIN);// Right Windows key (Microsoft keyboard)
|
||
|
|
AddConst('VKAPPS', 'Integer', VKAPPS);// Applications key (Microsoft keyboard)
|
||
|
|
AddConst('VKNUMPAD0', 'Integer', VKNUMPAD0);// 0 key (numeric keypad)
|
||
|
|
AddConst('VKNUMPAD1', 'Integer', VKNUMPAD1);// 1 key (numeric keypad)
|
||
|
|
AddConst('VKNUMPAD2', 'Integer', VKNUMPAD2);// 2 key (numeric keypad)
|
||
|
|
AddConst('VKNUMPAD3', 'Integer', VKNUMPAD3);// 3 key (numeric keypad)
|
||
|
|
AddConst('VKNUMPAD4', 'Integer', VKNUMPAD4);// 4 key (numeric keypad)
|
||
|
|
AddConst('VKNUMPAD5', 'Integer', VKNUMPAD5);// 5 key (numeric keypad)
|
||
|
|
AddConst('VKNUMPAD6', 'Integer', VKNUMPAD6);// 6 key (numeric keypad)
|
||
|
|
AddConst('VKNUMPAD7', 'Integer', VKNUMPAD7);// 7 key (numeric keypad)
|
||
|
|
AddConst('VKNUMPAD8', 'Integer', VKNUMPAD8);// 8 key (numeric keypad)
|
||
|
|
AddConst('VKNUMPAD9', 'Integer', VKNUMPAD9);// 9 key (numeric keypad)
|
||
|
|
AddConst('VKMULTIPLY', 'Integer', VKMULTIPLY);// Multiply key (numeric keypad)
|
||
|
|
AddConst('VKADD', 'Integer', VKADD);// Add key (numeric keypad)
|
||
|
|
AddConst('VKSEPARATOR', 'Integer', VKSEPARATOR);// Separator key (numeric keypad)
|
||
|
|
AddConst('VKSUBTRACT', 'Integer', VKSUBTRACT);// Subtract key (numeric keypad)
|
||
|
|
AddConst('VKDECIMAL', 'Integer', VKDECIMAL);// Decimal key (numeric keypad)
|
||
|
|
AddConst('VKDIVIDE', 'Integer', VKDIVIDE);// Divide key (numeric keypad)
|
||
|
|
AddConst('VKF1', 'Integer', VKF1);// F1 key
|
||
|
|
AddConst('VKF2', 'Integer', VKF2);// F2 key
|
||
|
|
AddConst('VKF3', 'Integer', VKF3);// F3 key
|
||
|
|
AddConst('VKF4', 'Integer', VKF4);// F4 key
|
||
|
|
AddConst('VKF5', 'Integer', VKF5);// F5 key
|
||
|
|
AddConst('VKF6', 'Integer', VKF6);// F6 key
|
||
|
|
AddConst('VKF7', 'Integer', VKF7);// F7 key
|
||
|
|
AddConst('VKF8', 'Integer', VKF8);// F8 key
|
||
|
|
AddConst('VKF9', 'Integer', VKF9);// F9 key
|
||
|
|
AddConst('VKF10', 'Integer', VKF10);// F10 key
|
||
|
|
AddConst('VKF11', 'Integer', VKF11);// F11 key
|
||
|
|
AddConst('VKF12', 'Integer', VKF12);// F12 key
|
||
|
|
AddConst('VKNUMLOCK', 'Integer', VKNUMLOCK);// Num Lock key
|
||
|
|
AddConst('VKSCROLL', 'Integer', VKSCROLL);// Scroll Lock key
|
||
|
|
|
||
|
|
AddConst('crDefault', 'Integer', crDefault);
|
||
|
|
AddConst('crNone', 'Integer', crNone);
|
||
|
|
AddConst('crArrow', 'Integer', crArrow);
|
||
|
|
AddConst('crCross', 'Integer', crCross);
|
||
|
|
AddConst('crIBeam', 'Integer', crIBeam);
|
||
|
|
AddConst('crSize', 'Integer', crSize);
|
||
|
|
AddConst('crSizeNESW', 'Integer', crSizeNESW);
|
||
|
|
AddConst('crSizeNS', 'Integer', crSizeNS);
|
||
|
|
AddConst('crSizeNWSE', 'Integer', crSizeNWSE);
|
||
|
|
AddConst('crSizeWE', 'Integer', crSizeWE);
|
||
|
|
AddConst('crUpArrow', 'Integer', crUpArrow);
|
||
|
|
AddConst('crHourGlass', 'Integer', crHourGlass);
|
||
|
|
AddConst('crDrag', 'Integer', crDrag);
|
||
|
|
AddConst('crNoDrop', 'Integer', crNoDrop);
|
||
|
|
AddConst('crHSplit', 'Integer', crHSplit);
|
||
|
|
AddConst('crVSplit', 'Integer', crVSplit);
|
||
|
|
AddConst('crMultiDrag', 'Integer', crMultiDrag);
|
||
|
|
AddConst('crSQLWait', 'Integer', crSQLWait);
|
||
|
|
AddConst('crNo', 'Integer', crNo);
|
||
|
|
AddConst('crAppStart', 'Integer', crAppStart);
|
||
|
|
AddConst('crHelp', 'Integer', crHelp);
|
||
|
|
AddConst('crHandPoint', 'Integer', crHandPoint);
|
||
|
|
AddConst('crSizeAll', 'Integer', crSizeAll);
|
||
|
|
|
||
|
|
AddType('TFormBorderStyle', fvtInt);
|
||
|
|
AddType('TBorderStyle', fvtInt);
|
||
|
|
|
||
|
|
AddEnumSet('TShiftState', 'ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble, ssTouch, ssPen, ssCommand');
|
||
|
|
AddEnum('TAniIndicatorStyle', 'aiLinear, aiCircular');
|
||
|
|
AddEnum('TAlign', 'alNone, alTop, alBottom, alLeft, alRight, alClient');
|
||
|
|
AddEnum('TMouseButton', 'mbLeft, mbRight, mbMiddle');
|
||
|
|
AddEnumSet('TAnchors', 'akLeft, akTop, akRight, akBottom');
|
||
|
|
AddEnum('TBevelCut', 'bvNone, bvLowered, bvRaised, bvSpace');
|
||
|
|
AddEnum('TTextLayout', 'tlTop, tlCenter, tlBottom');
|
||
|
|
AddEnum('TEditCharCase', 'ecNormal, ecUpperCase, ecLowerCase');
|
||
|
|
AddEnum('TScrollStyle', 'ssNone, ssHorizontal, ssVertical, ssBoth');
|
||
|
|
AddEnum('TComboBoxStyle', 'csDropDown, csSimple, csDropDownList, csOwnerDrawFixed, csOwnerDrawVariable');
|
||
|
|
AddEnum('TCheckBoxState', 'cbUnchecked, cbChecked, cbGrayed');
|
||
|
|
AddEnum('TListBoxStyle', 'lbStandard, lbOwnerDrawFixed, lbOwnerDrawVariable');
|
||
|
|
AddEnum('TWindowState', 'wsNormal, wsMinimized, wsMaximized');
|
||
|
|
AddEnum('TFormStyle', 'fsNormal, fsMDIChild, fsMDIForm, fsStayOnTop');
|
||
|
|
AddEnumSet('TBorderIcons', 'biSystemMenu, biMinimize, biMaximize, biHelp');
|
||
|
|
AddEnum('TFormPosition', 'poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly, poScreenCenter, poDesktopCenter');
|
||
|
|
AddEnum('TCloseAction', 'caNone, caHide, caFree, caMinimize');
|
||
|
|
|
||
|
|
with AddClass(TControl, 'TFmxObject') do
|
||
|
|
begin
|
||
|
|
AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
|
||
|
|
AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
|
||
|
|
AddMethod('procedure SetBounds(X: Single; Y: Single; AWidth: Single; AHeight: Single)', CallMethod);
|
||
|
|
AddMethod('function AbsoluteToLocal(P: TfsPointF): TfsPointF', CallMethod);
|
||
|
|
AddMethod('function LocalToAbsolute(P: TfsPointF): TfsPointF', CallMethod);
|
||
|
|
AddMethod('function AbsoluteToLocalVector(P: TfsVector): TfsVector', CallMethod);
|
||
|
|
AddMethod('function LocalToAbsoluteVector(P: TfsVector): TfsVector', CallMethod);
|
||
|
|
AddMethod('function PointInObject(X: Single; Y: Single): Boolean', CallMethod);
|
||
|
|
AddMethod('procedure BeginUpdate()', CallMethod);
|
||
|
|
AddMethod('procedure EndUpdate()', CallMethod);
|
||
|
|
{$IFNDEF DELPHI18}
|
||
|
|
AddMethod('procedure ApplyEffect()', CallMethod);
|
||
|
|
{$ENDIF}
|
||
|
|
AddMethod('procedure UpdateEffects()', CallMethod);
|
||
|
|
AddMethod('procedure SetFocus()', CallMethod);
|
||
|
|
AddMethod('procedure PaintTo(ACanvas: TCanvas; ARect: TFsRectF; AParent: TFmxObject)', CallMethod);
|
||
|
|
AddMethod('procedure Repaint()', CallMethod);
|
||
|
|
AddMethod('procedure InvalidateRect(ARect: TfsRectF)', CallMethod);
|
||
|
|
AddMethod('procedure Lock()', CallMethod);
|
||
|
|
AddProperty('AbsoluteMatrix', 'TfsMatrix', GetProp, nil);
|
||
|
|
AddProperty('AbsoluteOpacity', 'Single', GetProp, nil);
|
||
|
|
AddProperty('AbsoluteWidth', 'Single', GetProp, nil);
|
||
|
|
AddProperty('AbsoluteHeight', 'Single', GetProp, nil);
|
||
|
|
AddProperty('AbsoluteScale', 'TfsPointF', GetProp, nil);
|
||
|
|
AddProperty('AbsoluteEnabled', 'Boolean', GetProp, nil);
|
||
|
|
AddProperty('HasEffect', 'Boolean', GetProp, nil);
|
||
|
|
AddProperty('HasDisablePaintEffect', 'Boolean', GetProp, nil);
|
||
|
|
AddProperty('HasAfterPaintEffect', 'Boolean', GetProp, nil);
|
||
|
|
AddProperty('ChildrenRect', 'TfsRectF', GetProp, nil);
|
||
|
|
AddProperty('InvertAbsoluteMatrix', 'TfsMatrix', GetProp, nil);
|
||
|
|
AddProperty('InPaintTo', 'Boolean', GetProp, nil);
|
||
|
|
AddProperty('LocalRect', 'TfsRectF', GetProp, nil);
|
||
|
|
AddProperty('AbsoluteRect', 'TfsRectF', GetProp, nil);
|
||
|
|
AddProperty('UpdateRect', 'TfsRectF', GetProp, nil);
|
||
|
|
AddProperty('ParentedRect', 'TfsRectF', GetProp, nil);
|
||
|
|
AddProperty('ParentedVisible', 'Boolean', GetProp, nil);
|
||
|
|
AddProperty('ClipRect', 'TfsRectF', GetProp, nil);
|
||
|
|
AddProperty('Canvas', 'TCanvas', GetProp, nil);
|
||
|
|
AddProperty('AutoCapture', 'Boolean', GetProp, SetProp);
|
||
|
|
AddProperty('CanFocus', 'Boolean', GetProp, SetProp);
|
||
|
|
AddProperty('DisableFocusEffect', 'Boolean', GetProp, SetProp);
|
||
|
|
AddProperty('TabOrder', 'Integer', GetProp, SetProp);
|
||
|
|
AddProperty('BoundsRect', 'TfsRectF', GetProp, SetProp);
|
||
|
|
AddEvent('OnDragEnter', TfsDragDropEvent);
|
||
|
|
AddEvent('OnDragLeave', TfsNotifyEvent);
|
||
|
|
AddEvent('OnDragOver', TfsDragOverEvent);
|
||
|
|
AddEvent('OnDragDrop', TfsDragDropEvent);
|
||
|
|
AddEvent('OnDragEnd', TfsNotifyEvent);
|
||
|
|
AddEvent('OnKeyDown', TfsKeyEvent);
|
||
|
|
AddEvent('OnKeyUp', TfsKeyEvent);
|
||
|
|
AddEvent('OnClick', TfsNotifyEvent);
|
||
|
|
AddEvent('OnDblClick', TfsNotifyEvent);
|
||
|
|
AddEvent('OnCanFocus', TfsCanFocusEvent);
|
||
|
|
AddEvent('OnEnter', TfsNotifyEvent);
|
||
|
|
AddEvent('OnExit', TfsNotifyEvent);
|
||
|
|
AddEvent('OnMouseDown', TfsMouseEvent);
|
||
|
|
AddEvent('OnMouseMove', TfsMouseMoveEvent);
|
||
|
|
AddEvent('OnMouseUp', TfsMouseEvent);
|
||
|
|
AddEvent('OnMouseWheel', TfsMouseWheelEvent);
|
||
|
|
AddEvent('OnMouseEnter', TfsNotifyEvent);
|
||
|
|
AddEvent('OnMouseLeave', TfsNotifyEvent);
|
||
|
|
AddEvent('OnPainting', TfsOnPaintEvent);
|
||
|
|
AddEvent('OnPaint', TfsOnPaintEvent);
|
||
|
|
AddEvent('OnResize', TfsNotifyEvent);
|
||
|
|
AddEvent('OnApplyStyleLookup', TfsNotifyEvent);
|
||
|
|
end;
|
||
|
|
|
||
|
|
{ standard controls }
|
||
|
|
with AddClass(TStyledControl, 'TControl') do
|
||
|
|
begin
|
||
|
|
AddMethod('function FindStyleResource(AStyleLookup: string): TFmxObject', CallMethod);
|
||
|
|
AddMethod('procedure ApplyStyleLookup()', CallMethod);
|
||
|
|
{$IFNDEF DELPHI20}
|
||
|
|
AddMethod('procedure UpdateStyle()', CallMethod);
|
||
|
|
{$ENDIF}
|
||
|
|
AddProperty('StyleLookup', 'String', GetProp, SetProp);
|
||
|
|
end;
|
||
|
|
|
||
|
|
AddClass(TStyledControl, 'TControl');
|
||
|
|
AddClass(TTextControl, 'TStyledControl');
|
||
|
|
AddClass(TPanel, 'TStyledControl');
|
||
|
|
AddClass(TCalloutPanel, 'TPanel');
|
||
|
|
AddClass(TLabel, 'TTextControl');
|
||
|
|
AddClass(TCustomButton, 'TTextControl');
|
||
|
|
AddClass(TButton, 'TCustomButton');
|
||
|
|
AddClass(TSpeedButton, 'TCustomButton');
|
||
|
|
with AddClass(TCheckBox, 'TTextControl') do
|
||
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
||
|
|
|
||
|
|
with AddClass(TRadioButton, 'TTextControl') do
|
||
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
||
|
|
AddClass(TGroupBox, 'TTextControl');
|
||
|
|
AddClass(TStatusBar, 'TStyledControl');
|
||
|
|
AddClass(TToolBar, 'TStyledControl');
|
||
|
|
AddClass(TSizeGrip, 'TStyledControl');
|
||
|
|
AddClass(TSplitter, 'TStyledControl');
|
||
|
|
AddClass(TProgressBar, 'TStyledControl');
|
||
|
|
AddClass(TThumb, 'TStyledControl');
|
||
|
|
with AddClass(TCustomTrack, 'TStyledControl') do
|
||
|
|
begin
|
||
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
||
|
|
AddEvent('OnTracking', TfsNotifyEvent);
|
||
|
|
end;
|
||
|
|
AddClass(TTrack, 'TCustomTrack');
|
||
|
|
AddClass(TTrackBar, 'TCustomTrack');
|
||
|
|
AddClass(TBitmapTrackBar, 'TTrackBar');
|
||
|
|
with AddClass(TSwitch, 'TCustomTrack') do
|
||
|
|
AddEvent('OnSwitch', TfsNotifyEvent);
|
||
|
|
with AddClass(TScrollBar, 'TStyledControl') do
|
||
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
||
|
|
|
||
|
|
AddClass(TSmallScrollBar, 'TScrollBar');
|
||
|
|
AddClass(TAniIndicator, 'TStyledControl');
|
||
|
|
with AddClass(TArcDial, 'TStyledControl') do
|
||
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
||
|
|
AddClass(TExpanderButton, 'TCustomButton');
|
||
|
|
with AddClass(TExpander, 'TTextControl') do
|
||
|
|
AddEvent('OnCheckChange', TfsNotifyEvent);
|
||
|
|
with AddClass(TImageControl, 'TStyledControl') do
|
||
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
||
|
|
AddClass(TPathLabel, 'TStyledControl');
|
||
|
|
|
||
|
|
|
||
|
|
with AddClass(TCustomEdit, 'TStyledControl') do
|
||
|
|
begin
|
||
|
|
{$IFNDEF Delphi21}
|
||
|
|
AddMethod('procedure ClearSelection()', CallMethod);
|
||
|
|
{$ENDIF}
|
||
|
|
AddMethod('procedure CopyToClipboard()', CallMethod);
|
||
|
|
AddMethod('procedure CutToClipboard()', CallMethod);
|
||
|
|
AddMethod('procedure PasteFromClipboard()', CallMethod);
|
||
|
|
AddMethod('procedure SelectAll()', CallMethod);
|
||
|
|
{$IFNDEF Delphi21}
|
||
|
|
AddMethod('function GetCharX(a: Integer): Single', CallMethod);
|
||
|
|
AddMethod('function ContentRect(): TfsRectF', CallMethod);
|
||
|
|
{$ENDIF}
|
||
|
|
AddProperty('CaretPosition', 'Integer', GetProp, SetProp);
|
||
|
|
AddProperty('SelStart', 'Integer', GetProp, SetProp);
|
||
|
|
AddProperty('SelLength', 'Integer', GetProp, SetProp);
|
||
|
|
AddProperty('SelText', 'string', GetProp, nil);
|
||
|
|
AddProperty('MaxLength', 'Integer', GetProp, SetProp);
|
||
|
|
AddProperty('SelectionFill', 'TBrush', GetProp, nil);
|
||
|
|
AddProperty('FilterChar', 'string', GetProp, SetProp);
|
||
|
|
AddProperty('Typing', 'Boolean', GetProp, SetProp);
|
||
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
||
|
|
AddEvent('OnChangeTracking', TfsNotifyEvent);
|
||
|
|
AddEvent('OnTyping', TfsNotifyEvent);
|
||
|
|
end;
|
||
|
|
AddClass(TEdit, 'TCustomEdit');
|
||
|
|
with AddClass(TMemo, 'TScrollBox') do
|
||
|
|
begin
|
||
|
|
AddMethod('procedure CopyToClipboard()', CallMethod);
|
||
|
|
AddMethod('procedure PasteFromClipboard()', CallMethod);
|
||
|
|
AddMethod('procedure CutToClipboard()', CallMethod);
|
||
|
|
AddMethod('procedure ClearSelection()', CallMethod);
|
||
|
|
AddMethod('procedure SelectAll()', CallMethod);
|
||
|
|
AddMethod('procedure GoToTextEnd()', CallMethod);
|
||
|
|
AddMethod('procedure GoToTextBegin()', CallMethod);
|
||
|
|
AddMethod('procedure GotoLineEnd()', CallMethod);
|
||
|
|
AddMethod('procedure GoToLineBegin()', CallMethod);
|
||
|
|
AddMethod('procedure UnDo()', CallMethod);
|
||
|
|
AddProperty('SelStart', 'Integer', GetProp, SetProp);
|
||
|
|
AddProperty('SelLength', 'Integer', GetProp, SetProp);
|
||
|
|
AddProperty('SelText', 'string', GetProp, nil);
|
||
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
||
|
|
AddEvent('OnChangeTracking', TfsNotifyEvent);
|
||
|
|
end;
|
||
|
|
|
||
|
|
AddClass(TRadioButton, 'TTextControl');
|
||
|
|
with AddClass(TListBoxItem, 'TTextControl') do
|
||
|
|
begin
|
||
|
|
AddProperty('Data', 'TObject', GetProp, SetProp);
|
||
|
|
AddProperty('Index', 'Integer', GetProp, SetProp);
|
||
|
|
end;
|
||
|
|
|
||
|
|
with AddClass(TCustomListBox, 'TScrollBox') do
|
||
|
|
begin
|
||
|
|
AddMethod('procedure Clear()', CallMethod);
|
||
|
|
AddMethod('function DragChange(SourceItem: TListBoxItem; DestItem: TListBoxItem): Boolean', CallMethod);
|
||
|
|
AddMethod('procedure SelectAll()', CallMethod);
|
||
|
|
AddMethod('procedure ClearSelection()', CallMethod);
|
||
|
|
AddMethod('procedure SelectRange(Item1: TListBoxItem; Item2: TListBoxItem)', CallMethod);
|
||
|
|
AddMethod('function ItemByPoint(X: Single; Y: Single): TListBoxItem', CallMethod);
|
||
|
|
AddMethod('function ItemByIndex(Idx: Integer): TListBoxItem', CallMethod);
|
||
|
|
AddMethod('procedure Exchange(Item1: TListBoxItem; Item2: TListBoxItem)', CallMethod);
|
||
|
|
AddMethod('procedure AddObject(AObject: TFmxObject)', CallMethod);
|
||
|
|
AddMethod('procedure InsertObject(Index: Integer; AObject: TFmxObject)', CallMethod);
|
||
|
|
AddMethod('procedure RemoveObject(AObject: TFmxObject)', CallMethod);
|
||
|
|
AddIndexProperty( 'ListItems', 'Integer', 'TListBoxItem', CallMethod);
|
||
|
|
AddProperty('Count', 'Integer', GetProp, nil);
|
||
|
|
AddProperty('Selected', 'TListBoxItem', GetProp, nil);
|
||
|
|
AddProperty('Items', 'TStrings', GetProp, SetProp);
|
||
|
|
AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
|
||
|
|
end;
|
||
|
|
|
||
|
|
AddClass(TListBox, 'TCustomListBox');
|
||
|
|
with AddClass(TCustomComboBox, 'TStyledControl') do
|
||
|
|
begin
|
||
|
|
AddMethod('procedure Clear', CallMethod);
|
||
|
|
AddMethod('procedure DropDown', CallMethod);
|
||
|
|
AddIndexProperty( 'ListItems', 'Integer', 'TListBoxItem', CallMethod);
|
||
|
|
AddProperty('Count', 'Integer', GetProp, nil);
|
||
|
|
AddProperty('Selected', 'TListBoxItem', GetProp, nil);
|
||
|
|
AddProperty('Items', 'TStrings', GetProp, SetProp);
|
||
|
|
AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
|
||
|
|
AddEvent('OnDropDown', TfsNotifyEvent);
|
||
|
|
AddEvent('OnCloseUp', TfsNotifyEvent);
|
||
|
|
end;
|
||
|
|
|
||
|
|
with AddClass(TComboBox, 'TCustomComboBox') do
|
||
|
|
AddEvent('OnChange', TfsNotifyEvent);
|
||
|
|
|
||
|
|
with AddClass(TCommonCustomForm, 'TFmxObject') do
|
||
|
|
begin
|
||
|
|
AddConstructor('constructor CreateNew(AOwner: TComponent; Dummy: Integer = 0)', CallMethod);
|
||
|
|
AddMethod('procedure SetBounds(ALeft: Integer; ATop: Integer; AWidth: Integer; AHeight: Integer)', CallMethod);
|
||
|
|
AddMethod('function ClientToScreen(Point: TfsPointF): TfsPointF', CallMethod);
|
||
|
|
AddMethod('function ScreenToClient(Point: TfsPointF): TfsPointF', CallMethod);
|
||
|
|
AddMethod('function CloseQuery(): Boolean', CallMethod);
|
||
|
|
AddMethod('function ClientRect(): TfsRectF', CallMethod);
|
||
|
|
AddMethod('procedure Release()', CallMethod);
|
||
|
|
AddMethod('procedure Close()', CallMethod);
|
||
|
|
AddMethod('procedure Show()', CallMethod);
|
||
|
|
AddMethod('procedure Hide()', CallMethod);
|
||
|
|
AddMethod('function ShowModal(): Integer', CallMethod);
|
||
|
|
AddMethod('procedure CloseModal()', CallMethod);
|
||
|
|
AddMethod('procedure Invalidate()', CallMethod);
|
||
|
|
AddMethod('procedure BeginUpdate()', CallMethod);
|
||
|
|
AddMethod('procedure EndUpdate()', CallMethod);
|
||
|
|
end;
|
||
|
|
|
||
|
|
with AddClass(TCustomForm, 'TCommonCustomForm') do
|
||
|
|
begin
|
||
|
|
AddEvent('OnActivate', TfsNotifyEvent);
|
||
|
|
AddEvent('OnClose', TfsCloseEvent);
|
||
|
|
AddEvent('OnCloseQuery', TfsCloseQueryEvent);
|
||
|
|
AddEvent('OnCreate', TfsNotifyEvent);
|
||
|
|
AddEvent('OnDestroy', TfsNotifyEvent);
|
||
|
|
AddEvent('OnDeactivate', TfsNotifyEvent);
|
||
|
|
AddEvent('OnHide', TfsNotifyEvent);
|
||
|
|
AddEvent('OnPaint', TfsNotifyEvent);
|
||
|
|
AddEvent('OnShow', TfsNotifyEvent);
|
||
|
|
AddEvent('OnResize', TfsNotifyEvent);
|
||
|
|
AddProperty('Canvas', 'TCanvas', GetProp, nil);
|
||
|
|
AddProperty('ModalResult', 'Integer', GetProp, SetProp);
|
||
|
|
end;
|
||
|
|
AddClass(TForm, 'TCustomForm');
|
||
|
|
|
||
|
|
AddClass(TDataModule, 'TComponent');
|
||
|
|
with AddClass(TApplication, 'TComponent') do
|
||
|
|
begin
|
||
|
|
AddMethod('procedure ProcessMessages', CallMethod);
|
||
|
|
end;
|
||
|
|
AddObject('Application', Application);
|
||
|
|
end;
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
|
||
|
|
const MethodName: String; Caller: TfsMethodHelper): Variant;
|
||
|
|
var
|
||
|
|
Form: TCommonCustomForm;
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
|
||
|
|
if ClassType = TControl then
|
||
|
|
begin
|
||
|
|
if MethodName = 'ADDOBJECT' then
|
||
|
|
TControl(Instance).AddObject(TFmxObject(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'REMOVEOBJECT' then
|
||
|
|
TControl(Instance).RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'SETBOUNDS' then
|
||
|
|
TControl(Instance).SetBounds(Single(Caller.Params[0]), Single(Caller.Params[1]), Single(Caller.Params[2]), Single(Caller.Params[3]))
|
||
|
|
else if MethodName = 'ABSOLUTETOLOCAL' then
|
||
|
|
Result := frxInteger(TfsPointF.Create(TControl(Instance).AbsoluteToLocal(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
|
||
|
|
else if MethodName = 'LOCALTOABSOLUTE' then
|
||
|
|
Result := frxInteger(TfsPointF.Create(TControl(Instance).LocalToAbsolute(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
|
||
|
|
else if MethodName = 'ABSOLUTETOLOCALVECTOR' then
|
||
|
|
Result := frxInteger(TfsVector.Create(TControl(Instance).AbsoluteToLocalVector(TfsVector(frxInteger(Caller.Params[0])).GetRect)))
|
||
|
|
else if MethodName = 'LOCALTOABSOLUTEVECTOR' then
|
||
|
|
Result := frxInteger(TfsVector.Create(TControl(Instance).LocalToAbsoluteVector(TfsVector(frxInteger(Caller.Params[0])).GetRect)))
|
||
|
|
else if MethodName = 'POINTINOBJECT' then
|
||
|
|
Result := Boolean(TControl(Instance).PointInObject(Single(Caller.Params[0]), Single(Caller.Params[1])))
|
||
|
|
else if MethodName = 'BEGINUPDATE' then
|
||
|
|
TControl(Instance).BeginUpdate()
|
||
|
|
else if MethodName = 'ENDUPDATE' then
|
||
|
|
TControl(Instance).EndUpdate()
|
||
|
|
{$IFNDEF DELPHI18}
|
||
|
|
else if MethodName = 'APPLYEFFECT' then
|
||
|
|
TControl(Instance).ApplyEffect()
|
||
|
|
{$ENDIF}
|
||
|
|
else if MethodName = 'UPDATEEFFECTS' then
|
||
|
|
TControl(Instance).UpdateEffects()
|
||
|
|
else if MethodName = 'SETFOCUS' then
|
||
|
|
TControl(Instance).SetFocus()
|
||
|
|
else if MethodName = 'PAINTTO' then
|
||
|
|
TControl(Instance).PaintTo(TCanvas(frxInteger(Caller.Params[0])), TfsRectF(frxInteger(Caller.Params[1])).GetRect, TFmxObject(frxInteger(Caller.Params[2])))
|
||
|
|
else if MethodName = 'REPAINT' then
|
||
|
|
TControl(Instance).Repaint()
|
||
|
|
else if MethodName = 'INVALIDATERECT' then
|
||
|
|
TControl(Instance).InvalidateRect(TfsRectF(frxInteger(Caller.Params[0])).GetRect)
|
||
|
|
else if MethodName = 'LOCK' then
|
||
|
|
TControl(Instance).Lock()
|
||
|
|
end
|
||
|
|
else if ClassType = TStyledControl then
|
||
|
|
begin
|
||
|
|
if MethodName = 'FINDSTYLERESOURCE' then
|
||
|
|
Result := frxInteger(TStyledControl(Instance).FindStyleResource(String(Caller.Params[0])))
|
||
|
|
else if MethodName = 'APPLYSTYLELOOKUP' then
|
||
|
|
TStyledControl(Instance).ApplyStyleLookup()
|
||
|
|
{$IFNDEF DELPHI20}
|
||
|
|
else if MethodName = 'UPDATESTYLE' then
|
||
|
|
TStyledControl(Instance).UpdateStyle()
|
||
|
|
{$ENDIF}
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomEdit then
|
||
|
|
begin
|
||
|
|
{$IFNDEF Delphi21}
|
||
|
|
if MethodName = 'CLEARSELECTION' then
|
||
|
|
TCustomEdit(Instance).ClearSelection()
|
||
|
|
else
|
||
|
|
{$ENDIF}
|
||
|
|
if MethodName = 'COPYTOCLIPBOARD' then
|
||
|
|
TCustomEdit(Instance).CopyToClipboard()
|
||
|
|
else if MethodName = 'CUTTOCLIPBOARD' then
|
||
|
|
TCustomEdit(Instance).CutToClipboard()
|
||
|
|
else if MethodName = 'PASTEFROMCLIPBOARD' then
|
||
|
|
TCustomEdit(Instance).PasteFromClipboard()
|
||
|
|
else if MethodName = 'SELECTALL' then
|
||
|
|
TCustomEdit(Instance).SelectAll()
|
||
|
|
{$IFNDEF Delphi21}
|
||
|
|
else if MethodName = 'GETCHARX' then
|
||
|
|
Result := Single(TCustomEdit(Instance).GetCharX(Integer(Caller.Params[0])))
|
||
|
|
else if MethodName = 'CONTENTRECT' then
|
||
|
|
Result := frxInteger(TfsRectF.Create(TCustomEdit(Instance).ContentRect()))
|
||
|
|
{$ENDIF}
|
||
|
|
end
|
||
|
|
else if ClassType = TMemo then
|
||
|
|
begin
|
||
|
|
if MethodName = 'COPYTOCLIPBOARD' then
|
||
|
|
TMemo(Instance).CopyToClipboard()
|
||
|
|
else if MethodName = 'PASTEFROMCLIPBOARD' then
|
||
|
|
TMemo(Instance).PasteFromClipboard()
|
||
|
|
else if MethodName = 'CUTTOCLIPBOARD' then
|
||
|
|
TMemo(Instance).CutToClipboard()
|
||
|
|
else if MethodName = 'CLEARSELECTION' then
|
||
|
|
TMemo(Instance).ClearSelection()
|
||
|
|
else if MethodName = 'SELECTALL' then
|
||
|
|
TMemo(Instance).SelectAll()
|
||
|
|
else if MethodName = 'GOTOTEXTEND' then
|
||
|
|
TMemo(Instance).GoToTextEnd()
|
||
|
|
else if MethodName = 'GOTOTEXTBEGIN' then
|
||
|
|
TMemo(Instance).GoToTextBegin()
|
||
|
|
else if MethodName = 'GOTOLINEEND' then
|
||
|
|
TMemo(Instance).GotoLineEnd()
|
||
|
|
else if MethodName = 'GOTOLINEBEGIN' then
|
||
|
|
TMemo(Instance).GoToLineBegin()
|
||
|
|
else if MethodName = 'UNDO' then
|
||
|
|
TMemo(Instance).UnDo()
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomListBox then
|
||
|
|
begin
|
||
|
|
if MethodName = 'ASSIGN' then
|
||
|
|
TCustomListBox(Instance).Assign(TPersistent(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'CLEAR' then
|
||
|
|
TCustomListBox(Instance).Clear()
|
||
|
|
else if MethodName = 'DRAGCHANGE' then
|
||
|
|
Result := TCustomListBox(Instance).DragChange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
|
||
|
|
else if MethodName = 'SELECTALL' then
|
||
|
|
TCustomListBox(Instance).SelectAll()
|
||
|
|
else if MethodName = 'CLEARSELECTION' then
|
||
|
|
TCustomListBox(Instance).ClearSelection()
|
||
|
|
else if MethodName = 'SELECTRANGE' then
|
||
|
|
TCustomListBox(Instance).SelectRange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
|
||
|
|
else if MethodName = 'ITEMBYPOINT' then
|
||
|
|
Result := frxInteger(TListBoxItem(TCustomListBox(Instance).ItemByPoint(Single(Caller.Params[0]), Single(Caller.Params[1]))))
|
||
|
|
else if MethodName = 'ITEMBYINDEX' then
|
||
|
|
Result := frxInteger(TListBoxItem(TCustomListBox(Instance).ItemByIndex(Integer(Caller.Params[0]))))
|
||
|
|
else if MethodName = 'EXCHANGE' then
|
||
|
|
TCustomListBox(Instance).Exchange(TListBoxItem(frxInteger(Caller.Params[0])), TListBoxItem(frxInteger(Caller.Params[1])))
|
||
|
|
else if MethodName = 'ADDOBJECT' then
|
||
|
|
TCustomListBox(Instance).AddObject(TFmxObject(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'INSERTOBJECT' then
|
||
|
|
TCustomListBox(Instance).InsertObject(Integer(Caller.Params[0]), TFmxObject(frxInteger(Caller.Params[1])))
|
||
|
|
else if MethodName = 'REMOVEOBJECT' then
|
||
|
|
TCustomListBox(Instance).RemoveObject(TFmxObject(frxInteger(Caller.Params[0])))
|
||
|
|
else if MethodName = 'LISTITEMS.GET' then
|
||
|
|
Result := frxInteger(TCustomListBox(Instance).ListItems[Caller.Params[0]])
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomComboBox then
|
||
|
|
begin
|
||
|
|
if MethodName = 'CLEAR' then
|
||
|
|
TCustomComboBox(Instance).Clear()
|
||
|
|
else if MethodName = 'DROPDOWN' then
|
||
|
|
TCustomComboBox(Instance).DropDown()
|
||
|
|
else if MethodName = 'LISTITEMS.GET' then
|
||
|
|
Result := frxInteger(TCustomComboBox(Instance).ListItems[Caller.Params[0]])
|
||
|
|
end
|
||
|
|
else if ClassType = TCommonCustomForm then
|
||
|
|
begin
|
||
|
|
Form := TCommonCustomForm(Instance);
|
||
|
|
if MethodName = 'CREATENEW' then
|
||
|
|
Result := frxInteger(Form.CreateNew(TComponent(frxInteger(Caller.Params[0])), Integer(Caller.Params[1])))
|
||
|
|
else if MethodName = 'SETBOUNDS' then
|
||
|
|
Form.SetBounds(Integer(Caller.Params[0]), Integer(Caller.Params[1]), Integer(Caller.Params[2]), Integer(Caller.Params[3]))
|
||
|
|
else if MethodName = 'CLIENTTOSCREEN' then
|
||
|
|
Result := frxInteger(TfsPointF.Create(Form.ClientToScreen(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
|
||
|
|
else if MethodName = 'SCREENTOCLIENT' then
|
||
|
|
Result := frxInteger(TfsPointF.Create(Form.ScreenToClient(TfsPointF(frxInteger(Caller.Params[0])).GetRect)))
|
||
|
|
else if MethodName = 'CLOSEQUERY' then
|
||
|
|
Result := Form.CloseQuery
|
||
|
|
else if MethodName = 'CLIENTRECT' then
|
||
|
|
Result := frxInteger(TfsRectF.Create(Form.ClientRect))
|
||
|
|
else if MethodName = 'RELEASE' then
|
||
|
|
Form.Release()
|
||
|
|
else if MethodName = 'CLOSE' then
|
||
|
|
Form.Close()
|
||
|
|
else if MethodName = 'SHOW' then
|
||
|
|
Form.Show()
|
||
|
|
else if MethodName = 'HIDE' then
|
||
|
|
Form.Hide()
|
||
|
|
else if MethodName = 'SHOWMODAL' then
|
||
|
|
Result := Integer(Form.ShowModal)
|
||
|
|
else if MethodName = 'CLOSEMODAL' then
|
||
|
|
Form.CloseModal()
|
||
|
|
else if MethodName = 'INVALIDATE' then
|
||
|
|
Form.Invalidate()
|
||
|
|
else if MethodName = 'BEGINUPDATE' then
|
||
|
|
Form.BeginUpdate()
|
||
|
|
else if MethodName = 'ENDUPDATE' then
|
||
|
|
Form.EndUpdate()
|
||
|
|
end
|
||
|
|
else if ClassType = TApplication then
|
||
|
|
begin
|
||
|
|
if MethodName = 'PROCESSMESSAGES' then
|
||
|
|
TApplication(Instance).ProcessMessages
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
|
||
|
|
const PropName: String): Variant;
|
||
|
|
begin
|
||
|
|
Result := 0;
|
||
|
|
|
||
|
|
if ClassType = TControl then
|
||
|
|
begin
|
||
|
|
if PropName = 'ABSOLUTEMATRIX' then
|
||
|
|
Result := frxInteger(TfsMatrix.Create(TControl(Instance).AbsoluteMatrix))
|
||
|
|
else if PropName = 'ABSOLUTEOPACITY' then
|
||
|
|
Result := TControl(Instance).AbsoluteOpacity
|
||
|
|
else if PropName = 'ABSOLUTEWIDTH' then
|
||
|
|
Result := TControl(Instance).AbsoluteWidth
|
||
|
|
else if PropName = 'ABSOLUTEHEIGHT' then
|
||
|
|
Result := TControl(Instance).AbsoluteHeight
|
||
|
|
else if PropName = 'ABSOLUTESCALE' then
|
||
|
|
Result := frxInteger(TfsPointF.Create(TControl(Instance).AbsoluteScale))
|
||
|
|
else if PropName = 'ABSOLUTEENABLED' then
|
||
|
|
Result := TControl(Instance).AbsoluteEnabled
|
||
|
|
else if PropName = 'HASEFFECT' then
|
||
|
|
Result := TControl(Instance).HasEffect
|
||
|
|
else if PropName = 'HASDISABLEPAINTEFFECT' then
|
||
|
|
Result := TControl(Instance).HasDisablePaintEffect
|
||
|
|
else if PropName = 'HASAFTERPAINTEFFECT' then
|
||
|
|
Result := TControl(Instance).HasAfterPaintEffect
|
||
|
|
else if PropName = 'CHILDRENRECT' then
|
||
|
|
Result := frxInteger(TfsRectF.Create(TControl(Instance).ChildrenRect))
|
||
|
|
else if PropName = 'INVERTABSOLUTEMATRIX' then
|
||
|
|
Result := frxInteger(TfsMatrix.Create(TControl(Instance).InvertAbsoluteMatrix))
|
||
|
|
else if PropName = 'INPAINTTO' then
|
||
|
|
Result := TControl(Instance).InPaintTo
|
||
|
|
else if PropName = 'LOCALRECT' then
|
||
|
|
Result := frxInteger(TfsRectF.Create(TControl(Instance).LocalRect))
|
||
|
|
else if PropName = 'ABSOLUTERECT' then
|
||
|
|
Result := frxInteger(TfsRectF.Create(TControl(Instance).AbsoluteRect))
|
||
|
|
else if PropName = 'UPDATERECT' then
|
||
|
|
Result := frxInteger(TfsRectF.Create(TControl(Instance).UpdateRect))
|
||
|
|
else if PropName = 'PARENTEDRECT' then
|
||
|
|
Result := frxInteger(TfsRectF.Create(TControl(Instance).ParentedRect))
|
||
|
|
else if PropName = 'PARENTEDVISIBLE' then
|
||
|
|
Result := TControl(Instance).ParentedVisible
|
||
|
|
else if PropName = 'CLIPRECT' then
|
||
|
|
Result := frxInteger(TfsRectF.Create(TControl(Instance).ClipRect))
|
||
|
|
else if PropName = 'CANVAS' then
|
||
|
|
Result := frxInteger(TControl(Instance).Canvas)
|
||
|
|
else if PropName = 'AUTOCAPTURE' then
|
||
|
|
Result := TControl(Instance).AutoCapture
|
||
|
|
else if PropName = 'CANFOCUS' then
|
||
|
|
Result := TControl(Instance).CanFocus
|
||
|
|
else if PropName = 'DISABLEFOCUSEFFECT' then
|
||
|
|
Result := TControl(Instance).DisableFocusEffect
|
||
|
|
else if PropName = 'TABORDER' then
|
||
|
|
Result := Integer(TControl(Instance).TabOrder)
|
||
|
|
else if PropName = 'BOUNDSRECT' then
|
||
|
|
Result := frxInteger(TfsRectF.Create(TControl(Instance).BoundsRect))
|
||
|
|
end
|
||
|
|
else if ClassType = TStyledControl then
|
||
|
|
begin
|
||
|
|
if PropName = 'STYLELOOKUP' then
|
||
|
|
Result := TStyledControl(Instance).StyleLookup
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomEdit then
|
||
|
|
begin
|
||
|
|
if PropName = 'CARETPOSITION' then
|
||
|
|
Result := TCustomEdit(Instance).CaretPosition
|
||
|
|
else if PropName = 'SELSTART' then
|
||
|
|
Result := TCustomEdit(Instance).SelStart
|
||
|
|
else if PropName = 'SELLENGTH' then
|
||
|
|
Result := TCustomEdit(Instance).SelLength
|
||
|
|
else if PropName = 'SELTEXT' then
|
||
|
|
Result := String(TCustomEdit(Instance).SelText)
|
||
|
|
else if PropName = 'MAXLENGTH' then
|
||
|
|
Result := TCustomEdit(Instance).MaxLength
|
||
|
|
else if PropName = 'SELECTIONFILL' then
|
||
|
|
Result := frxInteger(TCustomEdit(Instance).SelectionFill)
|
||
|
|
else if PropName = 'FILTERCHAR' then
|
||
|
|
Result := TCustomEdit(Instance).FilterChar
|
||
|
|
else if PropName = 'TYPING' then
|
||
|
|
Result := TCustomEdit(Instance).Typing
|
||
|
|
end
|
||
|
|
else if ClassType = TMemo then
|
||
|
|
begin
|
||
|
|
if PropName = 'SELSTART' then
|
||
|
|
Result := TMemo(Instance).SelStart
|
||
|
|
else if PropName = 'SELLENGTH' then
|
||
|
|
Result := TMemo(Instance).SelLength
|
||
|
|
else if PropName = 'SELTEXT' then
|
||
|
|
Result := String(TMemo(Instance).SelText)
|
||
|
|
end
|
||
|
|
else if ClassType = TListBoxItem then
|
||
|
|
begin
|
||
|
|
if PropName = 'DATA' then
|
||
|
|
Result := frxInteger(TListBoxItem(Instance).Data)
|
||
|
|
else if PropName = 'INDEX' then
|
||
|
|
Result := TListBoxItem(Instance).Index
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomListBox then
|
||
|
|
begin
|
||
|
|
if PropName = 'COUNT' then
|
||
|
|
Result := TCustomListBox(Instance).Count
|
||
|
|
else if PropName = 'SELECTED' then
|
||
|
|
Result := frxInteger(TCustomListBox(Instance).Selected)
|
||
|
|
else if PropName = 'ITEMS' then
|
||
|
|
Result := frxInteger(TCustomListBox(Instance).Items)
|
||
|
|
else if PropName = 'ITEMINDEX' then
|
||
|
|
Result := TCustomListBox(Instance).ItemIndex
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomComboBox then
|
||
|
|
begin
|
||
|
|
if PropName = 'COUNT' then
|
||
|
|
Result := TCustomComboBox(Instance).Count
|
||
|
|
else if PropName = 'SELECTED' then
|
||
|
|
Result := frxInteger(TCustomComboBox(Instance).Selected)
|
||
|
|
else if PropName = 'ITEMS' then
|
||
|
|
Result := frxInteger(TCustomComboBox(Instance).Items)
|
||
|
|
else if PropName = 'ITEMINDEX' then
|
||
|
|
Result := TCustomComboBox(Instance).ItemIndex
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomForm then
|
||
|
|
begin
|
||
|
|
if PropName = 'MODALRESULT' then
|
||
|
|
Result := TCustomForm(Instance).ModalResult
|
||
|
|
else if PropName = 'CANVAS' then
|
||
|
|
Result := frxInteger(TCustomForm(Instance).Canvas)
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
|
||
|
|
const PropName: String; Value: Variant);
|
||
|
|
begin
|
||
|
|
if ClassType = TControl then
|
||
|
|
begin
|
||
|
|
if PropName = 'AUTOCAPTURE' then
|
||
|
|
TControl(Instance).AutoCapture := Boolean(Value)
|
||
|
|
else if PropName = 'CANFOCUS' then
|
||
|
|
TControl(Instance).CanFocus := Boolean(Value)
|
||
|
|
else if PropName = 'DISABLEFOCUSEFFECT' then
|
||
|
|
TControl(Instance).DisableFocusEffect := Boolean(Value)
|
||
|
|
else if PropName = 'TABORDER' then
|
||
|
|
TControl(Instance).TabOrder := TTabOrder(Integer(Value))
|
||
|
|
else if PropName = 'BOUNDSRECT' then
|
||
|
|
TControl(Instance).BoundsRect := TfsRectF(frxInteger(Value)).GetRect
|
||
|
|
end
|
||
|
|
else if ClassType = TStyledControl then
|
||
|
|
begin
|
||
|
|
if PropName = 'STYLELOOKUP' then
|
||
|
|
TStyledControl(Instance).StyleLookup := Value;
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomEdit then
|
||
|
|
begin
|
||
|
|
if PropName = 'CARETPOSITION' then
|
||
|
|
TCustomEdit(Instance).CaretPosition := Integer(Value)
|
||
|
|
else if PropName = 'SELSTART' then
|
||
|
|
TCustomEdit(Instance).SelStart := Integer(Value)
|
||
|
|
else if PropName = 'SELLENGTH' then
|
||
|
|
TCustomEdit(Instance).SelLength := Integer(Value)
|
||
|
|
else if PropName = 'MAXLENGTH' then
|
||
|
|
TCustomEdit(Instance).MaxLength := Integer(Value)
|
||
|
|
else if PropName = 'FILTERCHAR' then
|
||
|
|
TCustomEdit(Instance).FilterChar := String(Value)
|
||
|
|
else if PropName = 'TYPING' then
|
||
|
|
TCustomEdit(Instance).Typing := Boolean(Value)
|
||
|
|
end
|
||
|
|
else if ClassType = TMemo then
|
||
|
|
begin
|
||
|
|
if PropName = 'SELSTART' then
|
||
|
|
TMemo(Instance).SelStart := Integer(Value)
|
||
|
|
else if PropName = 'SELLENGTH' then
|
||
|
|
TMemo(Instance).SelLength := Integer(Value)
|
||
|
|
end
|
||
|
|
else if ClassType = TListBoxItem then
|
||
|
|
begin
|
||
|
|
if PropName = 'DATA' then
|
||
|
|
TListBoxItem(Instance).Data := TObject(frxInteger(Value))
|
||
|
|
else if PropName = 'INDEX' then
|
||
|
|
TListBoxItem(Instance).Index := Value
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomListBox then
|
||
|
|
begin
|
||
|
|
if PropName = 'ITEMS' then
|
||
|
|
TCustomListBox(Instance).Items := TStrings(frxInteger(Value))
|
||
|
|
else if PropName = 'ITEMINDEX' then
|
||
|
|
TCustomListBox(Instance).ItemIndex := Value
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomComboBox then
|
||
|
|
begin
|
||
|
|
if PropName = 'ITEMS' then
|
||
|
|
TCustomComboBox(Instance).Items := TStrings(frxInteger(Value))
|
||
|
|
else if PropName = 'ITEMINDEX' then
|
||
|
|
TCustomComboBox(Instance).ItemIndex := Value
|
||
|
|
end
|
||
|
|
else if ClassType = TCustomForm then
|
||
|
|
begin
|
||
|
|
if PropName = 'MODALRESULT' then
|
||
|
|
TCustomForm(Instance).ModalResult := Value
|
||
|
|
end
|
||
|
|
end;
|
||
|
|
|
||
|
|
|
||
|
|
initialization
|
||
|
|
StartClassGroup(TFmxObject);
|
||
|
|
ActivateClassGroup(TFmxObject);
|
||
|
|
GroupDescendentsWith(TfsFormsRTTI, TFmxObject);
|
||
|
|
fsRTTIModules.Add(TFunctions);
|
||
|
|
|
||
|
|
finalization
|
||
|
|
fsRTTIModules.Remove(TFunctions);
|
||
|
|
|
||
|
|
end.
|