paweld/lazarus
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/lazarus/lazarus.git synced 2025-04-05 12:38:05 +02:00
Code Issues Packages Projects Releases Wiki Activity

LCL: high-DPI: fix inplace frames. Issue #36370

Browse Source 
git-svn-id: trunk@62507 -
This commit is contained in:
ondrej 2020-01-07 21:14:44 +00:00
parent f97bf899bb
commit f5da5df4fb
32 changed files with 61 additions and 129 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
designer/jitforms.pp
View File

@ -57,7 +57,7 @@ uses
PackageDependencyIntf, PropEditUtils, PropEdits, UnitResources, IDEDialogs,
// IDE
{$IFDEF VerboseJITForms}DesignerProcs,{$ENDIF}
PackageDefs;
PackageDefs, Project, EnvironmentOpts;
type
//----------------------------------------------------------------------------
@ -1136,6 +1136,7 @@ var
AncestorStreams: TFPList;
i, j: Integer;
OldStreamClass: TClass;
DsgnComp, DsgnOwner: TCustomDesignControl;
begin
fCurReadChild:=Component;
fCurReadChildClass:=ComponentClass;
@ -1196,6 +1197,19 @@ begin
// next
Ancestor:=TComponent(Ancestors[i]);
end;
// scale to Owner's DesignTimePPI to get correct designed sizes - issue #36370
if (Project1.Scaled or EnvironmentOptions.ForceDPIScalingInDesignTime)
and Assigned(Component) and (Component is TCustomDesignControl) and (NewOwner is TCustomDesignControl) then
begin
DsgnComp := TCustomDesignControl(Component);
DsgnOwner := TCustomDesignControl(NewOwner);
if DsgnComp.Scaled and DsgnOwner.Scaled
and (DsgnComp.DesignTimePPI<>DsgnOwner.PixelsPerInch) then
begin
DsgnComp.AutoAdjustLayout(lapAutoAdjustForDPI, DsgnComp.PixelsPerInch, DsgnOwner.DesignTimePPI, 0, 0);
DsgnComp.DesignTimePPI := DsgnOwner.DesignTimePPI;
end;
end;
end;
finally
Ancestors.Free;

2
ide/customformeditor.pp
View File

@ -1089,6 +1089,8 @@ begin
Ancestor:=nil;
if AncestorUnit<>nil then
Ancestor:=AncestorUnit.Component;
if AnUnitInfo.Component is TCustomDesignControl then // set DesignTimePPI on save
TCustomDesignControl(AnUnitInfo.Component).DesignTimePPI := TCustomDesignControl(AnUnitInfo.Component).PixelsPerInch;
Writer.WriteDescendent(AnUnitInfo.Component,Ancestor);
if DestroyDriver then Writer.Driver.Free;
FreeAndNil(Writer);

2
ide/sourcefilemanager.pas
View File

@ -5005,6 +5005,8 @@ begin
if AncestorUnit<>nil then
Ancestor:=AncestorUnit.Component;
//DebugLn(['SaveUnitComponent Writer.WriteDescendent ARoot=',AnUnitInfo.Component,' Ancestor=',DbgSName(Ancestor)]);
if AnUnitInfo.Component is TCustomDesignControl then // set DesignTimePPI on save
TCustomDesignControl(AnUnitInfo.Component).DesignTimePPI := TCustomDesignControl(AnUnitInfo.Component).PixelsPerInch;
Writer.WriteDescendent(AnUnitInfo.Component,Ancestor);
if DestroyDriver then
Writer.Driver.Free;

1
lcl/controls.pp
View File

@ -2305,6 +2305,7 @@ type
procedure WriteLayoutDebugReport(const Prefix: string); override;
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; const AFromPPI,
AToPPI, AOldFormWidth, ANewFormWidth: Integer); override;
procedure FixDesignFontsPPIWithChildren(const ADesignTimePPI: Integer);
public
constructor Create(TheOwner: TComponent);override;
constructor CreateParented(AParentWindow: HWND);

4
lcl/forms.pp
View File

