moparisthebest/Simba
1
0
Fork 0
mirror of https://github.com/moparisthebest/Simba synced 2024-11-25 02:32:19 -05:00
Code Issues Releases Wiki Activity

Added ScrollMouse, BiDiMode and added CopyClientToBitmap to the TMufasaBitmap

Browse Source
This commit is contained in:
Raymond 2010-05-19 22:36:45 +02:00
parent 65f37d861e
commit 780190e2c7
12 changed files with 131 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Projects/Simba/psextension.pas
View File

@ -175,6 +175,11 @@ begin
end;
procedure TMufasaBitmapCopyClientToBitmap(self : TMufasaBitmap; Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);
begin
self.CopyClientToBitmap(SimbaForm.Manager,resize,x,y,xs,ys,xe,ye);
end;
procedure TSimbaPSExtension.RegisterPSCComponents(Sender: TObject; x: TPSPascalCompiler);
begin
SIRegister_Std(x);
@ -199,6 +204,8 @@ begin
RIRegister_ExtCtrls(x);
RIRegister_Menus(x);
RIRegister_MML(x);
with x.FindClass('TMufasaBitmap') do
RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'CopyClientToBitmap');
end;
destructor TSimbaPSExtension.Destroy;

7
Units/MMLAddon/PSInc/Wrappers/mouse.inc
View File

@ -27,7 +27,12 @@ const
ps_mouse_middle = 2;
procedure ps_MoveMouse(x, y: integer); extdecl;
begin
CurrThread.Client.IOManager.SetMousePos(X, Y);
CurrThread.Client.IOManager.MoveMouse(X, Y);
end;
procedure ps_ScrollMouse(x,y : integer; Clicks : integer); extdecl;
begin
CurrThread.Client.IOManager.ScrollMouse(x,y,Clicks);
end;
procedure ps_GetMousePos(var x, y: integer); extdecl;

2
Units/MMLAddon/PSInc/pscompile.inc
View File

@ -44,7 +44,7 @@ x.AddTypeS('TPointArrayArray','Array of TPointArray');
x.AddTypeS('TBmpMirrorStyle','(MirrorWidth,MirrorHeight,MirrorLine)');
x.AddTypeS('TMask','record White, Black : TPointArray; WhiteHi,BlackHi : integer; W,H : integer;end;');
x.addtypeS('PPoint','record R,T : extended; end;');
x.AddTypeS('TTarget_Exported','record int1,int2,int3,int4,int5,int6,int7,int8,int9,int10,int11,int12,int13,int14,int15:integer; end;');
x.AddTypeS('TTarget_Exported','record int1,int2,int3,int4,int5,int6,int7,int8,int9,int10,int11,int12,int13,int14,int15,int16:integer; end;');
x.AddTypes('TSDTMPointDef', 'record x, y, Color, Tolerance, AreaSize, AreaShape: integer; end;');
x.AddTypes('TSDTMPointDefArray', 'Array Of TSDTMPointDef;');

1
Units/MMLAddon/PSInc/psexportedmethods.inc
View File

