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

BiDiMode patch from zaher dirkey (report 0008955)

Browse Source 
git-svn-id: trunk@11209 -
This commit is contained in:
paul 2007-05-28 09:06:36 +00:00
parent 2ab9c1ae5a
commit 0b6ce0bd99
10 changed files with 180 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
lcl/buttons.pp
View File

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

18
lcl/controls.pp
View File

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

7
lcl/forms.pp
View File

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

102
lcl/include/control.inc
View File

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

8
lcl/include/wincontrol.inc
View File

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

14
lcl/interfaces/win32/win32wsbuttons.pp
View File

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

7
lcl/interfaces/win32/win32wsforms.pp
View File

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

14
lcl/interfaces/win32/win32wsstdctrls.pp
View File

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

5
lcl/stdctrls.pp
View File

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

6
lcl/widgetset/wscontrols.pp
View File

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