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

LCL: control: fix design font PPI only if ParentFont=False

Browse Source 
git-svn-id: trunk@54292 -
This commit is contained in:
ondrej 2017-02-27 14:01:06 +00:00
parent df06ce604d
commit dec8fb4e29
2 changed files with 14 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
lcl/include/control.inc
View File

@ -913,7 +913,8 @@ begin
// be used for LCL HighDPI scaling. // be used for LCL HighDPI scaling.
// Override this function - list all custom fonts in the overriden procedure // Override this function - list all custom fonts in the overriden procedure
DoFixDesignFontPPI(Font, ADesignTimePPI); if not ParentFont then
DoFixDesignFontPPI(Font, ADesignTimePPI);
end; end;
procedure TControl.ExecuteCancelAction; procedure TControl.ExecuteCancelAction;

17
lcl/include/customdesigncontrol.inc
View File

@ -31,8 +31,17 @@ begin
end; end;
procedure TCustomDesignControl.Loaded; procedure TCustomDesignControl.Loaded;
var procedure FixChildren(const AParent: TWinControl);
I: Integer; 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 begin
inherited Loaded; inherited Loaded;
@ -41,9 +50,7 @@ begin
if Application.Scaled and Scaled then if Application.Scaled and Scaled then
begin begin
FixDesignFontsPPI(FDesignTimePPI); FixDesignFontsPPI(FDesignTimePPI);
for I := 0 to ComponentCount-1 do FixChildren(Self);
if Components[I] is TControl then
TControl(Components[I]).FixDesignFontsPPI(FDesignTimePPI);
end; end;
end; end;