@ -238,6 +238,7 @@ AddFunction(@ps_FindColoredAreaTolerance, 'function FindColoredAreaTolerance(var
{Mouse etc.}
SetCurrSection('Mouse');
AddFunction(@ps_MoveMouse, 'procedure MoveMouse(x, y: integer);');
AddFunction(@ps_ScrollMouse,'procedure Scrollmouse(x,y : integer; Clicks : integer);');
AddFunction(@ps_GetMousePos, 'procedure GetMousePos(var x, y: integer);');
AddFunction(@ps_HoldMouse, 'procedure HoldMouse(x, y: integer; clickType: integer);');
AddFunction(@ps_ReleaseMouse, 'procedure ReleaseMouse(x, y: integer; clickType: integer);');

35
Units/MMLAddon/PSInc/uPSC_mml.pas
View File

@ -6,12 +6,10 @@ uses
procedure SIRegister_MML(cl: TPSPascalCompiler);
implementation
procedure SIRegister_MML(cl: TPSPascalCompiler);
var
PSClass : TPSCompileTimeClass;
procedure SIRegister_TMufasaBitmap(cl : TPSPascalCompiler);
begin
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap');
with PSClass do
with cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap') do
begin;
RegisterMethod('procedure SetSize(AWidth,AHeight : integer);');
RegisterMethod('procedure StretchResize(AWidth,AHeight : integer);');
@ -20,6 +18,7 @@ begin
RegisterMethod('procedure DrawATPA(ATPA : T2DPointArray; Colors : TIntegerArray);');
RegisterMethod('procedure DrawTPA(TPA : TPointArray; Color : TColor);');
RegisterMethod('function FastGetPixel(x,y : integer) : TColor;');
RegisterMethod('procedure CopyClientToBitmap(Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);');
RegisterMethod('procedure Rectangle(const Box : TBox; FillCol : TColor);');
RegisterMethod('procedure FloodFill(const StartPT : TPoint; const SearchCol,ReplaceCol : TColor);');
// function FastGetPixels(TPA : TPointArray) : TIntegerArray;
@ -49,13 +48,16 @@ begin
RegisterProperty('Index','Integer',iptR);
RegisterProperty('Name','String',iptRW);
end;
end;
procedure SIRegister_TRegExp(cl : TPSPascalCompiler);
begin
with CL.AddClassN(CL.FindClass('Exception'),'ERegExpr') do
begin
RegisterProperty('ErrorCode', 'integer', iptrw);
RegisterProperty('CompilerErrorPos', 'integer', iptrw);
end;
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TRegExp');
with PSClass do
with cl.AddClassN(cl.FindClass('TObject'),'TRegExp') do
begin
RegisterMethod('Constructor Create');
RegisterMethod('Function VersionMajor : integer');
@ -91,8 +93,11 @@ begin
RegisterMethod('Procedure Compile');
RegisterMethod('Function Dump : String');
end;
PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TMDTM');
with PSClass do
end;
procedure SIRegister_TMDTM(cl : TPSPascalCompiler);
begin
with cl.AddClassN(cl.FindClass('TObject'),'TMDTM') do
begin
RegisterMethod('constructor create;');
RegisterMethod('procedure free;');
@ -106,6 +111,10 @@ begin
RegisterProperty('Count','Integer',iptrw);
RegisterProperty('Points','TMDTMPointArray',iptr);
end;
end;
procedure SIRegister_TMMLSettingsSandbox(CL : TPSPascalCompiler);
begin
with cl.AddClassN(nil,'TMMLSettingsSandbox') do
begin;
RegisterMethod('function IsKey(const KeyName: String): Boolean;');
@ -120,4 +129,12 @@ begin
end;
end;
procedure SIRegister_MML(cl: TPSPascalCompiler);
begin
SIRegister_TMufasaBitmap(cl);
SIRegister_TRegExp(cl);
SIRegister_TMDTM(cL);
SIRegister_TMMLSettingsSandbox(cl);
end;
end.

28
Units/MMLAddon/PSInc/uPSR_mml.pas
View File

@ -63,12 +63,10 @@ procedure TMDTMCount_R(Self: TMDTM; var T: Integer);begin T := Self.Count; end;
procedure TMDTMPoints_R(Self : TMDTM; var T : TMDTMPointArray); begin t := self.Points; end;
procedure SettingsPrefix(self : TMMLSettingsSandbox; var Prefix : String);begin; Prefix := self.Prefix; end;
procedure RIRegister_MML(cl: TPSRuntimeClassImporter);
var
PSClass : TPSRuntimeClass;
begin;
PSClass :=cl.Add(TMufasaBitmap);
with PSClass do
procedure RIRegister_TMufasaBitmap(cl : TPSRuntimeClassImporter);
begin
with cl.Add(TMufasaBitmap) do
begin
RegisterMethod(@TMufasaBitmap.ToTBitmap,'ToTBitmap');
RegisterMethod(@TMufasaBitmap.SetSize,'SETSIZE');
@ -105,6 +103,10 @@ begin;
RegisterMethod(@TMufasaBitmap.SaveToFile, 'SAVETOFILE');
RegisterMethod(@TMufasaBitmap.LoadFromFile, 'LOADFROMFILE');
end;
end;
procedure RIRegister_TRegExp(cl : TPSRuntimeClassImporter);
begin
with CL.Add(ERegExpr) do
begin
RegisterPropertyHelper(@ERegExprErrorCode_R,@ERegExprErrorCode_W,'ErrorCode');
@ -146,6 +148,9 @@ begin;
RegisterMethod(@TRegExp.Compile, 'Compile');
RegisterMethod(@TRegExp.Dump, 'Dump');
end;
end;
procedure RIRegister_TMDTM(cl : TPSRuntimeClassImporter);
begin
with CL.Add(TMDTM) do
begin
RegisterConstructor(@TMDTM.Create,'Create');
@ -159,6 +164,9 @@ begin;
RegisterPropertyHelper(@TMDTMCount_R,@TMDTMCount_W,'Count');
RegisterPropertyHelper(@TMDTMPoints_R,nil,'Points');
end;
end;
procedure RIRegister_TMMLSettingsSandbox(cl : TPSRuntimeClassImporter);
begin
with cl.Add(TMMLSettingsSandbox) do
begin
RegisterMethod(@TMMLSettingsSandbox.IsKey,'ISKEY');
@ -173,4 +181,12 @@ begin;
end;
end;
procedure RIRegister_MML(cl: TPSRuntimeClassImporter);
begin;
RIRegister_TMufasaBitmap(cl);
RIRegister_TRegExp(cl);
RIRegister_TMDTM(cl);
RIRegister_TMMLSettingsSandbox(cl);
end;
end.

12
Units/MMLAddon/mmlpsthread.pas
View File

@ -204,14 +204,14 @@ uses
colour_conv,dtmutil,
{$ifdef mswindows}windows, MMSystem,{$endif}//MMSystem -> Sounds
uPSC_std, uPSC_controls,uPSC_classes,uPSC_graphics,uPSC_stdctrls,uPSC_forms, uPSC_menus,
uPSC_extctrls, //Compile-libs
uPSC_extctrls, uPSC_mml, //Compile-libs
uPSUtils,
fontloader,
IOmanager,//TTarget_Exported
IniFiles,//Silly INI files
stringutil, //String st00f
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms,
uPSR_std, uPSR_controls,uPSR_classes,uPSR_graphics,uPSR_stdctrls,uPSR_forms, uPSR_mml,
uPSR_menus, uPSI_ComCtrls, uPSI_Dialogs,
files,
dialogs,
@ -666,8 +666,6 @@ begin
'{$IFDEF __REMOVE_IS_INCLUDE}{$UNDEF IS_INCLUDE}{$ENDIF}';
end;
{$I PSInc/pscmml.inc}
procedure SIRegister_Mufasa(cl: TPSPascalCompiler);
begin
SIRegister_MML(cl);
@ -714,7 +712,6 @@ begin
end;
end;
{$I PSInc/psrmml.inc}
function TMufasaBitmapCreate : TMufasaBitmap;
begin;
result := TMufasaBitmap.Create;
@ -726,6 +723,10 @@ begin
result := Self.Copy(xs,ys,xe,ye);
CurrThread.Client.MBitmaps.AddBMP(result);
end;
procedure TMufasaBitmapCopyClientToBitmap(self : TMufasaBitmap; Resize : boolean;x,y : integer; xs, ys, xe, ye: Integer);
begin
self.CopyClientToBitmap(CurrThread.Client.IOManager,resize,x,y,xs,ys,xe,ye);
end;
function TMDTMCreate : TMDTM;
begin
result := TMDTM.Create;
@ -745,6 +746,7 @@ begin
RegisterConstructor(@TMufasaBitmapCreate,'Create');
RegisterMethod(@TMufasaBitmapFree,'Free');
RegisterMethod(@TMufasaBitmapCopy,'Copy');
RegisterMethod(@TMufasaBitmapCopyClientToBitmap,'CopyClientToBitmap');
end;
With cl.FindClass('TMDTM') do
begin

11
Units/MMLCore/bitmaps.pas
View File

@ -966,12 +966,11 @@ var
begin
if Resize then
Self.SetSize(xe-xs+1 + x,ye-ys+1 + y);
wi := Min(xe-xs + 1 + x,Self.w);
hi := Min(ye-ys + 1 + y,Self.h);
PtrRet := TIOManager_Abstract(MWindow).ReturnData(xs,ys,wi - x,hi - y);
for yy := 0 to (hi-1 - y) do
ValidatePoint(x,y);
wi := Min(xe-xs + 1 + x,Self.w)-x;
hi := Min(ye-ys + 1 + y,Self.h)-y;
PtrRet := TIOManager_Abstract(MWindow).ReturnData(xs,ys,wi,hi);
for yy := 0 to (hi-1) do
Move(PtrRet.Ptr[yy * (PtrRet.RowLen)], FData[(yy + y) * self.w + x],wi * SizeOf(TRGB32));
TIOManager_Abstract(MWindow).FreeReturnData;
end;

34
Units/MMLCore/iomanager.pas
View File

@ -58,6 +58,7 @@ interface
| raise exceptions }
procedure GetMousePosition(var x,y: integer); virtual;
procedure MoveMouse(x,y: integer); virtual;
procedure ScrollMouse(x,y : integer; Lines : integer); virtual;
procedure HoldMouse(x,y: integer; button: TClickType); virtual;
procedure ReleaseMouse(x,y: integer; button: TClickType); virtual;
function IsMouseButtonHeld( button : TClickType) : boolean ; virtual;
@ -114,6 +115,7 @@ interface
procedure ActivateClient; override; abstract;
procedure GetMousePosition(var x,y: integer); override; abstract;
procedure MoveMouse(x,y: integer); override; abstract;
procedure ScrollMouse(x,y : integer; Lines : integer); override; abstract;
procedure HoldMouse(x,y: integer; button: TClickType); override; abstract;
procedure ReleaseMouse(x,y: integer; button: TClickType); override; abstract;
function IsMouseButtonHeld( button : TClickType) : boolean;override; abstract;
@ -140,6 +142,7 @@ interface
GetMousePosition: procedure(target: pointer; var x,y: integer); stdcall;
MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
ScrollMouse: procedure(target : pointer; x,y : integer; lines : integer); stdcall;
HoldMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
ReleaseMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
IsMouseButtonHeld : function (target : pointer; left : Boolean) : boolean; stdcall;
@ -170,6 +173,7 @@ interface
procedure GetMousePosition(var x,y: integer); override;
procedure MoveMouse(x,y: integer); override;
procedure ScrollMouse(x,y : integer; Lines : integer); override;
procedure HoldMouse(x,y: integer; button: TClickType); override;
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
function IsMouseButtonHeld( button : TClickType) : boolean;override;
@ -229,6 +233,7 @@ interface
GetMousePosition: procedure(target: pointer; var x,y: integer); stdcall;
MoveMouse: procedure(target: pointer; x,y: integer); stdcall;
ScrollMouse: procedure(target: pointer; x,y : integer; Lines : integer); stdcall;
HoldMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
ReleaseMouse: procedure(target: pointer; x,y: integer; left: boolean); stdcall;
IsMouseButtonHeld : function (target : pointer; left : boolean) : boolean;stdcall;
@ -279,7 +284,8 @@ interface
procedure SetFrozen(makefrozen: boolean);
procedure GetMousePos(var X, Y: Integer);
procedure SetMousePos(X, Y: Integer);
procedure MoveMouse(X, Y: Integer);
procedure ScrollMouse(x,y : integer; Lines : integer);
procedure HoldMouse(x,y : integer; button: TClickType);
procedure ReleaseMouse(x,y : integer; button: TClickType);
procedure ClickMouse(X, Y: Integer; button: TClickType);
@ -334,6 +340,7 @@ interface
procedure TTarget_Exported_GetMousePosition(target: pointer; var x,y: integer); stdcall;
procedure TTarget_Exported_MoveMouse(target: pointer; x,y: integer); stdcall;
procedure TTarget_Exported_ScrollMouse(target: pointer; x,y : integer; Lines : integer); stdcall;
procedure TTarget_Exported_HoldMouse(target: pointer; x,y: integer; left: boolean); stdcall;
procedure TTarget_Exported_ReleaseMouse(target: pointer; x,y: integer; left: boolean); stdcall;
function TTarget_Exported_IsMouseButtonHeld(target: pointer; left : boolean) : boolean;stdcall;
@ -473,6 +480,7 @@ begin
Target:= KeyMouse;
GetMousePosition := @TTarget_Exported_GetMousePosition;
MoveMouse := @TTarget_Exported_MoveMouse;
ScrollMouse:= @TTarget_Exported_ScrollMouse;
HoldMouse := @TTarget_Exported_HoldMouse;
ReleaseMouse := @TTarget_Exported_ReleaseMouse;
@ -602,10 +610,17 @@ procedure TIOManager_Abstract.GetMousePos(var X, Y: Integer);
begin
keymouse.GetMousePosition(x,y)
end;
procedure TIOManager_Abstract.SetMousePos(X, Y: Integer);
procedure TIOManager_Abstract.MoveMouse(X, Y: Integer);
begin
keymouse.MoveMouse(x,y);
end;
procedure TIOManager_Abstract.ScrollMouse(x, y: integer; Lines: integer);
begin
keymouse.ScrollMouse(x,y,lines);
end;
procedure TIOManager_Abstract.HoldMouse(x,y : integer; button: TClickType);
begin
keymouse.HoldMouse(x,y,button);
@ -698,6 +713,7 @@ function TTarget.TargetValid: boolean; begin result:= true; end;
procedure TTarget.GetMousePosition(var x,y: integer); begin raise Exception.Create('GetMousePosition not available for this target'); end;
procedure TTarget.MoveMouse(x,y: integer); begin raise Exception.Create('MoveMouse not available for this target'); end;
procedure TTarget.ScrollMouse(x,y : integer; lines : integer); begin raise Exception.Create('ScrollMouse is not available for this target'); end;
procedure TTarget.HoldMouse(x,y: integer; button: TClickType); begin raise Exception.Create('HoldMouse not available for this target'); end;
procedure TTarget.ReleaseMouse(x,y: integer; button: TClickType); begin raise Exception.Create('ReleaseMouse not available for this target'); end;
function TTarget.IsMouseButtonHeld(button: TClickType): boolean; begin raise Exception.Create('IsMouseButtonHeld not available for this target'); end;
@ -763,6 +779,14 @@ begin
else
inherited MoveMouse(x,y);
end;
procedure TEIOS_Target.ScrollMouse(x,y : integer; Lines : integer);
begin
if Pointer(Client.ScrollMouse) <> nil then
client.ScrollMouse(target,x,y,lines)
else
inherited Scrollmouse(x,y,lines);
end;
procedure TEIOS_Target.HoldMouse(x,y: integer; button: TClickType);
begin
if Pointer(client.HoldMouse) <> nil then
@ -942,6 +966,7 @@ begin
Pointer(GetMousePosition):= GetProcAddress(plugin, PChar('EIOS_GetMousePosition'));
Pointer(MoveMouse):= GetProcAddress(plugin, PChar('EIOS_MoveMouse'));
Pointer(ScrollMouse) := GetProcAddress(plugin,PChar('EIOS_ScrollMouse'));
Pointer(HoldMouse):= GetProcAddress(plugin, PChar('EIOS_HoldMouse'));
Pointer(ReleaseMouse):= GetProcAddress(plugin, PChar('EIOS_ReleaseMouse'));
@ -1011,6 +1036,11 @@ procedure TTarget_Exported_MoveMouse(target: pointer; x, y: integer); stdcall;
begin
TTarget(Target).MoveMouse(x,y);
end;
procedure TTarget_Exported_ScrollMouse(target: pointer; x, y: integer;
Lines: integer); stdcall;
begin
TTarget(Target).ScrollMouse(x,y,lines);
end;
procedure TTarget_Exported_HoldMouse(target: pointer; x, y: integer;
left: boolean); stdcall;

