Added ScrollMouse, BiDiMode and added CopyClientToBitmap to the TMufasaBitmap

Projects/Simba/psextension.pas

@@ -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;

Units/MMLAddon/PSInc/Wrappers/mouse.inc

@@ -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;

Units/MMLAddon/PSInc/pscompile.inc

@@ -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;');

Units/MMLAddon/PSInc/psexportedmethods.inc

@@ -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);');

Units/MMLAddon/PSInc/uPSC_mml.pas

@@ -6,12 +6,10 @@ uses
 procedure SIRegister_MML(cl: TPSPascalCompiler);
 
 implementation
-procedure SIRegister_MML(cl: TPSPascalCompiler);
+
-var
+procedure SIRegister_TMufasaBitmap(cl : TPSPascalCompiler);
-  PSClass : TPSCompileTimeClass;
 begin
-  PSClass :=cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap');
+  with cl.AddClassN(cl.FindClass('TObject'),'TMufasaBitmap') do
-  with PSClass 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 cl.AddClassN(cl.FindClass('TObject'),'TRegExp') do
-  with PSClass 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');
+end;
-  with PSClass do
+
+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.

Units/MMLAddon/PSInc/uPSR_mml.pas

@@ -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
+procedure RIRegister_TMufasaBitmap(cl : TPSRuntimeClassImporter);
-  PSClass : TPSRuntimeClass;
+begin
-begin;
+  with cl.Add(TMufasaBitmap) do
-  PSClass :=cl.Add(TMufasaBitmap);
-  with PSClass 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.

Units/MMLAddon/mmlpsthread.pas

@@ -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

Units/MMLCore/bitmaps.pas

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

Units/MMLCore/iomanager.pas

@@ -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;

Units/MMLCore/os_windows.pas

@@ -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;

Units/PascalScript/uPSC_controls.pas

@@ -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)');

Units/PascalScript/uPSR_controls.pas

@@ -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}