Commit 4a4c2d93 authored by ondrej's avatar ondrej
Browse files

LCL:fix scaling of font size set to <>0 in design time. Issue #33132,...

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

git-svn-id: trunk@57265 -
parent 248e7792
......@@ -1597,6 +1597,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;
......
......@@ -943,6 +943,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;
......@@ -1918,7 +1931,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;
......
......@@ -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);
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment