BiDiMode patch from zaher dirkey (report 0008955)

git-svn-id: trunk@11209 -

lcl/buttons.pp

@@ -112,6 +112,7 @@ type
     property Align;
     property Anchors;
     property AutoSize;
+    property BidiMode;
     property BorderSpacing;
     property Cancel;
     property Caption;
@@ -122,6 +123,7 @@ type
     property DragMode;
     property Enabled;
     property Font;
+    property ParentBidiMode;
     property ModalResult;
     property OnChangeBounds;
     property OnClick;

lcl/controls.pp

@@ -1282,6 +1282,22 @@ type
     property TBDockHeight: Integer read GetTBDockHeight write FTBDockHeight;
     property UndockHeight: Integer read GetUndockHeight write FUndockHeight;// Height used when undocked
     property UndockWidth: Integer read GetUndockWidth write FUndockWidth;// Width used when undocked
+  private
+    //BidiMode property, RightToLeft
+    FBiDiMode: TBiDiMode;
+    FParentBiDiMode: Boolean;
+    function IsBiDiModeStored: boolean;
+    procedure SetBiDiMode(const AValue: TBiDiMode);
+    procedure SetParentBiDiMode(const AValue: Boolean);
+    procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
+    procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED;
+  public
+    function UseRightToLeftAlignment: Boolean; virtual;
+    function UseRightToLeftReading: Boolean; virtual;
+    function UseRightToLeftScrollBar: Boolean;
+    function IsRightToLeft: Boolean;
+    property BiDiMode: TBiDiMode read FBiDiMode write SetBiDiMode stored IsBiDiModeStored default bdLeftToRight;
+    property ParentBiDiMode: Boolean read FParentBiDiMode write SetParentBiDiMode default True;
   published
     property AnchorSideLeft: TAnchorSide index 0 read GetAnchorSideIndex write SetAnchorSideIndex;
     property AnchorSideTop: TAnchorSide index 1 read GetAnchorSideIndex write SetAnchorSideIndex;
@@ -1586,6 +1602,7 @@ type
     // messages
     procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED;
     procedure CMShowHintChanged(var Message: TLMessage); message CM_SHOWHINTCHANGED;
+    procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED;
     procedure WMEraseBkgnd(var Message: TLMEraseBkgnd); message LM_ERASEBKGND;
     procedure WMNotify(var Message: TLMNotify); message LM_NOTIFY;
     procedure WMSetFocus(var Message: TLMSetFocus); message LM_SETFOCUS;
@@ -3243,3 +3260,4 @@ finalization
 
 end.
 
+

lcl/forms.pp

@@ -185,7 +185,7 @@ type
     property AutoSize;
     //property AutoScroll;
     property BorderSpacing;
-    //property BiDiMode;
+    property BiDiMode;
     property BorderStyle;
     property ChildSizing;
     property Constraints;
@@ -198,7 +198,7 @@ type
     property Color nodefault;
     property Ctl3D;
     property Font;
-    //property ParentBiDiMode;
+    property ParentBiDiMode;
     property ParentColor;
     property ParentCtl3D;
     property ParentFont;
@@ -571,6 +571,7 @@ type
     property ActiveControl;
     property Align;
     property AutoSize;
+    property BiDiMode;
     property BorderIcons;
     property BorderStyle;
     property Caption;
@@ -617,6 +618,7 @@ type
     property OnStartDock;
     property OnUnDock;
     property OnUTF8KeyPress;
+    property ParentBiDiMode;
     property ParentFont;
     property PixelsPerInch;
     property PopupMenu;
@@ -1783,3 +1785,4 @@ finalization
 
 end.
 
+

lcl/include/control.inc

@@ -2631,6 +2631,11 @@ begin
       Font := Parent.Font;
       ParentFont := true;
     end;
+
+    if ParentBidiMode then begin
+      BiDiMode := Parent.BiDiMode;
+      ParentBidiMode := true;
+    end;
   end;
 
   UpdateBaseBounds(true,true,true);
@@ -3690,6 +3695,7 @@ begin
   FHelpType := htContext;
   FDragCursor := crDrag;
   FFloatingDockSiteClass := TCustomDockForm;
+  FParentBidiMode := True;
   //DebugLn('TControl.Create END ',Name,':',ClassName);
 end;
 
@@ -4134,6 +4140,102 @@ begin
   SetBoundsKeepBase(Message.XPos, Message.YPos, Width, Height,Parent<>nil);
 end;
 
