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

LCL: High-DPI: disable/enable auto sizing on scale.

Browse Source 
git-svn-id: trunk@54359 -
This commit is contained in:
ondrej 2017-03-07 13:52:49 +00:00
parent ae7acd5803
commit 8537762cb8
3 changed files with 87 additions and 72 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

129
lcl/include/control.inc
View File

@ -3008,77 +3008,82 @@ begin
// Apply the changes // Apply the changes
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin begin
if not ParentFont or (Parent=nil) then DisableAutoSizing;
ScaleFontsPPI(AYProportion); try
if not ParentFont or (Parent=nil) then
ScaleFontsPPI(AYProportion);
// Dimensions // Dimensions
AAWidth := False; AAWidth := False;
AAHeight := False; AAHeight := False;
NewLeft := Left; NewLeft := Left;
NewTop := Top; NewTop := Top;
NewWidth := Width; NewWidth := Width;
NewHeight := Height; NewHeight := Height;
OldWidth := Width; OldWidth := Width;
OldHeight := Height; OldHeight := Height;
ShouldAutoAdjust(AAWidth, AAHeight); ShouldAutoAdjust(AAWidth, AAHeight);
AAWidth := AAWidth and (Align in [alNone, alLeft, alRight]) AAWidth := AAWidth and (Align in [alNone, alLeft, alRight])
and not((akLeft in Anchors) and (akRight in Anchors)); and not((akLeft in Anchors) and (akRight in Anchors));
AAHeight := AAHeight and (Align in [alNone, alTop, alBottom]) AAHeight := AAHeight and (Align in [alNone, alTop, alBottom])
and not((akTop in Anchors) and (akBottom in Anchors)); and not((akTop in Anchors) and (akBottom in Anchors));
if (Align=alNone) and (akLeft in Anchors) then if (Align=alNone) and (akLeft in Anchors) then
NewLeft := Round(NewLeft * AXProportion); NewLeft := Round(NewLeft * AXProportion);
if (Align=alNone) and (akRight in Anchors) and (Parent<>nil) if (Align=alNone) and (akRight in Anchors) and (Parent<>nil)
and (AnchorSideRight.Control=nil) then and (AnchorSideRight.Control=nil) then
begin
if not(akLeft in Anchors) then
begin begin
NewRight := Round((Parent.ClientWidth-NewLeft-OldWidth) * AXProportion); if not(akLeft in Anchors) then
NewLeft := Parent.ClientWidth-NewRight-OldWidth begin
end else NewRight := Round((Parent.ClientWidth-NewLeft-OldWidth) * AXProportion);
begin NewLeft := Parent.ClientWidth-NewRight-OldWidth
NewRight := Round((Parent.ClientWidth-Left-OldWidth) * AXProportion); end else
NewWidth := Parent.ClientWidth-NewLeft-NewRight; begin
NewRight := Round((Parent.ClientWidth-Left-OldWidth) * AXProportion);
NewWidth := Parent.ClientWidth-NewLeft-NewRight;
end;
end; end;
end;
if (Align=alNone) and (akTop in Anchors) then if (Align=alNone) and (akTop in Anchors) then
NewTop := Round(NewTop * AYProportion); NewTop := Round(NewTop * AYProportion);
if (Align=alNone) and (akBottom in Anchors) and (Parent<>nil) if (Align=alNone) and (akBottom in Anchors) and (Parent<>nil)
and (AnchorSideBottom.Control=nil) then and (AnchorSideBottom.Control=nil) then
begin
if not(akTop in Anchors) then
begin begin
NewBottom := Round((Parent.ClientHeight-NewTop-OldHeight) * AYProportion); if not(akTop in Anchors) then
NewTop := Parent.ClientHeight-NewBottom-OldHeight begin
end else NewBottom := Round((Parent.ClientHeight-NewTop-OldHeight) * AYProportion);
begin NewTop := Parent.ClientHeight-NewBottom-OldHeight
NewBottom := Round((Parent.ClientHeight-Top-OldHeight) * AYProportion); end else
NewHeight := Parent.ClientHeight-NewTop-NewBottom; begin
NewBottom := Round((Parent.ClientHeight-Top-OldHeight) * AYProportion);
NewHeight := Parent.ClientHeight-NewTop-NewBottom;
end;
end; end;
if AAWidth then
NewWidth := Round(Width * AXProportion);
if AAHeight then
NewHeight := Round(Height * AYProportion);
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;
BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion);
Constraints.AutoAdjustLayout(AXProportion, AYProportion);
SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
finally
EnableAutoSizing;
end; end;
if AAWidth then
NewWidth := Round(Width * AXProportion);
if AAHeight then
NewHeight := Round(Height * AYProportion);
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;
BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion);
Constraints.AutoAdjustLayout(AXProportion, AYProportion);
SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
end; end;
end; end;

19
lcl/include/customform.inc
View File

@ -1581,16 +1581,21 @@ begin
// Apply the changes // Apply the changes
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin begin
if not ParentFont or (Parent=nil) then DisableAutoSizing;
ScaleFontsPPI(AYProportion); try
if not ParentFont or (Parent=nil) then
ScaleFontsPPI(AYProportion);
NewWidth := Round(Width*AXProportion); NewWidth := Round(Width*AXProportion);
NewHeight := Round(Height*AYProportion); NewHeight := Round(Height*AYProportion);
BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion); BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion);
Constraints.AutoAdjustLayout(AXProportion, AYProportion); Constraints.AutoAdjustLayout(AXProportion, AYProportion);
SetBounds(Left, Top, NewWidth, NewHeight); SetBounds(Left, Top, NewWidth, NewHeight);
finally
EnableAutoSizing;
end;
end; end;
end; end;

11
lcl/include/wincontrol.inc
View File

@ -3844,10 +3844,15 @@ procedure TWinControl.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
var var
i: Integer; i: Integer;
begin begin
for i:=0 to ControlCount-1 do DisableAutoSizing;
Controls[i].AutoAdjustLayout(AMode, AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth); try
for i:=0 to ControlCount-1 do
Controls[i].AutoAdjustLayout(AMode, AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth);
inherited; inherited;
finally
EnableAutoSizing;
end;
end; end;
{------------------------------------------------------------------------------ {------------------------------------------------------------------------------