Курсовая ( Тест Томоса и узнавание фигур ) / fs_iformsrtti

{******************************************}
{ }
{ FastScript v1.9 }
{ Forms and StdCtrls }
{ }
{ (c) 2003-2007 by Alexander Tzyganenko, }
{ Fast Reports Inc }
{ }
{******************************************}

unit fs_iformsrtti;

interface

{$i fs.inc}

uses
SysUtils, Classes, fs_iinterpreter, fs_ievents, fs_iclassesrtti,
fs_igraphicsrtti
{$IFDEF CLX}
, QControls, QForms, QStdCtrls
{$ELSE}
{$IFNDEF FPC}
, Windows
{$ELSE}
, LCLType, Buttons
{$ENDIF}
, Controls, Forms, StdCtrls
{$ENDIF}
{$IFDEF Delphi16}
, System.Types
{$ENDIF};

type
{$IFDEF DELPHI16}
[ComponentPlatformsAttribute(pidWin32 or pidWin64)]
{$ENDIF}
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', bsNone);
AddConst('bsSingle', 'Integer', bsSingle);
AddConst('bsSizeable', 'Integer', bsSizeable);
AddConst('bsDialog', 'Integer', bsDialog);
AddConst('bsToolWindow', 'Integer', bsToolWindow);
AddConst('bsSizeToolWin', 'Integer', bsSizeToolWin);
{$ENDIF}

{$IFNDEF CLX}
AddConst('VK_RBUTTON', 'Integer', VK_RBUTTON);
AddConst('VK_CANCEL', 'Integer', VK_CANCEL);
AddConst('VK_MBUTTON', 'Integer', VK_MBUTTON);
AddConst('VK_BACK', 'Integer', VK_BACK);//Backspace key
AddConst('VK_TAB', 'Integer', VK_TAB);//Tab key
AddConst('VK_RETURN', 'Integer', VK_RETURN);//Enter key
AddConst('VK_SHIFT', 'Integer', VK_SHIFT);//Shift key
AddConst('VK_CONTROL', 'Integer', VK_CONTROL);//Ctrl key
AddConst('VK_MENU', 'Integer', VK_MENU);//Alt key
AddConst('VK_PAUSE', 'Integer', VK_PAUSE);//Pause key
AddConst('VK_CAPITAL', 'Integer', VK_CAPITAL);//Caps Lock key
AddConst('VK_ESCAPE', 'Integer', VK_ESCAPE);//Esc key
AddConst('VK_SPACE', 'Integer', VK_SPACE);//Space bar
AddConst('VK_PRIOR', 'Integer', VK_PRIOR);//Page Up key
AddConst('VK_NEXT', 'Integer', VK_NEXT);// Page Down key
AddConst('VK_END', 'Integer', VK_END);// End key
AddConst('VK_HOME', 'Integer', VK_HOME);// Home key
AddConst('VK_LEFT', 'Integer', VK_LEFT);// Left Arrow key
AddConst('VK_UP', 'Integer', VK_UP);// Up Arrow key
AddConst('VK_RIGHT', 'Integer', VK_RIGHT);// Right Arrow key
AddConst('VK_DOWN', 'Integer', VK_DOWN);// Down Arrow key
AddConst('VK_INSERT', 'Integer', VK_INSERT);// Insert key
AddConst('VK_DELETE', 'Integer', VK_DELETE);// Delete key
AddConst('VK_HELP', 'Integer', VK_HELP);// Help key
AddConst('VK_LWIN', 'Integer', VK_LWIN);// Left Windows key (Microsoft keyboard)
AddConst('VK_RWIN', 'Integer', VK_RWIN);// Right Windows key (Microsoft keyboard)
AddConst('VK_APPS', 'Integer', VK_APPS);// Applications key (Microsoft keyboard)
AddConst('VK_NUMPAD0', 'Integer', VK_NUMPAD0);// 0 key (numeric keypad)
AddConst('VK_NUMPAD1', 'Integer', VK_NUMPAD1);// 1 key (numeric keypad)
AddConst('VK_NUMPAD2', 'Integer', VK_NUMPAD2);// 2 key (numeric keypad)
AddConst('VK_NUMPAD3', 'Integer', VK_NUMPAD3);// 3 key (numeric keypad)
AddConst('VK_NUMPAD4', 'Integer', VK_NUMPAD4);// 4 key (numeric keypad)
AddConst('VK_NUMPAD5', 'Integer', VK_NUMPAD5);// 5 key (numeric keypad)
AddConst('VK_NUMPAD6', 'Integer', VK_NUMPAD6);// 6 key (numeric keypad)
AddConst('VK_NUMPAD7', 'Integer', VK_NUMPAD7);// 7 key (numeric keypad)
AddConst('VK_NUMPAD8', 'Integer', VK_NUMPAD8);// 8 key (numeric keypad)
AddConst('VK_NUMPAD9', 'Integer', VK_NUMPAD9);// 9 key (numeric keypad)
AddConst('VK_MULTIPLY', 'Integer', VK_MULTIPLY);// Multiply key (numeric keypad)
AddConst('VK_ADD', 'Integer', VK_ADD);// Add key (numeric keypad)
AddConst('VK_SEPARATOR', 'Integer', VK_SEPARATOR);// Separator key (numeric keypad)
AddConst('VK_SUBTRACT', 'Integer', VK_SUBTRACT);// Subtract key (numeric keypad)
AddConst('VK_DECIMAL', 'Integer', VK_DECIMAL);// Decimal key (numeric keypad)
AddConst('VK_DIVIDE', 'Integer', VK_DIVIDE);// Divide key (numeric keypad)
AddConst('VK_F1', 'Integer', VK_F1);// F1 key
AddConst('VK_F2', 'Integer', VK_F2);// F2 key
AddConst('VK_F3', 'Integer', VK_F3);// F3 key
AddConst('VK_F4', 'Integer', VK_F4);// F4 key
AddConst('VK_F5', 'Integer', VK_F5);// F5 key
AddConst('VK_F6', 'Integer', VK_F6);// F6 key
AddConst('VK_F7', 'Integer', VK_F7);// F7 key
AddConst('VK_F8', 'Integer', VK_F8);// F8 key
AddConst('VK_F9', 'Integer', VK_F9);// F9 key
AddConst('VK_F10', 'Integer', VK_F10);// F10 key
AddConst('VK_F11', 'Integer', VK_F11);// F11 key
AddConst('VK_F12', 'Integer', VK_F12);// F12 key
AddConst('VK_NUMLOCK', 'Integer', VK_NUMLOCK);// Num Lock key
AddConst('VK_SCROLL', 'Integer', VK_SCROLL);// Scroll Lock key
{$ENDIF}

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);
AddType('TAlignment', fvtInt);
AddType('TLeftRight', fvtInt);
AddConst('taLeftJustify', 'Integer', taLeftJustify);
AddConst('taRightJustify', 'Integer', taRightJustify);
AddConst('taCenter', 'Integer', taCenter);

