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

lcl: TControl: highDPI: scale margins and constraints.

Browse Source 
git-svn-id: trunk@53576 -
This commit is contained in:
ondrej 2016-12-06 14:50:02 +00:00
parent 6b37ddd73e
commit 110955f1da
3 changed files with 63 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
lcl/controls.pp
View File

@ -622,6 +622,7 @@ type
function EffectiveMaxHeight: integer; virtual;
function MinMaxWidth(Width: integer): integer;
function MinMaxHeight(Height: integer): integer;
procedure AutoAdjustLayout(const AXProportion, AYProportion: Double);
public
property MaxInterfaceHeight: integer read FMaxInterfaceHeight;
property MaxInterfaceWidth: integer read FMaxInterfaceWidth;
@ -742,6 +743,7 @@ type
procedure GetSpaceAround(var SpaceAround: TRect); virtual;
function GetSideSpace(Kind: TAnchorKind): Integer; // Around+GetSpace
function GetSpace(Kind: TAnchorKind): Integer; virtual;
procedure AutoAdjustLayout(const AXProportion, AYProportion: Double);
public
property Control: TControl read FControl;
property Space[Kind: TAnchorKind]: integer read GetSpace write SetSpace;
@ -3643,6 +3645,37 @@ begin
Dest.Assign(Self);
end;
procedure TControlBorderSpacing.AutoAdjustLayout(const AXProportion,
AYProportion: Double);
procedure Scale(var Value: Integer; const Proportion: Double; var Changed: Boolean);
begin
if Value<>0 then
begin
Value := Round(Value * Proportion);
Changed := True;
end;
end;
var
InnerChanged, OuterChanged: Boolean;
begin
InnerChanged := False;
OuterChanged := False;
Scale(FAround, AXProportion, OuterChanged);
Scale(FInnerBorder, AXProportion, InnerChanged);
Scale(FLeft, AXProportion, OuterChanged);
Scale(FTop, AYProportion, OuterChanged);
Scale(FRight, AXProportion, OuterChanged);
Scale(FBottom, AYProportion, OuterChanged);
if OuterChanged or InnerChanged then
begin
if Control<>nil then Control.InvalidatePreferredSize;
Change(InnerChanged);
end;
end;
function TControlBorderSpacing.IsEqual(Spacing: TControlBorderSpacing
): boolean;
begin

5
lcl/include/control.inc
View File

@ -2981,6 +2981,8 @@ begin
// Apply the changes
if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
begin
// Dimensions
AAWidth := False;
AAHeight := False;
NewLeft := Left;
@ -3054,6 +3056,9 @@ begin
NewTop := NewTop-NewHeight+OldHeight;
end;
BorderSpacing.AutoAdjustLayout(AXProportion, AYProportion);
Constraints.AutoAdjustLayout(AXProportion, AYProportion);
SetBounds(NewLeft, NewTop, NewWidth, NewHeight);
end;
end;

25
lcl/include/sizeconstraints.inc
View File

@ -264,4 +264,29 @@ begin
end;
end;
procedure TSizeConstraints.AutoAdjustLayout(const AXProportion,
AYProportion: Double);
procedure Scale(var Value: Integer; const Proportion: Double; var Changed: Boolean);
begin
if Value<>0 then
begin
Value := Round(Value * Proportion);
Changed := True;
end;
end;
var
Changed: Boolean;
begin
Changed := False;
Scale(FMaxWidth, AXProportion, Changed);
Scale(FMinWidth, AXProportion, Changed);
Scale(FMaxHeight, AYProportion, Changed);
Scale(FMinHeight, AYProportion, Changed);
if Changed then
Change;
end;
// included by controls.pp