+{------------------------------------------------------------------------------
+   Method:  TControl.SetBiDiMode
+ ------------------------------------------------------------------------------}
+
+procedure TControl.SetBiDiMode(const AValue: TBiDiMode);
+begin
+  if FBiDiMode=AValue then exit;
+  FBiDiMode:=AValue;
+  FParentBiDiMode := False;
+  Perform(CM_BIDIMODECHANGED, 0, 0);
+end;
+
+{------------------------------------------------------------------------------
+   Method:  TControl.SetParentBiDiMode
+ ------------------------------------------------------------------------------}
+
+procedure TControl.SetParentBiDiMode(const AValue: Boolean);
+begin
+  if FParentBiDiMode=AValue then exit;
+  FParentBiDiMode:=AValue;
+  if (FParent <> nil) and not (csReading in ComponentState) then
+    Perform(CM_PARENTBIDIMODECHANGED, 0, 0);
+end;
+
+{------------------------------------------------------------------------------
+   Method:  TControl.CMBiDiModeChanged
+ ------------------------------------------------------------------------------}
+
+procedure TControl.CMBiDiModeChanged(var Message: TLMessage);
+begin
+  if (Message.wParam = 0) then
+    Invalidate;
+end;
+
+{------------------------------------------------------------------------------
+       TControl.CMParentBidiModeChanged
+
+       assumes: FParent <> nil
+------------------------------------------------------------------------------}
+
+procedure TControl.CMParentBidiModeChanged(var Message: TLMessage);
+begin
+  if csLoading in ComponentState then exit;
+
+  if FParentBidiMode then
+  begin
+    if FParent <> nil then
+      BidiMode := FParent.BidiMode;
+    FParentBidiMode := true;
+  end;
+end;
+
+{------------------------------------------------------------------------------
+       TControl.IsBiDiModeStored
+------------------------------------------------------------------------------}
+function TControl.IsBiDiModeStored: boolean;
+begin
+  Result := not FParentBidiMode;
+end;
+
+
+{------------------------------------------------------------------------------
+       TControl.IsRightToLeft
+------------------------------------------------------------------------------}
+
+function TControl.IsRightToLeft: Boolean;
+begin
+  Result := UseRightToLeftReading;
+end;
+
+{------------------------------------------------------------------------------
+       TControl.UseRightToLeftAlignment
+------------------------------------------------------------------------------}
+
+function TControl.UseRightToLeftAlignment: Boolean;
+begin
+  Result := (BiDiMode = bdRightToLeft);
+end;
+
+{------------------------------------------------------------------------------
+       TControl.UseRightToLeftReading
+------------------------------------------------------------------------------}
+
+function TControl.UseRightToLeftReading: Boolean;
+begin
+  Result := (BiDiMode <> bdLeftToRight);
+end;
+
+{------------------------------------------------------------------------------
+       TControl.UseRightToLeftScrollBar
+------------------------------------------------------------------------------}
+
+function TControl.UseRightToLeftScrollBar: Boolean;
+begin
+  Result := (BiDiMode in [bdRightToLeft, bdRightToLeftNoAlign]);
+end;
 
 {$IFDEF ASSERT_IS_ON}
   {$UNDEF ASSERT_IS_ON}

lcl/include/wincontrol.inc

@@ -4668,6 +4668,14 @@ begin
   NotifyControls(CM_PARENTSHOWHINTCHANGED);
 end;
 
+procedure TWinControl.CMBiDiModeChanged(var Message: TLMessage);
+begin
+  inherited;
+  NotifyControls(CM_PARENTBIDIMODECHANGED);
+  if HandleAllocated and (Message.wParam = 0) then
+    TWSWinControlClass(WidgetSetClass).SetBiDiMode(Self, BiDiMode);
+end;
+
 {------------------------------------------------------------------------------
   Method: TWinControl.WMSetFocus
   Params: Message

lcl/interfaces/win32/win32wsbuttons.pp

@@ -33,7 +33,7 @@ uses
 // To get as little as posible circles,
 // uncomment only when needed for registration
 ////////////////////////////////////////////////////
-  Windows, Buttons, Graphics, Controls,
+  Windows, Classes, Buttons, Graphics, Controls,
 ////////////////////////////////////////////////////
   WSProc, WSControls, WSButtons, WSLCLClasses, 
   Win32WSControls, LCLType, Themes;
@@ -48,6 +48,7 @@ type
   public
     class function  CreateHandle(const AWinControl: TWinControl;
           const AParams: TCreateParams): HWND; override;
+    class procedure SetBiDiMode(const AWinControl: TWinControl; const ABiDiMode: TBiDiMode); override;
     class procedure SetDefault(const AButton: TCustomButton; ADefault: Boolean); override;
     class procedure SetShortCut(const AButton: TCustomButton; const OldKey, NewKey: word); override;
   end;
@@ -101,6 +102,11 @@ begin
       Flags := Flags or BS_DEFPUSHBUTTON
     else
       Flags := Flags or BS_PUSHBUTTON;
+    with Params do {BidiMode}
+    begin
+      if AWinControl.UseRightToLeftReading then
+        FlagsEx := FlagsEx or WS_EX_RTLREADING;
+    end;
     pClassName := 'BUTTON';
     WindowTitle := StrCaption;
   end;
@@ -109,6 +115,12 @@ begin
   Result := Params.Window;
 end;
 
+class procedure TWin32WSButton.SetBiDiMode(const AWinControl: TWinControl;
+  const ABiDiMode: TBiDiMode);
+begin
+  RecreateWnd(AWinControl);
+end;
+
 class procedure TWin32WSButton.SetDefault(const AButton: TCustomButton; ADefault: Boolean);
 var
   WindowStyle: dword;

lcl/interfaces/win32/win32wsforms.pp

@@ -245,6 +245,13 @@ begin
        ( not (csDesigning in lForm.ComponentState) and
         (lForm.ShowInTaskBar = stAlways)) then
       Parent := 0;
+    with Params do {BidiMode}
+    begin
+      if AWinControl.UseRightToLeftAlignment then
+        FlagsEx := FlagsEx or WS_EX_LEFTSCROLLBAR or WS_EX_RIGHT;
+      if AWinControl.UseRightToLeftReading then
+        FlagsEx := FlagsEx or WS_EX_RTLREADING ;
+    end;
   end;
   // create window
   FinishCreateWindow(AWinControl, Params, false);

lcl/interfaces/win32/win32wsstdctrls.pp

@@ -161,6 +161,7 @@ type
     class function  GetMaxLength(const ACustomEdit: TCustomEdit): integer; {override;}
     class function  GetText(const AWinControl: TWinControl; var AText: string): boolean; override;
 
+    class procedure SetBiDiMode(const AWinControl: TWinControl; const ABiDiMode: TBiDiMode); override;
     class procedure SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase); override;
     class procedure SetEchoMode(const ACustomEdit: TCustomEdit; NewMode: TEchoMode); override;
     class procedure SetMaxLength(const ACustomEdit: TCustomEdit; NewLength: integer); override;
