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

lcl: control: high-DPI: correctly scale base bounds. Issue #31992

Browse Source 
git-svn-id: trunk@55537 -
This commit is contained in:
ondrej 2017-07-18 20:51:36 +00:00
parent 6bf088db97
commit 0a2fe800e3
1 changed files with 19 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
lcl/include/control.inc
View File

@ -3046,7 +3046,7 @@ procedure TControl.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
var
AAWidth, AAHeight: Boolean;
NewLeft, NewTop, NewWidth, NewHeight, NewRight, NewBottom, OldWidth, OldHeight,
BeforeConstraintsWidth, BeforeConstraintsHeight: Integer;
NewBaseLeft, NewBaseTop, NewBaseWidth, NewBaseHeight: Integer;
begin
// Apply the changes
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
@ -3112,23 +3112,36 @@ begin
BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion);
Constraints.AutoAdjustLayout(AXProportion, AYProportion);
BeforeConstraintsWidth := NewWidth;
NewBaseLeft := NewLeft;
NewBaseTop := NewTop;
NewBaseWidth := NewWidth;
NewBaseHeight := NewHeight;
NewWidth := Constraints.MinMaxWidth(NewWidth);
BeforeConstraintsHeight := NewHeight;
NewHeight := Constraints.MinMaxHeight(NewHeight);
if AAWidth or (BeforeConstraintsWidth<>NewWidth) then
if AAWidth or (NewBaseWidth<>NewWidth) then
begin
if akRight in Anchors then
NewLeft := NewLeft-NewWidth+OldWidth;
end;
if AAHeight or (BeforeConstraintsHeight<>NewHeight) then
if AAHeight or (NewBaseHeight<>NewHeight) then
begin
if akBottom in Anchors then
NewTop := NewTop-NewHeight+OldHeight;
end;
if AAWidth and (akRight in Anchors) then
NewBaseLeft := NewBaseLeft-NewBaseWidth+OldWidth;
if AAHeight and (akBottom in Anchors) then
NewBaseTop := NewBaseTop-NewBaseHeight+OldHeight;
SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
FBaseBounds.Left:=NewBaseLeft;
FBaseBounds.Top:=NewBaseTop;
FBaseBounds.Right:=NewBaseLeft+NewBaseWidth;
FBaseBounds.Bottom:=NewBaseTop+NewBaseHeight;
FBaseParentClientSize.cx:=Parent.ClientWidth;
FBaseParentClientSize.cy:=Parent.ClientHeight;
SetBoundsKeepBase(NewLeft, NewTop, NewWidth, NewHeight);
finally
EnableAutoSizing{$IFDEF DebugDisableAutoSizing}('TControl.DoAutoAdjustLayout'){$ENDIF};
end;