paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-07 07:38:14 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: trunk@17177 -
This commit is contained in:
paul 2008-11-01 18:11:31 +00:00
parent 9d2926b3f7
commit 69f9aff08a
2 changed files with 28 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
lcl/forms.pp
View File

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

23
lcl/include/application.inc
View File

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