19
Units/MMLCore/os_windows.pas
View File

@ -58,6 +58,7 @@ interface
procedure ActivateClient; override;
procedure GetMousePosition(var x,y: integer); override;
procedure MoveMouse(x,y: integer); override;
procedure ScrollMouse(x,y, lines : integer); override;
procedure HoldMouse(x,y: integer; button: TClickType); override;
procedure ReleaseMouse(x,y: integer; button: TClickType); override;
function IsMouseButtonHeld( button : TClickType) : boolean;override;
@ -290,6 +291,24 @@ implementation
y := y + rect.top;
Windows.SetCursorPos(x, y);
end;
const
MOUSEEVENTF_WHEEL = $800;
procedure TWindow.ScrollMouse(x, y, lines: integer);
var
Input : TInput;
Rect : TRect;
begin
WindowRect(rect);
Input.Itype:= INPUT_MOUSE;
FillChar(Input,Sizeof(Input),0);
Input.mi.dx:= x + Rect.left;
Input.mi.dy:= y + Rect.Top;
Input.mi.dwFlags:= MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_WHEEL;
Input.mi.mouseData:= lines * WHEEL_DELTA;
SendInput(1,Input, sizeof(Input));
end;
procedure TWindow.HoldMouse(x,y: integer; button: TClickType);
var
Input : TInput;

