diff --git a/lcl/forms.pp b/lcl/forms.pp index 5dae7e7812..4670fd7df3 100644 --- a/lcl/forms.pp +++ b/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) diff --git a/lcl/include/application.inc b/lcl/include/application.inc index 1e9a235844..c8a51cbb05 100644 --- a/lcl/include/application.inc +++ b/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 }