@ -268,20 +268,20 @@ type
FDesignTimePPI: Integer;
FPixelsPerInch: Integer;
function DesignTimePPIIsStored: Boolean;
procedure SetDesignTimePPI(const ADesignTimePPI: Integer);
protected
procedure SetScaled(const AScaled: Boolean); virtual;
procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
const AXProportion, AYProportion: Double); override;
procedure Loaded; override;
public
constructor Create(TheOwner: TComponent); override;
procedure AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy; const AFromPPI,
AToPPI, AOldFormWidth, ANewFormWidth: Integer); override;
public
property DesignTimePPI: Integer read FDesignTimePPI write SetDesignTimePPI default 96;
property DesignTimePPI: Integer read FDesignTimePPI write SetDesignTimePPI stored DesignTimePPIIsStored;
property PixelsPerInch: Integer read FPixelsPerInch write FPixelsPerInch stored False;
property Scaled: Boolean read FScaled write SetScaled default True;
end;

50
lcl/include/customdesigncontrol.inc
View File

@ -25,12 +25,26 @@ end;
procedure TCustomDesignControl.AutoAdjustLayout(AMode: TLayoutAdjustmentPolicy;
const AFromPPI, AToPPI, AOldFormWidth, ANewFormWidth: Integer);
begin
inherited;
if (AMode = lapAutoAdjustForDPI) and (AToPPI=FPixelsPerInch) then // don't do anything if FPixelsPerInch already is AToPPI
Exit;
// override AFromPPI with FPixelsPerInch - it is needed e.g. when a frame is placed on form
// - the frame can have a different PPI than the parent form.
// See issue #36370
inherited AutoAdjustLayout(AMode, FPixelsPerInch, AToPPI, AOldFormWidth, ANewFormWidth);
if AMode = lapAutoAdjustForDPI then
FPixelsPerInch := AToPPI;
end;
function TCustomDesignControl.DesignTimePPIIsStored: Boolean;
begin
if Assigned(Owner) then
Result := False // inplace frames do not store DesignTimePPI - always the parent's DesignTimePPI is used
else
Result := FDesignTimePPI<>96;
end;
procedure TCustomDesignControl.DoAutoAdjustLayout(
const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double
);
@ -56,42 +70,14 @@ begin
end;
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);
begin
if FDesignTimePPI=ADesignTimePPI then
Exit;
if (csLoading in ComponentState) // allow setting only when loading
or not (csDesigning in ComponentState) // or in runtime (the programmer has to know why he is doing that)
or ((csDesigning in ComponentState) and (ADesignTimePPI=Screen.PixelsPerInch)) // or in designtime when setting the correct value
then
FDesignTimePPI := ADesignTimePPI
else
raise EInvalidOperation.Create(sCannotSetDesignTimePPI);
FDesignTimePPI := ADesignTimePPI;
if csLoading in ComponentState then
FPixelsPerInch := FDesignTimePPI; // set FPixelsPerInch in LFM loading
end;
procedure TCustomDesignControl.SetScaled(const AScaled: Boolean);

5
lcl/include/customform.inc
View File

@ -79,7 +79,8 @@ begin
inherited AfterConstruction;
MonPPI := Monitor.PixelsPerInch;
if Application.Scaled and Scaled and (MonPPI > 0) and (MonPPI <> PixelsPerInch) then
if Application.Scaled and Scaled and (MonPPI > 0) and (MonPPI <> PixelsPerInch)
and not (csDesigning in ComponentState) then
AutoAdjustLayout(lapAutoAdjustForDPI, PixelsPerInch, MonPPI,
Width, MulDiv(Width, MonPPI, PixelsPerInch));
end;
@ -2687,6 +2688,8 @@ begin
{$ENDIF}
DisableAlign;
try
if Application.Scaled and Scaled then
FixDesignFontsPPIWithChildren(FDesignTimePPI);
inherited Loaded;
finally
EnableAlign;

17
lcl/include/wincontrol.inc
View File

@ -4616,6 +4616,23 @@ begin
end;
end;
procedure TWinControl.FixDesignFontsPPIWithChildren(const ADesignTimePPI: Integer);
procedure FixChildren(const AParent: TWinControl);
var
I: Integer;
begin
for I := 0 to AParent.ControlCount-1 do
begin
AParent.Controls[I].FixDesignFontsPPI(ADesignTimePPI);
if AParent.Controls[I] is TWinControl then
FixChildren(TWinControl(AParent.Controls[I]));
end;
end;
begin
FixDesignFontsPPI(ADesignTimePPI);
FixChildren(Self);
end;
procedure TWinControl.SelectFirst;
var
Form : TCustomForm;

