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

lcl: highDPI: handle right and bottom anchored controls in AutoAdjustLayout.

Browse Source 
git-svn-id: trunk@53555 -
This commit is contained in:
ondrej 2016-12-03 23:07:10 +00:00
parent d8b8e86cdf
commit 58c2446357
8 changed files with 62 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
components/lazcontrols/dividerbevel.pas
View File

@ -54,7 +54,7 @@ type
{%H-}WithThemeSpace: Boolean); override;
public
constructor Create(AOwner: TComponent); override;
procedure ShouldAutoAdjust(var ALeft, ATop, AWidth, AHeight: Boolean); override;
procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); override;
published
property Caption;
property Align;
@ -397,15 +397,11 @@ begin
end;
end;
procedure TDividerBevel.ShouldAutoAdjust(var ALeft, ATop, AWidth,
procedure TDividerBevel.ShouldAutoAdjust(var AWidth,
AHeight: Boolean);
begin
ALeft := (Align = alNone) and (Parent <> nil);
ATop := ALeft;
AWidth := (Align in [alNone, alLeft, alRight])
and (AutoSize = False) and not (Orientation = trVertical);
AHeight := (Align in [alNone, alTop, alBottom])
and (AutoSize = False) and not (Orientation = trHorizontal);
AWidth := not (AutoSize and (Orientation = trVertical));
AHeight := not (AutoSize and (Orientation = trHorizontal));
end;
constructor TDividerBevel.Create(AOwner: TComponent);

2
lcl/controls.pp
View File

@ -1531,7 +1531,7 @@ type
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
const AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth: Integer;
const AScaleFonts: Boolean); virtual;
procedure ShouldAutoAdjust(var ALeft, ATop, AWidth, AHeight: Boolean); virtual;
procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); virtual;
public
constructor Create(TheOwner: TComponent);override;
destructor Destroy; override;

10
lcl/groupededit.pp
View File

@ -243,7 +243,7 @@ type
procedure SetAutoSize(AValue: Boolean); override;
procedure SetColor(AValue: TColor); override;
procedure SetCursor(AValue: TCursor); override;
procedure ShouldAutoAdjust(var ALeft, ATop, AWidth, AHeight: Boolean); override;
procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); override;
property AutoSelect: Boolean read GetAutoSelect write SetAutoSelect default True;
property AutoSelected: Boolean read GetAutoSelected write SetAutoSelected;
@ -847,13 +847,11 @@ begin
FEdit.Cursor := AValue;
end;
procedure TCustomAbstractGroupedEdit.ShouldAutoAdjust(var ALeft, ATop, AWidth,
procedure TCustomAbstractGroupedEdit.ShouldAutoAdjust(var AWidth,
AHeight: Boolean);
begin
ALeft := (Align = alNone) and (Parent <> nil);
ATop := ALeft;
AWidth := (Align in [alNone, alLeft, alRight]);
AHeight := (Align in [alNone, alTop, alBottom]) and (AutoSize = False);
AWidth := True;
AHeight := not AutoSize;
end;
procedure TCustomAbstractGroupedEdit.SetFocus;

62
lcl/include/control.inc
View File

@ -2943,8 +2943,8 @@ end;
procedure TControl.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double; const AScaleFonts: Boolean);
var
NewLeft, NewTop, NewHeight, NewWidth: Integer;
AALeft, AATop, AAWidth, AAHeight: Boolean;
AAWidth, AAHeight: Boolean;
NewLeft, NewTop, NewWidth, NewHeight, OldWidth, OldHeight: Integer;
begin
if AScaleFonts and not ParentFont then
Font.Height := Round(GetFontData(Font.Reference.Handle).Height*AYProportion);
@ -2952,21 +2952,31 @@ begin
// Apply the changes
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
AALeft := False;
AATop := False;
AAWidth := False;
AAHeight := False;
NewLeft := Left;
NewTop := Top;
NewWidth := Width;
NewHeight := Height;
ShouldAutoAdjust(AALeft, AATop, AAWidth, AAHeight);
if AALeft then
NewLeft := Round(Left * AXProportion)
else
NewLeft := Left;
if AATop then
NewTop := Round(Top * AYProportion)
else
NewTop := Top;
OldWidth := Width;
OldHeight := Height;
ShouldAutoAdjust(AAWidth, AAHeight);
AAWidth := AAWidth and (Align in [alNone, alLeft, alRight])
and not((akLeft in Anchors) and (akRight in Anchors));
AAHeight := AAHeight and (Align in [alNone, alTop, alBottom])
and not((akTop in Anchors) and (akBottom in Anchors));
if (Align=alNone) and (akLeft in Anchors) then
NewLeft := Round(NewLeft * AXProportion);
if (Align=alNone) and (akRight in Anchors) and (Parent<>nil) then
NewLeft := Parent.ClientWidth-Round((Parent.ClientWidth-NewLeft-OldWidth) * AXProportion)-OldWidth;
if (Align=alNone) and (akTop in Anchors) then
NewTop := Round(NewTop * AYProportion);
if (Align=alNone) and (akBottom in Anchors) and (Parent<>nil) then
NewTop := Parent.ClientHeight-Round((Parent.ClientHeight-NewTop-OldHeight) * AYProportion)-OldHeight;
// Give a shake at the autosize to recalculate font sizes for example
if (not AAWidth or not AAHeight) and AutoSize then
begin
@ -2979,6 +2989,22 @@ begin
if AAHeight then
NewHeight := Round(Height * AYProportion);
if Anchors*[akLeft, akRight] = [akRight] then
NewLeft := NewLeft+Width-NewWidth;
if Anchors*[akTop, akBottom] = [akBottom] then
NewTop := NewTop+Height-NewHeight;
if AAWidth then
begin
if akRight in Anchors then
NewLeft := NewLeft-NewWidth+OldWidth;
end;
if AAHeight then
begin
if akBottom in Anchors then
NewTop := NewTop-NewHeight+OldHeight;
end;
SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
end;
end;
@ -3933,13 +3959,11 @@ begin
DoAutoAdjustLayout(lMode, lXProportion, lYProportion, AScaleFonts);
end;
// Auto-adjust the layout of controls without alignment. Custom anchoring is allowed.
procedure TControl.ShouldAutoAdjust(var ALeft, ATop, AWidth, AHeight: Boolean);
// Auto-adjust the layout of controls.
procedure TControl.ShouldAutoAdjust(var AWidth, AHeight: Boolean);
begin
ALeft := (Align = alNone) and (Parent <> nil);
ATop := ALeft;
AWidth := (Align in [alNone, alLeft, alRight]) and (AutoSize = False);
AHeight := (Align in [alNone, alTop, alBottom]) and (AutoSize = False);
AWidth := not AutoSize;
AHeight := not AutoSize;
end;
procedure TControl.UpdateAnchorRules;