AddEnumSet('TShiftState', 'ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble');
// AddEnum('TAlignment', 'taLeftJustify, taRightJustify, taCenter');
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('TPosition', 'poDesigned, poDefault, poDefaultPosOnly, poDefaultSizeOnly, poScreenCenter, poDesktopCenter');
AddEnum('TCloseAction', 'caNone, caHide, caFree, caMinimize');

with AddClass(TControl, 'TComponent') do
begin
AddProperty('Parent', 'TWinControl', GetProp, SetProp);
AddMethod('procedure Hide', CallMethod);
AddMethod('procedure Show', CallMethod);
AddMethod('procedure SetBounds(ALeft, ATop, AWidth, AHeight: Integer)', CallMethod);
AddEvent('OnCanResize', TfsCanResizeEvent);
AddEvent('OnClick', TfsNotifyEvent);
AddEvent('OnDblClick', TfsNotifyEvent);
AddEvent('OnMouseDown', TfsMouseEvent);
AddEvent('OnMouseMove', TfsMouseMoveEvent);
AddEvent('OnMouseUp', TfsMouseEvent);
AddEvent('OnResize', TfsNotifyEvent);
end;
with AddClass(TWinControl, 'TControl') do
begin
AddMethod('procedure SetFocus', CallMethod);
AddEvent('OnEnter', TfsNotifyEvent);
AddEvent('OnExit', TfsNotifyEvent);
AddEvent('OnKeyDown', TfsKeyEvent);
AddEvent('OnKeyPress', TfsKeyPressEvent);
AddEvent('OnKeyUp', TfsKeyEvent);
end;
AddClass(TCustomControl, 'TWinControl');
AddClass(TGraphicControl, 'TControl');
AddClass(TGroupBox, 'TWinControl');
AddClass(TLabel, 'TControl');
AddClass(TEdit, 'TWinControl');
AddClass(TMemo, 'TWinControl');
with AddClass(TCustomComboBox, 'TWinControl') do
begin
AddProperty('DroppedDown', 'Boolean', GetProp, SetProp);
AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
AddEvent('OnChange', TfsNotifyEvent);
AddEvent('OnDropDown', TfsNotifyEvent);
AddEvent('OnCloseUp', TfsNotifyEvent);
end;
AddClass(TComboBox, 'TCustomComboBox');
AddClass(TButton, 'TWinControl');
AddClass(TCheckBox, 'TWinControl');
AddClass(TRadioButton, 'TWinControl');
with AddClass(TCustomListBox, 'TWinControl') do
begin
AddProperty('ItemIndex', 'Integer', GetProp, SetProp);
AddProperty('SelCount', 'Integer', GetProp, nil);
AddIndexProperty('Selected', 'Integer', 'Boolean', CallMethod);
end;
AddClass(TListBox, 'TCustomListBox');
AddClass(TControlScrollBar, 'TPersistent');
AddClass(TScrollingWinControl, 'TWinControl');
AddClass(TScrollBox, 'TScrollingWinControl');
with AddClass(TCustomForm, 'TScrollingWinControl') do
begin
AddMethod('procedure Close', CallMethod);
AddMethod('procedure Hide', CallMethod);
AddMethod('procedure Show', CallMethod);
AddMethod('function ShowModal: Integer', CallMethod);
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);
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 Minimize', CallMethod);
AddMethod('procedure ProcessMessages', CallMethod);
AddMethod('procedure Restore', CallMethod);
AddProperty('ExeName', 'String', GetProp, nil);
end;
AddObject('Application', Application);
end;
end;