2
Units/PascalScript/uPSC_controls.pas
View File

@ -53,6 +53,7 @@ begin
RegisterProperty('Visible', 'Boolean', iptRW);
RegisterProperty('ENABLED', 'BOOLEAN', iptrw);
RegisterProperty('CURSOR', 'TCURSOR', iptrw);
RegisterProperty('BiDiMode','TBiDiMode',iptrw);
{$IFNDEF PS_MINIVCL}
RegisterMethod('function Dragging: Boolean;');
@ -133,6 +134,7 @@ begin
Cl.addTypeS('TEShiftState','(ssShift, ssAlt, ssCtrl, ssLeft, ssRight, ssMiddle, ssDouble,' +
'ssMeta, ssSuper, ssHyper, ssAltGr, ssCaps, ssNum,ssScroll,ssTriple,ssQuad)');
{$ENDIF}
cl.AddTypeS('TBiDiMode','(bdLeftToRight,bdRightToLeft,bdRightToLeftNoAlign,bdRightToLeftReadingOnly)');
Cl.addTypeS('TShiftState','set of TEShiftState');
cl.AddTypeS('TMouseButton', '(mbLeft, mbRight, mbMiddle)');
cl.AddTypeS('TDragMode', '(dmManual, dmAutomatic)');

3
Units/PascalScript/uPSR_controls.pas
View File

