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

LCL: control: fix 0-height font scaling

Browse Source 
git-svn-id: trunk@54220 -
This commit is contained in:
ondrej 2017-02-21 11:59:27 +00:00
parent 8b4aa08543
commit 00e450bfa7
1 changed files with 3 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
lcl/include/control.inc
View File

@ -1877,11 +1877,11 @@ end;
class procedure TControl.DoScaleFontPPI(const AFont: TFont; class procedure TControl.DoScaleFontPPI(const AFont: TFont;
const AProportion: Double); const AProportion: Double);
begin begin
AFont.PixelsPerInch := Round(AFont.PixelsPerInch*AProportion); // If AFont.PixelsPerInch is different from "Screen.PixelsPerInch" (=GetDeviceCaps(DC, LOGPIXELSX))
// If AFont.PixelsPerInch is different from "Screen.PixelsPerInch" (=GetDeviceCaps(DC, LOGPIXELSX)
// then the font doesn't scale -> we have to assign a nonzero height value. // then the font doesn't scale -> we have to assign a nonzero height value.
if AFont.Height=0 then if AFont.Height=0 then
AFont.Height := Round(GetFontData(AFont.Reference.Handle).Height*AProportion); AFont.Height := MulDiv(GetFontData(AFont.Reference.Handle).Height, AFont.PixelsPerInch, Screen.PixelsPerInch);
AFont.PixelsPerInch := Round(AFont.PixelsPerInch*AProportion);
end; end;
function TControl.IsAParentAligning: boolean; function TControl.IsAParentAligning: boolean;