Index: lcl/controls.pp =================================================================== --- lcl/controls.pp (revision 20144) +++ lcl/controls.pp (working copy) @@ -820,7 +820,7 @@ * compatibility. } - TControl = class(TLCLComponent) + TControl = class(TVisualComponent) private FActionLink: TControlActionLink; FAlign: TAlign; @@ -831,7 +831,6 @@ FBaseBounds: TRect; FBaseBoundsLock: integer; FBaseParentClientSize: TPoint; - FBiDiMode: TBiDiMode; FBorderSpacing: TControlBorderSpacing; FBoundsRectForNewParent: TRect; FCaption: TCaption; @@ -890,7 +889,6 @@ FOnStartDrag: TStartDragEvent; FOnTripleClick: TNotifyEvent; FParent: TWinControl; - FParentBiDiMode: Boolean; FPopupMenu: TPopupMenu; FPreferredMinWidth: integer;// without theme space FPreferredMinHeight: integer;// without theme space @@ -931,7 +929,6 @@ function GetUndockHeight: Integer; function GetUndockWidth: Integer; function IsAnchorsStored: boolean; - function IsBiDiModeStored: boolean; function IsCaptionStored: Boolean; function IsColorStored: Boolean; function IsEnabledStored: Boolean; @@ -1013,8 +1010,6 @@ procedure ChangeScale(Multiplier, Divider: Integer); dynamic; function CanAutoSize(var NewWidth, NewHeight: Integer): Boolean; virtual; procedure SetAlignedBounds(aLeft, aTop, aWidth, aHeight: integer); virtual; - procedure SetBiDiMode(AValue: TBiDiMode); virtual; - procedure SetParentBiDiMode(AValue: Boolean); virtual; function IsAParentAligning: boolean; function GetClientOrigin: TPoint; virtual; function GetClientRect: TRect; virtual;// visual size of client area @@ -1029,6 +1024,7 @@ property AutoSizingLockCount: Integer read FAutoSizingLockCount; protected // protected messages + procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED; procedure WMCancelMode(var Message: TLMessage); message LM_CANCELMODE; procedure WMContextMenu(var Message: TLMMouse); message LM_CONTEXTMENU; procedure WMLButtonDown(var Message: TLMLButtonDown); message LM_LBUTTONDOWN; @@ -1052,13 +1048,11 @@ procedure WMSize(var Message: TLMSize); message LM_SIZE; procedure WMWindowPosChanged(var Message: TLMWindowPosChanged); message LM_WINDOWPOSCHANGED; procedure LMCaptureChanged(var Message: TLMessage); message LM_CaptureChanged; - procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; procedure CMEnabledChanged(var Message: TLMEssage); message CM_ENABLEDCHANGED; procedure CMHitTest(var Message: TCMHittest) ; message CM_HITTEST; procedure CMMouseEnter(var Message :TLMessage); message CM_MouseEnter; procedure CMMouseLeave(var Message :TLMessage); message CM_MouseLeave; procedure CMHintShow(var Message: TLMessage); message CM_HINTSHOW; - procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED; procedure CMParentColorChanged(var Message: TLMessage); message CM_PARENTCOLORCHANGED; procedure CMParentShowHintChanged(var Message: TLMessage); message CM_PARENTSHOWHINTCHANGED; procedure CMVisibleChanged(var Message: TLMessage); message CM_VISIBLECHANGED; @@ -1089,6 +1083,10 @@ function GetDefaultDockCaption: String; virtual; //procedure SendDockNotification; virtual; MG: probably not needed protected + //BidiMode + procedure BiDiModeChanged; override; + procedure ParentBiDiModeChanged; override; + protected // key and mouse procedure Click; dynamic; procedure DblClick; dynamic; @@ -1347,12 +1345,7 @@ property UndockHeight: Integer read GetUndockHeight write FUndockHeight;// Height used when undocked property UndockWidth: Integer read GetUndockWidth write FUndockWidth;// Width used when undocked 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; @@ -1669,7 +1662,6 @@ procedure CreateBrush; virtual; protected // messages - procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; procedure CMBorderChanged(var Message: TLMessage); message CM_BORDERCHANGED; procedure CMEnabledChanged(var Message: TLMessage); message CM_ENABLEDCHANGED; procedure CMShowingChanged(var Message: TLMessage); message CM_SHOWINGCHANGED; @@ -1780,6 +1772,7 @@ procedure UpdateShowing; virtual; procedure WndProc(var Message: TLMessage); override; procedure WSSetText(const AText: String); virtual; + procedure BiDiModeChanged; override; protected // properties which are not supported by all descendents property BorderStyle: TBorderStyle read GetBorderStyle write SetBorderStyle default bsNone; Index: lcl/extctrls.pp =================================================================== --- lcl/extctrls.pp (revision 20144) +++ lcl/extctrls.pp (working copy) @@ -1145,7 +1145,7 @@ TBalloonFlags = (bfNone, bfInfo, bfWarning, bfError); - TCustomTrayIcon = class(TLCLComponent) + TCustomTrayIcon = class(TVisualComponent) private FBalloonFlags: TBalloonFlags; FBalloonHint: string; @@ -1210,6 +1210,8 @@ property Icon; property Hint; property Visible; + property BidiMode; + property ParentBidiMode; property OnClick; property OnDblClick; property OnMouseDown; Index: lcl/forms.pp =================================================================== --- lcl/forms.pp (revision 20144) +++ lcl/forms.pp (working copy) @@ -40,9 +40,9 @@ 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, Themes - {$ifndef wince},gettext{$endif}// remove ifdefs when gettext is fixed and a new fpc is released - ; + CustomTimer, ActnList, ClipBrd, CustApp, HelpIntfs, LCLClasses, Controls, Themes; +(* {$ifndef wince},gettext{$endif}// remove ifdefs when gettext is fixed and a new fpc is released + ;*) type // forward class declarations @@ -457,7 +457,6 @@ procedure WMPaint(var message: TLMPaint); message LM_PAINT; procedure WMShowWindow(var message: TLMShowWindow); message LM_SHOWWINDOW; procedure WMSize(var message: TLMSize); message LM_Size; - procedure CMBiDiModeChanged(var Message: TLMessage); message CM_BIDIMODECHANGED; procedure CMIconChanged(var Message: TLMessage); message CM_ICONCHANGED; procedure AddHandler(HandlerType: TFormHandlerType; const Handler: TMethod; AsLast: Boolean); @@ -505,6 +504,8 @@ procedure DoSendBoundsToInterface; override; procedure DoAutoSize; override; procedure SetAutoSize(Value: Boolean); override; + procedure BiDiModeChanged; override; + procedure ParentBidiModeChanged; override; protected // drag and dock procedure BeginAutoDrag; override; @@ -834,7 +835,7 @@ { TScreen } - TScreen = class(TLCLComponent) + TScreen = class(TVisualComponent) private FActiveControl: TWinControl; FActiveCustomForm: TCustomForm; @@ -1069,6 +1070,7 @@ private FApplicationHandlers: array[TApplicationHandlerType] of TMethodList; FApplicationType: TApplicationType; + FAutoFlipChildren: Boolean; FCaptureExceptions: boolean; FComponentsToRelease: TAvgLvlTree; FCreatingForm: TForm;// currently created form (CreateForm), candidate for MainForm @@ -1123,7 +1125,7 @@ FLastMousePos: TPoint; FLastMouseControl: TControl; FLastMouseControlValid: Boolean; - FBidiMode: TBiDiMode; + FBidiMode: TBidiMode; procedure DoOnIdleEnd; function GetActive: boolean; function GetCurrentHelpFile: string; @@ -1133,7 +1135,7 @@ procedure IconChanged(Sender: TObject); function InvokeHelp(Command: Word; Data: Longint): Boolean; function GetControlAtMouse: TControl; - procedure SetBidiMode ( const AValue : TBiDiMode ) ; + procedure SetBidiMode(const AValue : TBidiMode) ; procedure SetFlags(const AValue: TApplicationFlags); procedure SetNavigation(const AValue: TApplicationNavigationOptions); procedure SetShowButtonGlyphs(const AValue: TShowButtonGlyphs); @@ -1175,6 +1177,7 @@ procedure ReleaseComponents; procedure DoBeforeFinalization; function GetParams(Index: Integer): string; override; + procedure BidiModeChanged; virtual; public constructor Create(AOwner: TComponent); override; destructor Destroy; override; @@ -1275,7 +1278,10 @@ property Active: boolean read GetActive; property ApplicationType : TApplicationType read FApplicationType write FApplicationType; + + property AutoFlipChildren: Boolean read FAutoFlipChildren write FAutoFlipChildren default True; property BidiMode: TBiDiMode read FBidiMode write SetBidiMode; + property CaptureExceptions: boolean read FCaptureExceptions write SetCaptureExceptions; property FindGlobalComponentEnabled: boolean read FFindGlobalComponentEnabled @@ -1328,6 +1334,7 @@ TApplicationProperties = class(TLCLComponent) private + FAutoFlipChildren: Boolean; FCaptureExceptions: boolean; FHelpFile: string; FHint: string; @@ -1341,6 +1348,7 @@ FShowHint: Boolean; FShowMainForm: Boolean; FTitle: String; + FBidiMode: TBidiMode; FOnException: TExceptionEvent; FOnIdle: TIdleEvent; @@ -1353,6 +1361,9 @@ FOnQueryEndSession : TQueryEndSessionEvent; FOnMinimize : TNotifyEvent; FOnRestore : TNotifyEvent; + function GetBidiMode: TBidiMode; + procedure SetAutoFlipChildren(const AValue: Boolean); + procedure SetBidiMode(const AValue: TBidiMode); protected procedure SetCaptureExceptions(const AValue : boolean); procedure SetHelpFile(const AValue : string); @@ -1385,6 +1396,8 @@ published property CaptureExceptions: boolean read FCaptureExceptions write SetCaptureExceptions default True; + property AutoFlipChildren: Boolean read FAutoFlipChildren write SetAutoFlipChildren default True; + property BidiMode: TBidiMode read GetBidiMode write SetBidiMode; property HelpFile: string read FHelpFile write SetHelpFile; property Hint: string read FHint write SetHint; property HintColor: TColor read FHintColor write SetHintColor default DefHintColor; Index: lcl/include/application.inc =================================================================== --- lcl/include/application.inc (revision 20144) +++ lcl/include/application.inc (working copy) @@ -85,7 +85,7 @@ TApplication Constructor ------------------------------------------------------------------------------} constructor TApplication.Create(AOwner: TComponent); -const +(*const BidiModeMap: array[Boolean] of TBiDiMode = (bdLeftToRight, bdRightToLeft); function IsRTLLang(ALang: String): Boolean; @@ -95,7 +95,7 @@ end; var - LangDefault, LangFallback: String; + LangDefault, LangFallback: String; *) begin LCLProc.SendApplicationMessageFunction:=@SendApplicationMsg; @@ -122,6 +122,9 @@ FFindGlobalComponentEnabled:=true; RegisterFindGlobalComponentProc(@FindApplicationComponent); + FAutoFlipChildren := true; + FBidiMode := bdLeftToRight; +(*removed: the developer can use it in main project unit {$ifndef wince}// remove ifdef when gettext is fixed GetLanguageIDs(LangDefault, LangFallback); if LangDefault <> '' then @@ -131,6 +134,7 @@ {$else} FBidiMode := bdLeftToRight; {$endif} +*) inherited Create(AOwner); CaptureExceptions:=true; @@ -475,10 +479,14 @@ end; end; -procedure TApplication.SetBidiMode ( const AValue : TBiDiMode ) ; +procedure TApplication.SetBidiMode(const AValue: TBiDiMode) ; begin if AValue <> FBidiMode then + begin FBidiMode := AValue; + if not (csLoading in ComponentState) then + BidiModeChanged; + end; end; procedure TApplication.SetFlags(const AValue: TApplicationFlags); @@ -934,6 +942,21 @@ Result:=ParamStrUTF8(Index); end; +procedure TApplication.BidiModeChanged; +var + i: Integer; +begin + for i := 0 to ComponentCount -1 do + begin + if (Components[i] is TVisualComponent) then + begin + (Components[i] as TVisualComponent).ParentBidiModeChanged; + if AutoFlipChildren and (Components[i] is TWinControl) then + (Components[i] as TWinControl).FlipChildren(True); + end; + end; +end; + {------------------------------------------------------------------------------ Method: TApplication.IconChanged ------------------------------------------------------------------------------} Index: lcl/include/applicationproperties.inc =================================================================== --- lcl/include/applicationproperties.inc (revision 20144) +++ lcl/include/applicationproperties.inc (working copy) @@ -17,6 +17,27 @@ ***************************************************************************** } +function TApplicationProperties.GetBidiMode: TBidiMode; +begin + Result := FBidiMode; +end; + +procedure TApplicationProperties.SetAutoFlipChildren(const AValue: Boolean); +begin + FAutoFlipChildren := AValue; + + if not (csDesigning in ComponentState) then + Application.AutoFlipChildren := AValue; +end; + +procedure TApplicationProperties.SetBidiMode(const AValue: TBidiMode); +begin + FBidiMode := AValue; + + if not (csDesigning in ComponentState) then + Application.BidiMode := AValue; +end; + procedure TApplicationProperties.SetCaptureExceptions(const AValue : boolean); begin FCaptureExceptions := AValue; @@ -301,6 +322,7 @@ FTitle := Application.Title; end; FShowMainForm := True; + FAutoFlipChildren := True; FOnException := nil; FOnIdle := nil; Index: lcl/include/control.inc =================================================================== --- lcl/include/control.inc (revision 20144) +++ lcl/include/control.inc (working copy) @@ -2786,11 +2786,6 @@ Font := Parent.Font; ParentFont := true; end; - - if ParentBidiMode then begin - BiDiMode := Parent.BiDiMode; - ParentBidiMode := true; - end; end; UpdateBaseBounds(true,true,true); @@ -3889,7 +3884,6 @@ FHelpType := htContext; FDragCursor := crDrag; FFloatingDockSiteClass := TCustomDockForm; - FParentBidiMode := True; //DebugLn('TControl.Create END ',Name,':',ClassName); end; @@ -4457,94 +4451,36 @@ end; {------------------------------------------------------------------------------ - Method: TControl.SetBiDiMode + Method: TControl.CMParentBiDiModeChanged ------------------------------------------------------------------------------} -procedure TControl.SetBiDiMode(AValue: TBiDiMode); +procedure TControl.CMParentBiDiModeChanged(var Message: TLMessage); begin - if FBiDiMode=AValue then exit; - FBiDiMode:=AValue; - FParentBiDiMode := False; - Perform(CM_BIDIMODECHANGED, 0, 0); + if (Message.wParam = 0) then + ParentBidiModeChanged; end; {------------------------------------------------------------------------------ - Method: TControl.SetParentBiDiMode + Method: TControl.BiDiModeChanged ------------------------------------------------------------------------------} -procedure TControl.SetParentBiDiMode(AValue: Boolean); +procedure TControl.BiDiModeChanged; begin - if FParentBiDiMode=AValue then exit; - FParentBiDiMode:=AValue; - if (FParent <> nil) and not (csReading in ComponentState) then - Perform(CM_PARENTBIDIMODECHANGED, 0, 0); + Invalidate; end; {------------------------------------------------------------------------------ - Method: TControl.CMBiDiModeChanged + Method: TControl.ParentBiDiModeChanged ------------------------------------------------------------------------------} -procedure TControl.CMBiDiModeChanged(var Message: TLMessage); +procedure TControl.ParentBiDiModeChanged; begin - if (Message.wParam = 0) then - Invalidate; + //do not inherite it + if (FParent <> nil) and not (csDestroying in ComponentState) then + ChangeToBidiMode(FParent.BidiMode); 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 ------------------------------------------------------------------------------} Index: lcl/include/customform.inc =================================================================== --- lcl/include/customform.inc (revision 20144) +++ lcl/include/customform.inc (working copy) @@ -588,29 +588,26 @@ end; End; -procedure TCustomForm.CMBiDiModeChanged(var Message: TLMessage); +procedure TCustomForm.BiDiModeChanged; var i:Integer; - lMessage:TLMessage; begin inherited; - //send CM_PARENTBIDIMODECHANGED to All Component owned by Form -{ This way is usefull for other TMenu components that need BidiMode of form changed - Like as TToolbar } - lMessage.msg := CM_PARENTBIDIMODECHANGED; - lMessage.wParam := 0; - lMessage.lParam := 0; - lMessage.Result := 0; for i := 0 to ComponentCount - 1 do begin - if not (Components[i] is TCustomControl) then//TCustomControl already has this notification - Components[i].Dispatch(lMessage); -//the old way -// if Components[i] is TMenu then -// TMenu(Components[i]).ParentBiDiModeChanged; + if (Components[i] is TVisualComponent) and not (Components[i] is TCustomControl) then//TCustomControl already has this notification + (Components[i] as TVisualComponent).ParentBiDiModeChanged; end; end; +procedure TCustomForm.ParentBidiModeChanged; +begin + if Parent <> nil then + inherited + else if (Application <> nil) and not (csDestroying in ComponentState) then + ChangeToBidiMode(Application.BidiMode); +end; + procedure TCustomForm.CMIconChanged(var Message: TLMessage); begin IconChanged(Self); Index: lcl/include/customlabel.inc =================================================================== --- lcl/include/customlabel.inc (revision 20144) +++ lcl/include/customlabel.inc (working copy) @@ -444,7 +444,10 @@ FillChar(TR,SizeOf(TR),0); with TR do begin - Alignment := Self.Alignment; + if UseRightToLeftAlignment and (Self.Alignment = taLeftJustify) then + Alignment := taRightJustify + else + Alignment := Self.Alignment; WordBreak := wordWrap; SingleLine:= not WordWrap and not HasMultiLine; Clipping := True; Index: lcl/include/menu.inc =================================================================== --- lcl/include/menu.inc (revision 20144) +++ lcl/include/menu.inc (working copy) @@ -32,9 +32,6 @@ FItems.FMenu := Self; FImageChangeLink := TChangeLink.Create; FImageChangeLink.OnChange := @ImageListChange; - FBidiMode := bdLeftToRight; - FParentBidiMode := True; - ParentBidiModeChanged(AOwner); inherited Create(AOwner); end; @@ -49,61 +46,19 @@ FItems.UpdateImages; end; -procedure TMenu.SetBidiMode(const AValue: TBidiMode); -begin - if FBidiMode=AValue then exit; - FBidiMode:=AValue; - FParentBiDiMode := False; - if not (csLoading in ComponentState) then - BidiModeChanged; -end; -procedure TMenu.SetParentBidiMode(const AValue: Boolean); -begin - if FParentBiDiMode = AValue then exit; - FParentBiDiMode := AValue; - if not (csLoading in ComponentState) then - ParentBidiModeChanged; -end; - class procedure TMenu.WSRegisterClass; begin inherited WSRegisterClass; RegisterMenu; end; -procedure TMenu.CMParentBiDiModeChanged(var Message: TLMessage); -begin - ParentBidiModeChanged; -end; - procedure TMenu.BidiModeChanged; begin if HandleAllocated then TWSMenuClass(WidgetSetClass).SetBiDiMode(Self, UseRightToLeftAlignment, UseRightToLeftReading); end; -procedure TMenu.ParentBidiModeChanged(AOwner: TComponent); -begin - if FParentBidiMode then - begin - //Take the value from the Owner - //i can not use parent because TPopupMenu.Parent = nil - if (AOwner<>nil) - and (AOwner is TCustomForm) - and not (csDestroying in AOwner.ComponentState) then - begin - BiDiMode := TCustomForm(AOwner).BiDiMode; - FParentBiDiMode := True; - end; - end; -end; - -procedure TMenu.ParentBidiModeChanged; -begin - ParentBidiModeChanged(Owner); -end; - {------------------------------------------------------------------------------ procedure TMenu.SetParent(const AValue: TComponent); @@ -339,31 +294,4 @@ end; end; -function TMenu.IsBiDiModeStored: boolean; -begin - Result := not FParentBidiMode; -end; - -{------------------------------------------------------------------------------ - Function: TMenu.IsRightToLeft - Params: - Returns: - - - ------------------------------------------------------------------------------} -function TMenu.IsRightToLeft : Boolean; -Begin - Result := BidiMode <> bdLeftToRight; -end; - -function TMenu.UseRightToLeftAlignment : Boolean; -begin - Result := (BiDiMode = bdRightToLeft); -end; - -function TMenu.UseRightToLeftReading : Boolean; -begin - Result := (BiDiMode <> bdLeftToRight); -end; - // included by menus.pp Index: lcl/include/wincontrol.inc =================================================================== --- lcl/include/wincontrol.inc (revision 20144) +++ lcl/include/wincontrol.inc (working copy) @@ -81,7 +81,7 @@ destructor Destroy; override; procedure Clear; procedure SetControl(AControl: TControl); - procedure ApplyChildsizingBorders(ChildSizing: TControlChildSizing); + procedure ApplyChildSizingBorders(ChildSizing: TControlChildSizing); // for rows and columns procedure AllocateChildsArray(Orientation: TAutoSizeBoxOrientation; @@ -1350,7 +1350,7 @@ end; end; -procedure TAutoSizeBox.ApplyChildsizingBorders(ChildSizing: TControlChildSizing +procedure TAutoSizeBox.ApplyChildSizingBorders(ChildSizing: TControlChildSizing ); var MinBorder: LongInt; @@ -5676,7 +5676,7 @@ begin AControl.Perform(CM_PARENTCOLORCHANGED, 0, 0); AControl.Perform(CM_PARENTSHOWHINTCHANGED, 0, 0); - AControl.Perform(CM_PARENTBIDIMODECHANGED, 0, 0); + AControl.ParentBidiModeChanged; AControl.ParentFontChanged; if AControl is TWinControl then TWinControl(AControl).UpdateControlState @@ -6002,6 +6002,10 @@ for i:=0 to ControlCount-1 do begin CurControl:=Controls[i]; CurControl.Left:=AWidth-CurControl.Left-CurControl.Width; + if (akLeft in CurControl.Anchors) and not (akRight in CurControl.Anchors) then + CurControl.Anchors := CurControl.Anchors - [akLeft] + [akRight] + else if (akRight in CurControl.Anchors) and not (akLeft in CurControl.Anchors) then + CurControl.Anchors := CurControl.Anchors - [akRight] + [akLeft]; end; end; @@ -6035,11 +6039,11 @@ NotifyControls(CM_PARENTSHOWHINTCHANGED); end; -procedure TWinControl.CMBiDiModeChanged(var Message: TLMessage); +procedure TWinControl.BiDiModeChanged; begin inherited; NotifyControls(CM_PARENTBIDIMODECHANGED); - if HandleAllocated and (Message.wParam = 0) then + if HandleAllocated then TWSWinControlClass(WidgetSetClass).SetBiDiMode(Self, UseRightToLeftAlignment, UseRightToLeftReading, UseRightToLeftScrollBar); end; Index: lcl/interfaces/win32/win32trayicon.inc =================================================================== --- lcl/interfaces/win32/win32trayicon.inc (revision 20144) +++ lcl/interfaces/win32/win32trayicon.inc (working copy) @@ -168,6 +168,7 @@ WideBuffer: widestring; {$endif} Window: Windows.TWndClassEx; + FlagsEx: dword; begin vwsTrayIcon := ATrayIcon; @@ -187,8 +188,14 @@ Windows.RegisterClassEx(Window); + FlagsEx := 0; + if ATrayIcon.UseRightToLeftAlignment then + FlagsEx := FlagsEx or WS_EX_RIGHT; + if ATrayIcon.UseRightToLeftReading then + FlagsEx := FlagsEx or WS_EX_RTLREADING; + ATrayIcon.Handle := CreateWindowEx( - 0, //* Ensure that there will be no button in the bar */ + FlagsEx, //* Ensure that there will be no button in the bar */ szClassName, //* Name of the registered class */ szAppTitle, //* Title of the window */ 0, //* Style of the window */ Index: lcl/lclclasses.pp =================================================================== --- lcl/lclclasses.pp (revision 20144) +++ lcl/lclclasses.pp (working copy) @@ -81,6 +81,30 @@ property ReferenceAllocated: Boolean read GetReferenceAllocated; end; + { TVisualComponent } + + TVisualComponent = class(TLCLComponent) + private + FBiDiMode: TBiDiMode; + FParentBiDiMode: Boolean; + function IsBidiModeStored: Boolean; + procedure SetBidiMode(const AValue: TBiDiMode); + procedure SetParentBidiMode(const AValue: Boolean); + protected + procedure BidiModeChanged; virtual; + procedure Loaded; override; + procedure ChangeToBidiMode(ABidiMode: TBidiMode); + public + constructor Create(TheOwner: TComponent); override; + procedure ParentBidiModeChanged; virtual; + function IsRightToLeft: Boolean; virtual; + function UseRightToLeftAlignment: Boolean; virtual; + function UseRightToLeftReading: Boolean; virtual; + //to be published + property BidiMode: TBidiMode read FBidiMode write SetBidiMode stored IsBiDiModeStored default bdLeftToRight; + property ParentBidiMode: Boolean read FParentBidiMode write SetParentBidiMode default True; + end; + implementation uses InterfaceBase; @@ -227,5 +251,83 @@ TWSLCLReferenceComponentClass(WidgetSetClass).DestroyReference(Self); end; +{ TVisualComponent } + +function TVisualComponent.IsBidiModeStored: Boolean; +begin + Result := not FParentBidiMode; +end; + +procedure TVisualComponent.SetBidiMode(const AValue: TBiDiMode); +begin + if FBidiMode = AValue then exit; + FBidiMode := AValue; + if not (csLoading in ComponentState) then + begin + FParentBiDiMode := False; + BidiModeChanged; + end; +end; + +procedure TVisualComponent.SetParentBiDiMode(const AValue: Boolean); +begin + if FParentBiDiMode <> AValue then + begin + FParentBiDiMode := AValue; + if not (csReading in ComponentState) and not (csLoading in ComponentState) then + ParentBidiModeChanged; + end; +end; + +procedure TVisualComponent.BidiModeChanged; +begin +end; + +procedure TVisualComponent.ParentBidiModeChanged; +begin + //default for all TComponent, take from the owner, TControl must inherited it and change to FParent + if (Owner <> nil) and (Owner is TVisualComponent) and not (csDestroying in Owner.ComponentState) then + begin + ChangeToBidiMode((Owner as TVisualComponent).BidiMode); + end; +end; + +procedure TVisualComponent.ChangeToBidiMode(ABidiMode: TBidiMode); +begin + if FParentBidiMode then + begin + BidiMode := ABidiMode; + FParentBiDiMode := True; //BidiMode will change it to False so we return it back to True + end; +end; + +procedure TVisualComponent.Loaded; +begin + inherited Loaded; + ParentBidiModeChanged; +end; + +constructor TVisualComponent.Create(TheOwner: TComponent); +begin + inherited Create(TheOwner); + FParentBidiMode := True; + FBidiMode := bdLeftToRight; +end; + +function TVisualComponent.IsRightToLeft: Boolean; +begin + Result := UseRightToLeftReading; +end; + +function TVisualComponent.UseRightToLeftAlignment: Boolean; +begin + Result := (BiDiMode = bdRightToLeft); +end; + +function TVisualComponent.UseRightToLeftReading: Boolean; +begin + Result := (BiDiMode <> bdLeftToRight); +end; + end. Index: lcl/menus.pp =================================================================== --- lcl/menus.pp (revision 20144) +++ lcl/menus.pp (working copy) @@ -278,27 +278,20 @@ TFindItemKind = (fkCommand, fkHandle, fkShortCut); - TMenu = class(TLCLComponent) + TMenu = class(TVisualComponent) private - FBiDiMode: TBiDiMode; FImageChangeLink: TChangeLink; FImages: TCustomImageList; FItems: TMenuItem; FOnChange: TMenuChangeEvent; FParent: TComponent; - FParentBiDiMode: Boolean; FShortcutHandled: boolean; -//See TCustomForm.CMBiDiModeChanged - procedure CMParentBiDiModeChanged(var Message: TLMessage); message CM_PARENTBIDIMODECHANGED; - function IsBiDiModeStored: Boolean; procedure ImageListChange(Sender: TObject); - procedure SetBiDiMode(const AValue: TBiDiMode); procedure SetImages(const AValue: TCustomImageList); procedure SetParent(const AValue: TComponent); - procedure SetParentBiDiMode(const AValue: Boolean); protected class procedure WSRegisterClass; override; - procedure BidiModeChanged; virtual; + procedure BidiModeChanged; override; procedure CreateHandle; virtual; procedure DoChange(Source: TMenuItem; Rebuild: Boolean); virtual; function GetHandle: HMENU; virtual; @@ -307,8 +300,6 @@ Rebuild: Boolean); virtual; procedure Notification(AComponent: TComponent; Operation: TOperation); override; - procedure ParentBidiModeChanged; - procedure ParentBidiModeChanged(AOwner:TComponent);//used in Create constructor procedure SetChildOrder(Child: TComponent; Order: Integer); override; procedure UpdateItems; @@ -321,9 +312,6 @@ function FindItem(AValue: PtrInt; Kind: TFindItemKind) : TMenuItem; function IsShortcut(var Message: TLMKey): boolean; function HandleAllocated: Boolean; - function IsRightToLeft: Boolean; virtual; - function UseRightToLeftAlignment: Boolean; virtual; - function UseRightToLeftReading: Boolean; virtual; procedure HandleNeeded; function DispatchCommand(ACommand: Word): Boolean; public @@ -331,13 +319,12 @@ property Parent: TComponent read FParent write SetParent; property ShortcutHandled: boolean read FShortcutHandled write FShortcutHandled; published - property BidiMode:TBidiMode read FBidiMode write SetBidiMode stored IsBiDiModeStored default bdLeftToRight; - property ParentBidiMode:Boolean read FParentBidiMode write SetParentBidiMode default True; property Items: TMenuItem read FItems; property Images: TCustomImageList read FImages write SetImages; + property BidiMode; + property ParentBidiMode; end; - { TMainMenu } TMainMenu = class(TMenu) Index: lcl/popupnotifier.pas =================================================================== --- lcl/popupnotifier.pas (revision 20144) +++ lcl/popupnotifier.pas (working copy) @@ -25,7 +25,7 @@ {$endif} uses - Classes, SysUtils, Forms, Controls, Graphics, StdCtrls; + Classes, SysUtils, Forms, Controls, Graphics, StdCtrls, LCLClasses; { Note: Be careful that ExtCtrls depend on popupnotifier, so it should have only a minimal amount of dependencies to avoid circular references. Preferably only units that ExtCtrls already has } @@ -72,7 +72,7 @@ { TPopupNotifier } - TPopupNotifier = class(TComponent) + TPopupNotifier = class(TVisualComponent) private function GetColor: TColor; procedure SetColor(const Value: TColor); @@ -86,6 +86,8 @@ procedure SetVisible(const Value: Boolean); procedure SetOnClose(const Value: TCloseEvent); function GetOnClose:TCloseEvent; + protected + procedure BidiModeChanged; override; public vNotifierForm: TNotifierForm; constructor Create(AOwner: TComponent); override; @@ -100,6 +102,8 @@ property Title: string read GetTitle write SetTitle; property Visible: Boolean read GetVisible write SetVisible; property OnClose: TCloseEvent read GetOnClose write SetOnClose; + property BidiMode; + property ParentBidiMode; end; const @@ -365,7 +369,13 @@ Result := VNotifierForm.Onclose; end; +procedure TPopupNotifier.BidiModeChanged; +begin + inherited BidiModeChanged; + vNotifierForm.BidiMode := BidiMode; +end; + function TPopupNotifier.GetVisible: Boolean; begin Result := vNotifierForm.Visible; @@ -414,6 +424,7 @@ inherited Create(AOwner); vNotifierForm := TNotifierForm.Create(nil); + vNotifierForm.BidiMode := BidiMode; vNotifierForm.Visible := False; end;