9
lcl/include/customcombobox.inc
View File

@ -622,13 +622,10 @@ begin
Result := False;
end;
procedure TCustomComboBox.ShouldAutoAdjust(var ALeft, ATop, AWidth,
AHeight: Boolean);
procedure TCustomComboBox.ShouldAutoAdjust(var AWidth, AHeight: Boolean);
begin
ALeft := (Align = alNone) and (Parent <> nil);
ATop := ALeft;
AWidth := (Align in [alNone, alLeft, alRight]);
AHeight := (Align in [alNone, alTop, alBottom]) and (AutoSize = False);
AWidth := True;
AHeight := not AutoSize;
end;
{------------------------------------------------------------------------------

9
lcl/include/customedit.inc
View File

@ -505,13 +505,10 @@ begin
inherited WndProc(Message);
end;
procedure TCustomEdit.ShouldAutoAdjust(var ALeft, ATop, AWidth, AHeight: Boolean
);
procedure TCustomEdit.ShouldAutoAdjust(var AWidth, AHeight: Boolean);
begin
ALeft := (Align = alNone) and (Parent <> nil);
ATop := ALeft;
AWidth := (Align in [alNone, alLeft, alRight]);
AHeight := (Align in [alNone, alTop, alBottom]) and (AutoSize = False);
AWidth := True;
AHeight := not AutoSize;
end;
procedure TCustomEdit.CMWantSpecialKey(var Message: TCMWantSpecialKey);

4
lcl/include/wincontrol.inc
View File

@ -3841,10 +3841,10 @@ procedure TWinControl.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
var
i: Integer;
begin
inherited AutoAdjustLayout(AMode, AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth, AScaleFonts);
for i:=0 to ControlCount-1 do
Controls[i].AutoAdjustLayout(AMode, AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth, AScaleFonts);
inherited AutoAdjustLayout(AMode, AFromDPI, AToDPI, AOldFormWidth, ANewFormWidth, AScaleFonts);
end;
{------------------------------------------------------------------------------

4
lcl/stdctrls.pp
View File

@ -345,7 +345,7 @@ type
procedure UTF8KeyPress(var UTF8Key: TUTF8Char); override;
procedure MouseUp(Button: TMouseButton; Shift:TShiftState; X, Y: Integer); override;
function SelectItem(const AnItem: String): Boolean;
procedure ShouldAutoAdjust(var ALeft, ATop, AWidth, AHeight: Boolean); override;
procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); override;
property ItemHeight: Integer read GetItemHeight write SetItemHeight;
property ItemWidth: Integer read GetItemWidth write SetItemWidth default 0;
@ -765,7 +765,7 @@ type
procedure WMChar(var Message: TLMChar); message LM_CHAR;
procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure WndProc(var Message: TLMessage); override;
procedure ShouldAutoAdjust(var ALeft, ATop, AWidth, AHeight: Boolean); override;
procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); override;
property AutoSelect: Boolean read FAutoSelect write FAutoSelect default True;
property AutoSelected: Boolean read FAutoSelected write FAutoSelected;