lcl: TApplication.BidiMode from Ido with modifications (#0012542)

git-svn-id: trunk@17177 -

lcl/forms.pp

@@ -40,7 +40,8 @@ uses
   Classes, SysUtils, Types, TypInfo, Math,
   AvgLvlTree, Maps, LCLVersion, LCLStrConsts, LCLType, LCLProc, LCLIntf,
   FileUtil, InterfaceBase, LResources, GraphType, Graphics, Menus, LMessages,
-  CustomTimer, ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls;
+  CustomTimer, ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls,
+  gettext;
 
 type
   TProcedure = procedure;
@@ -1016,6 +1017,7 @@ type
     FLastMousePos: TPoint;
     FLastMouseControl: TControl;
     FLastMouseControlValid: Boolean;
+    FBidiMode: TBiDiMode;
     procedure DoOnIdleEnd;
     function GetActive: boolean;
     function GetCurrentHelpFile: string;
@@ -1025,6 +1027,7 @@ type
     procedure IconChanged(Sender: TObject);
     function InvokeHelp(Command: Word; Data: Longint): Boolean;
     function GetControlAtMouse: TControl;
+    procedure SetBidiMode ( const AValue : TBiDiMode ) ;
     procedure SetFlags(const AValue: TApplicationFlags);
     procedure SetNavigation(const AValue: TApplicationNavigationOptions);
     procedure UpdateMouseControl(NewMouseControl: TControl);
@@ -1159,6 +1162,7 @@ type
                           Shift: TShiftState);
     procedure DoTabKey(AControl: TWinControl; var Key: Word;Shift: TShiftState);
     property Active: boolean read GetActive;
+    property BidiMode: TBiDiMode read FBidiMode write SetBidiMode;
     property CaptureExceptions: boolean read FCaptureExceptions
                                         write SetCaptureExceptions;
     property FindGlobalComponentEnabled: boolean read FFindGlobalComponentEnabled
@@ -1198,7 +1202,6 @@ type
     property ApplicationType : TApplicationType read FApplicationType write FApplicationType;
   end;
 
-
   { TApplicationProperties }
 
   TApplicationProperties = class(TLCLComponent)

lcl/include/application.inc

@@ -89,6 +89,17 @@ end;
        TApplication Constructor
 ------------------------------------------------------------------------------}
 constructor TApplication.Create(AOwner: TComponent);
+const
+  BidiModeMap: array[Boolean] of TBiDiMode = (bdLeftToRight, bdRightToLeft);
+
+  function IsRTLLang(ALang: String): Boolean;
+  begin
+    Result := (ALang = 'ar') or
+              (ALang = 'he');
+  end;
+
+var
+  LangDefault, LangFallback: String;
 begin
   LCLProc.SendApplicationMessageFunction:=@SendApplicationMsg;
 
@@ -114,6 +125,12 @@ begin
   FFindGlobalComponentEnabled:=true;
   RegisterFindGlobalComponentProc(@FindApplicationComponent);
 
+  GetLanguageIDs(LangDefault, LangFallback);
+  if LangDefault <> '' then
+    FBidiMode := BidiModeMap[IsRTLLang(LangDefault)]
+  else
+    FBidiMode := BidiModeMap[IsRTLLang(LangFallback)];
+
   inherited Create(AOwner);
   CaptureExceptions:=true;
 
@@ -450,6 +467,12 @@ begin
   end;
 end;
 
+procedure TApplication.SetBidiMode ( const AValue : TBiDiMode ) ;
+begin
+  if AValue <> FBidiMode then
+    FBidiMode := AValue;
+end;
+
 procedure TApplication.SetFlags(const AValue: TApplicationFlags);
 begin
   { Only allow AppNoExceptionMessages to be changed }