function TFunctions.CallMethod(Instance: TObject; ClassType: TClass;
const MethodName: String; Caller: TfsMethodHelper): Variant;
var
Form: TCustomForm;
begin
Result := 0;

if ClassType = TControl then
begin
if MethodName = 'HIDE' then
TControl(Instance).Hide
else if MethodName = 'SHOW' then
TControl(Instance).Show
else if MethodName = 'SETBOUNDS' then
TControl(Instance).SetBounds(Caller.Params[0], Caller.Params[1], Caller.Params[2], Caller.Params[3])
end
else if ClassType = TWinControl then
begin
if MethodName = 'SETFOCUS' then
TWinControl(Instance).SetFocus
end
else if ClassType = TCustomListBox then
begin
if MethodName = 'SELECTED.GET' then
Result := TCustomListBox(Instance).Selected[Caller.Params[0]]
else if MethodName = 'SELECTED.SET' then
TCustomListBox(Instance).Selected[Caller.Params[0]] := Caller.Params[1]
end
else if ClassType = TCustomForm then
begin
Form := TCustomForm(Instance);
if MethodName = 'CLOSE' then
Form.Close
else if MethodName = 'HIDE' then
Form.Hide
else if MethodName = 'SHOW' then
Form.Show
else if MethodName = 'SHOWMODAL' then
Result := Form.ShowModal;
end
else if ClassType = TApplication then
begin
if MethodName = 'MINIMIZE' then
TApplication(Instance).Minimize
else if MethodName = 'PROCESSMESSAGES' then
TApplication(Instance).ProcessMessages
else if MethodName = 'RESTORE' then
TApplication(Instance).Restore
end
end;

function TFunctions.GetProp(Instance: TObject; ClassType: TClass;
const PropName: String): Variant;
begin
Result := 0;

if ClassType = TControl then
begin
if PropName = 'PARENT' then
Result := frxInteger(TControl(Instance).Parent)
end
else if ClassType = TCustomComboBox then
begin
if PropName = 'DROPPEDDOWN' then
Result := TCustomComboBox(Instance).DroppedDown
else if PropName = 'ITEMINDEX' then
Result := TCustomComboBox(Instance).ItemIndex
end
else if ClassType = TCustomListBox then
begin
if PropName = 'SELCOUNT' then
Result := TCustomListBox(Instance).SelCount
else if PropName = 'ITEMINDEX' then
Result := TCustomListBox(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
else if ClassType = TApplication then
begin
if PropName = 'EXENAME' then
Result := TApplication(Instance).ExeName
end
end;

procedure TFunctions.SetProp(Instance: TObject; ClassType: TClass;
const PropName: String; Value: Variant);
begin
if ClassType = TControl then
begin
if PropName = 'PARENT' then
TControl(Instance).Parent := TWinControl(frxInteger(Value))
end
else if ClassType = TCustomComboBox then
begin
if PropName = 'DROPPEDDOWN' then
TCustomComboBox(Instance).DroppedDown := Value
else if PropName = 'ITEMINDEX' then
TCustomComboBox(Instance).ItemIndex := Value
end
else if ClassType = TCustomListBox then
begin
if PropName = 'ITEMINDEX' then
TCustomListBox(Instance).ItemIndex := Value
end
else if ClassType = TCustomForm then
begin
if PropName = 'MODALRESULT' then
TCustomForm(Instance).ModalResult := Value
end
end;


initialization
{$IFDEF Delphi16}
StartClassGroup(TControl);
ActivateClassGroup(TControl);
GroupDescendentsWith(TfsFormsRTTI, TControl);
{$ENDIF}
fsRTTIModules.Add(TFunctions);

finalization
fsRTTIModules.Remove(TFunctions);

end.