@@ -873,6 +874,13 @@ begin
     pClassName := 'EDIT';
     WindowTitle := StrCaption;
     Flags := Flags or ES_AUTOHSCROLL;
+    with Params do {BidiMode}
+    begin
+      if AWinControl.UseRightToLeftAlignment then
+        FlagsEx := FlagsEx or WS_EX_LEFTSCROLLBAR or WS_EX_RIGHT;
+      if AWinControl.UseRightToLeftReading then
+        FlagsEx := FlagsEx or WS_EX_RTLREADING ;
+    end;
   end;
   // create window
   FinishCreateWindow(AWinControl, Params, false);
@@ -904,6 +912,12 @@ begin
   AText := GetControlText(AWinControl.Handle);
 end;
 
+class procedure TWin32WSCustomEdit.SetBiDiMode(const AWinControl: TWinControl;
+  const ABiDiMode: TBiDiMode);
+begin
+  RecreateWnd(AWinControl);
+end;
+
 class procedure TWin32WSCustomEdit.SetCharCase(const ACustomEdit: TCustomEdit; NewCase: TEditCharCase);
 const
   EditStyles: array[TEditCharCase] of integer = (0, ES_UPPERCASE, ES_LOWERCASE);

lcl/stdctrls.pp

@@ -776,6 +776,7 @@ type
     property Anchors;
     property AutoSize;
     property AutoSelect;
+    property BidiMode;
     property BorderSpacing;
     property Color;
     property Constraints;
@@ -786,6 +787,7 @@ type
     property Enabled;
     property Font;
     property MaxLength;
+    property ParentBidiMode;
     property OnChange;
     property OnChangeBounds;
     property OnClick;
@@ -823,6 +825,7 @@ type
     property Align;
     property Alignment;
     property Anchors;
+    property BidiMode;
     property BorderSpacing;
     property Color;
     property Constraints;
@@ -832,6 +835,7 @@ type
     property Font;
     property Lines;
     property MaxLength;
+    property ParentBidiMode;
     property OnChange;
     property OnClick;
     property OnDblClick;
@@ -1389,3 +1393,4 @@ end.
 
 
 
+

lcl/widgetset/wscontrols.pp

@@ -90,6 +90,7 @@ type
     class function  GetText(const AWinControl: TWinControl; var AText: String): Boolean; virtual;
     class function  GetTextLen(const AWinControl: TWinControl; var ALength: Integer): Boolean; virtual;
 
+    class procedure SetBiDiMode(const AWinControl: TWinControl; const ABiDiMode: TBiDiMode); virtual;
     class procedure SetBorderStyle(const AWinControl: TWinControl; const ABorderStyle: TBorderStyle); virtual;
     class procedure SetBounds(const AWinControl: TWinControl; const ALeft, ATop, AWidth, AHeight: Integer); virtual;
     class procedure SetColor(const AWinControl: TWinControl); virtual;
@@ -198,6 +199,11 @@ begin
   if Result
   then ALength := Length(S);
 end;
+
+class procedure TWSWinControl.SetBiDiMode(const AWinControl: TWinControl;
+  const ABiDiMode: TBiDiMode);
+begin
+end;
   
 class procedure TWSWinControl.GetPreferredSize(const AWinControl: TWinControl;
   var PreferredWidth, PreferredHeight: integer; WithThemeSpace: Boolean);