4
lcl/languages/lclstrconsts.ca.po
View File

@ -1249,10 +1249,6 @@ msgstr ""
msgid "Cannot focus a disabled or invisible window"
msgstr "No puc accedir a una finestra invisible o tancada"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr ""
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Menús duplicats"

4
lcl/languages/lclstrconsts.cs.po
View File

@ -1221,10 +1221,6 @@ msgstr "Žlutá"
msgid "Cannot focus a disabled or invisible window"
msgstr "Nelze zaktivnit zakázané nebo neviditelné okno"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Nelze nastavit návrhové PPI."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Zdvojit nabídku"

4
lcl/languages/lclstrconsts.de.po
View File

@ -1221,10 +1221,6 @@ msgstr "Gelb"
msgid "Cannot focus a disabled or invisible window"
msgstr "Kann abgeschaltetes oder unsichtbares Fenster nicht fokussieren"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Kann die Entwurfszeit-PPI nicht festlegen."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Doppelte Menüs"

4
lcl/languages/lclstrconsts.es.po
View File

@ -1220,10 +1220,6 @@ msgstr "Amarillo"
msgid "Cannot focus a disabled or invisible window"
msgstr "No se puede establecer el foco en una ventana desactivada o invisible"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "No se puede establecer el PPI en tiempo de diseño."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Duplicar menús"

4
lcl/languages/lclstrconsts.fi.po
View File

@ -1217,10 +1217,6 @@ msgstr "Keltainen"
msgid "Cannot focus a disabled or invisible window"
msgstr "Ei voi fokusoida estettyä tai näkymätöntä ikkunaa"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Suunnitteluaikaisen PPI:n muuttaminen ei onnistu."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Samanlaiset valikot"

4
lcl/languages/lclstrconsts.fr.po
View File

@ -1219,10 +1219,6 @@ msgstr "Jaune"
msgid "Cannot focus a disabled or invisible window"
msgstr "Impossible de focaliser une fenêtre invisible ou désactivée"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Impossible de définir le PPI de conception."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Doublon de menus"

4
lcl/languages/lclstrconsts.he.po
View File

@ -1243,10 +1243,6 @@ msgstr "צהוב"
msgid "Cannot focus a disabled or invisible window"
msgstr "לא יכול להתמקד בחלון מנוטרל או בלתי נראה"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr ""
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "תפריטים כפולים"

4
lcl/languages/lclstrconsts.hu.po
View File

@ -1219,10 +1219,6 @@ msgstr "Sárga"
msgid "Cannot focus a disabled or invisible window"
msgstr "Nem lehet letiltott vagy láthatatlan ablakot előtérbe hozni"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "A PPI értéke nem változtatható meg tervezés közben."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Ismétlődő menük"

4
lcl/languages/lclstrconsts.id.po
View File

@ -1250,10 +1250,6 @@ msgstr ""
msgid "Cannot focus a disabled or invisible window"
msgstr "Tidak bisa memberikan fokus ke jendela yang dimatikan atau tidak nampak"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr ""
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Duplikasi menu"

4
lcl/languages/lclstrconsts.it.po
View File

@ -1223,10 +1223,6 @@ msgstr "Giallo"
msgid "Cannot focus a disabled or invisible window"
msgstr "Impossibile dare il focus a finestre disabilitate o invisibili"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr ""
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Menu dupicati"

4
lcl/languages/lclstrconsts.ja.po
View File

@ -1220,10 +1220,6 @@ msgstr "黄色"
msgid "Cannot focus a disabled or invisible window"
msgstr "無効または不可視ウィンドウにフォーカスはできません"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "設計時PPIをセットできません"
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "メニューが重複しています"

4
lcl/languages/lclstrconsts.lt.po
View File

@ -1222,10 +1222,6 @@ msgstr "Geltona"
msgid "Cannot focus a disabled or invisible window"
msgstr "Negalima sufokusuoti neveiksnaus ar nematomo lango"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Nepavyko nustatyti konstravimo rėžimo „PPI“."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Meniu dubliuojasi"

4
lcl/languages/lclstrconsts.nl.po
View File

@ -1227,10 +1227,6 @@ msgstr "Geel"
msgid "Cannot focus a disabled or invisible window"
msgstr "Kan geen focus geven aan een onzichtbaar of disabled venster"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Kan design time PPI niet zetten"
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Dubbele menus"

4
lcl/languages/lclstrconsts.no.po
View File

@ -1252,10 +1252,6 @@ msgstr ""
msgid "Cannot focus a disabled or invisible window"
msgstr "Kan ikke fokusere et deaktivert eller usynlig vindu"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr ""
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Duplikate menyer"

4
lcl/languages/lclstrconsts.pl.po
View File

@ -1220,10 +1220,6 @@ msgstr "Żółty"
msgid "Cannot focus a disabled or invisible window"
msgstr "Nie można ustawić aktywności na niedostępnym lub niewidocznym oknie"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Nie można ustawiać projektowania podczas PPI."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Zdublowane menu"

4
lcl/languages/lclstrconsts.pot
View File

@ -1212,10 +1212,6 @@ msgstr ""
msgid "Cannot focus a disabled or invisible window"
msgstr ""
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr ""
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr ""

4
lcl/languages/lclstrconsts.pt.po
View File

@ -1231,10 +1231,6 @@ msgstr "Amarelo"
msgid "Cannot focus a disabled or invisible window"
msgstr "Impossível focar uma janela inativa ou invisível"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr ""
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Duplicar menus"

4
lcl/languages/lclstrconsts.pt_BR.po
View File

@ -1219,10 +1219,6 @@ msgstr "Amarelo"
msgid "Cannot focus a disabled or invisible window"
msgstr "Impossível focar uma janela inativa ou invisível"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Impossível definir PPI de tempo de projeto."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Duplicar menus"

4
lcl/languages/lclstrconsts.ru.po
View File

@ -1219,10 +1219,6 @@ msgstr "Жёлтый"
msgid "Cannot focus a disabled or invisible window"
msgstr "Невозможно перевести фокус в отключённое или невидимое окно"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Невозможно установить PPI времени разработки."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Дублирующиеся меню"

4
lcl/languages/lclstrconsts.sk.po
View File

@ -1222,10 +1222,6 @@ msgstr "Žltá"
msgid "Cannot focus a disabled or invisible window"
msgstr "Nemôžem zamerať vypnuté alebo neviditeľné okno"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr ""
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Duplikovaná ponuka"

4
lcl/languages/lclstrconsts.tr.po
View File

@ -1219,10 +1219,6 @@ msgstr "Sarı"
msgid "Cannot focus a disabled or invisible window"
msgstr "Etkisizleştirilmiş ya da görünmez pencerelere odaklanılamaz"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Tasarım zamanı PPI ayarlanamıyor."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Birbirinin aynı menüler"

4
lcl/languages/lclstrconsts.uk.po
View File

@ -1222,10 +1222,6 @@ msgstr "Жовтий"
msgid "Cannot focus a disabled or invisible window"
msgstr "Не можна дати фокус вимкненому або невидимому вікну"
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr "Неможливо встановити ПНД часу розробки."
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr "Дублювати меню"

4
lcl/languages/lclstrconsts.zh_CN.po
View File

@ -1221,10 +1221,6 @@ msgstr "黄色"
msgid "Cannot focus a disabled or invisible window"
msgstr ""
#: lclstrconsts.scannotsetdesigntimeppi
msgid "Cannot set design time PPI."
msgstr ""
#: lclstrconsts.sduplicatemenus
msgid "Duplicate menus"
msgstr ""

1
lcl/lclstrconsts.pas
View File

@ -223,7 +223,6 @@ resourceString
sInvalidImageSize = 'Invalid image size';
sDuplicateMenus = 'Duplicate menus';
sCannotFocus = 'Cannot focus a disabled or invisible window';
sCannotSetDesignTimePPI = 'Cannot set design time PPI.';
sParentRequired = 'Control "%s" has no parent window.';
sInvalidCharSet = 'The char set in mask "%s" is not valid!';
SMaskEditNoMatch = 'The current text does not match the specified mask.';