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

LCL: TFont: add TFont.PixelsPerInch setter - the Height/Size ratio wasn't correct after change of PixelsPerInch.

Browse Source 
git-svn-id: trunk@54209 -
This commit is contained in:
ondrej 2017-02-20 13:53:32 +00:00
parent fefe00702a
commit 1b57bc9ee8
2 changed files with 15 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/graphics.pp
View File

@ -528,6 +528,7 @@ type
procedure SetData(const FontData: TFontData);
procedure SetHandle(const Value: HFONT);
procedure ReferenceNeeded;
procedure SetPixelsPerInch(const APixelsPerInch: Integer);
protected
function GetCharSet: TFontCharSet;
function GetHeight: Integer;
@ -568,7 +569,7 @@ type
property IsMonoSpace: boolean read GetIsMonoSpace;
procedure SetDefault;
property CanUTF8: boolean read GetCanUTF8; deprecated;
property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch;
property PixelsPerInch: Integer read FPixelsPerInch write SetPixelsPerInch;
property Reference: TWSFontReference read GetReference;
published
property CharSet: TFontCharSet read GetCharSet write SetCharSet default DEFAULT_CHARSET;

13
lcl/include/font.inc
View File

@ -850,6 +850,19 @@ Begin
end;
end;
procedure TFont.SetPixelsPerInch(const APixelsPerInch: Integer);
var
OldPPI: Integer;
begin
if FPixelsPerInch = APixelsPerInch then Exit;
OldPPI := FPixelsPerInch;
FPixelsPerInch := APixelsPerInch;
// the Height value is not correct anymore -> force recalculate it
if Height<>0 then
Height := MulDiv(Height, APixelsPerInch, OldPPI);
end;
{------------------------------------------------------------------------------
Method: TFont.SetHeight
Params: Value: the new value