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

Merged revision(s) 57265 #4a4c2d9374 from trunk:

Browse Source 
LCL:fix scaling of font size set to <>0 in design time. Issue #33132, regression after r56962 #d7f8f5e5f6
........

git-svn-id: branches/fixes_1_8@57296 -
This commit is contained in:
maxim 2018-02-13 21:22:02 +00:00
parent 626cb4bcd8
commit aa24def062
3 changed files with 32 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
lcl/controls.pp
View File

@ -1550,6 +1550,7 @@ type
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
const AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth: Integer); virtual;
procedure ShouldAutoAdjust(var AWidth, AHeight: Boolean); virtual;
procedure FixDesignFontsPPI(const ADesignTimePPI: Integer); virtual;
procedure ScaleFontsPPI(const AToPPI: Integer; const AProportion: Double); virtual;
public
constructor Create(TheOwner: TComponent);override;

15
lcl/include/control.inc
View File

@ -936,6 +936,19 @@ procedure TControl.ExecuteDefaultAction;
begin
end;
procedure TControl.FixDesignFontsPPI(const ADesignTimePPI: Integer);
begin
// Problem: Font.PixelsPerInch isn't saved in the LFM, therefore the
// design-time font PPI is different from the one that is loaded on target
// machine, which results in different font scaling.
// DoFixDesignFont restores the corrent design-time font PPI so that it can
// be used for LCL HighDPI scaling.
// Override this function - list all custom fonts in the overriden procedure
// To-Do: maybe save Font.PixelsPerInch in the LFM and remove this?
DoFixDesignFontPPI(Font, ADesignTimePPI);
end;
procedure TControl.ExecuteCancelAction;
begin
end;
@ -1911,7 +1924,7 @@ begin
if (AFont.Height=0) and not (csDesigning in ComponentState) then
AFont.Height := MulDiv(GetFontData(AFont.Reference.Handle).Height, AFont.PixelsPerInch, Screen.PixelsPerInch);
if AToPPI>0 then
AFont.PixelsPerInch := MulDiv(AFont.PixelsPerInch, AToPPI, AFont.PixelsPerInch)
AFont.PixelsPerInch := AToPPI
else
AFont.PixelsPerInch := Round(AFont.PixelsPerInch*AProportion);
end;

17
lcl/include/customdesigncontrol.inc
View File

@ -57,10 +57,27 @@ begin
end;
procedure TCustomDesignControl.Loaded;
procedure FixChildren(const AParent: TWinControl);
var
I: Integer;
begin
for I := 0 to AParent.ControlCount-1 do
begin
AParent.Controls[I].FixDesignFontsPPI(FDesignTimePPI);
if AParent.Controls[I] is TWinControl then
FixChildren(TWinControl(AParent.Controls[I]));
end;
end;
begin
inherited Loaded;
FPixelsPerInch := FDesignTimePPI;
if Application.Scaled and Scaled then
begin
FixDesignFontsPPI(FDesignTimePPI);
FixChildren(Self);
end;
end;
procedure TCustomDesignControl.SetDesignTimePPI(const ADesignTimePPI: Integer);