@ -51,6 +51,8 @@ procedure TCONTROLENABLED_W(Self: TCONTROL; T: BOOLEAN); begin Self.ENABLED := T
procedure TCONTROLENABLED_R(Self: TCONTROL; var T: BOOLEAN); begin T := Self.ENABLED; end;
procedure TControlCaption_W(Self: TCONTROL; T: String); begin Self.Caption := T; end;
procedure TControlCaption_R(Self: TCONTROL; var T: String); begin T := Self.Caption; end;
procedure TControlBiDiMode_W(Self: TCONTROL; T: TBiDiMode); begin Self.BiDiMode := T; end;
procedure TControlBiDiMode_R(Self: TCONTROL; var T: TBiDiMode); begin T := Self.BiDiMode; end;
procedure TControlBeginDrag(Self : TControl;Immediate : boolean); begin self.BeginDrag(Immediate); end;
procedure RIRegisterTControl(Cl: TPSRuntimeClassImporter);
@ -75,6 +77,7 @@ begin
RegisterPropertyHelper(@TControlVisibleR, @TControlVisibleW, 'VISIBLE');
RegisterPropertyHelper(@TCONTROLENABLED_R, @TCONTROLENABLED_W, 'ENABLED');
RegisterPropertyHelper(@TControlCaption_R,@TControlCaption_W,'CAPTION');
RegisterPropertyHelper(@TControlBiDiMode_R,@TControlBiDiMode_W,'BiDiMode');
RegisterPropertyHelper(@TControlParentR, @TControlParentW, 'PARENT');
{$IFNDEF PS_MINIVCL}