LCL: HighDPI: use relative font scaling, not the absolute PPI (fix for r54210 #eb28e06e83). Issue #31276

git-svn-id: trunk@54211 -

lcl/comctrls.pp

@@ -159,7 +159,7 @@ type
     procedure LMDrawItem(var Message: TLMDrawItems); message LM_DRAWITEM;
 
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-      const AXProportion, AYProportion: Double; const AToDPI: Integer); override;
+      const AXProportion, AYProportion: Double); override;
   public
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;
@@ -1490,7 +1490,7 @@ type
     procedure DoItemChecked(AItem: TListItem);
     procedure DoSelectItem(AItem: TListItem; ASelected: Boolean); virtual;
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-      const AXProportion, AYProportion: Double; const AToDPI: Integer); override;
+      const AXProportion, AYProportion: Double); override;
     procedure DoSetBounds(ALeft, ATop, AWidth, AHeight: integer); override;
 
     procedure DoEndEdit(AItem: TListItem; const AValue: String); virtual;
@@ -2252,7 +2252,7 @@ type
                          Simulate: boolean): Boolean;
     procedure CNDropDownClosed(var Message: TLMessage); message CN_DROPDOWNCLOSED;
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-      const AXProportion, AYProportion: Double; const AToDPI: Integer); override;
+      const AXProportion, AYProportion: Double); override;
   public
     constructor Create(TheOwner: TComponent); override;
     destructor Destroy; override;

lcl/controls.pp

@@ -1419,7 +1419,7 @@ type
     class function GetControlClassDefaultSize: TSize; virtual;
     function ColorIsStored: boolean; virtual;
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-      const AXProportion, AYProportion: Double; const AToDPI: Integer); virtual;
+      const AXProportion, AYProportion: Double); virtual;
     class procedure DoFixDesignFontPPI(const AFont: TFont; const ADesignTimePPI: Integer);
   protected
     // actions

lcl/forms.pp

@@ -549,7 +549,7 @@ type
     procedure CreateWnd; override;
     procedure Deactivate; virtual;
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-      const AXProportion, AYProportion: Double; const AToDPI: Integer); override;
+      const AXProportion, AYProportion: Double); override;
     procedure DoClose(var CloseAction: TCloseAction); virtual;
     procedure DoCreate; virtual;
     procedure DoDestroy; virtual;

lcl/grids.pas

@@ -960,7 +960,7 @@ type
     function  DoMouseWheelDown(Shift: TShiftState; MousePos: TPoint): Boolean; override;
     function  DoMouseWheelUp(Shift: TShiftState; MousePos: TPoint): Boolean; override;
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-      const AXProportion, AYProportion: Double; const AToDPI: Integer); override;
+      const AXProportion, AYProportion: Double); override;
     procedure DoOnChangeBounds; override;
     procedure DoOPDeleteColRow(IsColumn: Boolean; index: Integer);
     procedure DoOPExchangeColRow(IsColumn: Boolean; index, WithIndex: Integer);
@@ -6749,7 +6749,7 @@ begin
 end;
 
 procedure TCustomGrid.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-  const AXProportion, AYProportion: Double; const AToDPI: Integer);
+  const AXProportion, AYProportion: Double);
 var
   i: Integer;
   C: TGridColumn;

lcl/groupededit.pp

@@ -179,7 +179,7 @@ type
     procedure SetTextHint(AValue: TTranslateString);
   protected
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-      const AXProportion, AYProportion: Double; const AToDPI: Integer); override;
+      const AXProportion, AYProportion: Double); override;
     procedure CalculatePreferredSize(var PreferredWidth, PreferredHeight: integer;
                 WithThemeSpace: Boolean); override;
     function CreateBuddy: TControl; virtual;
@@ -1246,8 +1246,8 @@ begin
 end;
 
 procedure TCustomAbstractGroupedEdit.DoAutoAdjustLayout(
-  const AMode: TLayoutAdjustmentPolicy; const AXProportion,
+  const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double
-  AYProportion: Double; const AToDPI: Integer);
+  );
 begin
   inherited;
 

lcl/include/control.inc

@@ -2976,13 +2976,13 @@ begin
 end;
 
 procedure TControl.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-  const AXProportion, AYProportion: Double; const AToDPI: Integer);
+  const AXProportion, AYProportion: Double);
 var
   AAWidth, AAHeight: Boolean;
   NewLeft, NewTop, NewWidth, NewHeight, NewRight, NewBottom, OldWidth, OldHeight: Integer;
 begin
   if not ParentFont or (Parent=nil) then
-    Font.PixelsPerInch := AToDPI;
+    Font.PixelsPerInch := Round(Font.PixelsPerInch*AYProportion);
 
   // Apply the changes
   if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then
@@ -4008,7 +4008,7 @@ begin
   if AFromDPI > 0 then lYProportion := AToDPI / AFromDPI
   else lYProportion := 1.0;
 
-  DoAutoAdjustLayout(lMode, lXProportion, lYProportion, AToDPI);
+  DoAutoAdjustLayout(lMode, lXProportion, lYProportion);
 end;
 
 // Auto-adjust the layout of controls.

lcl/include/customform.inc

@@ -1568,7 +1568,7 @@ begin
 end;
 
 procedure TCustomForm.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-  const AXProportion, AYProportion: Double; const AToDPI: Integer);
+  const AXProportion, AYProportion: Double);
 var
   NewWidth, NewHeight, OldWidth, OldHeight: Integer;
 begin
@@ -1579,7 +1579,7 @@ begin
   end;
 
   if not ParentFont or (Parent=nil) then
-    Font.PixelsPerInch := AToDPI;
+    Font.PixelsPerInch := Round(Font.PixelsPerInch*AYProportion);
 
   // Apply the changes
   if AMode in [lapAutoAdjustWithoutHorizontalScrolling, lapAutoAdjustForDPI] then

lcl/include/customlistbox.inc

@@ -470,8 +470,8 @@ begin
 end;
 
 procedure TCustomListBox.DoAutoAdjustLayout(
-  const AMode: TLayoutAdjustmentPolicy; const AXProportion,
+  const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double
-  AYProportion: Double; const AToDPI: Integer);
+  );
 begin
   inherited;
 

lcl/include/customlistview.inc

@@ -612,8 +612,8 @@ begin
 end;
 
 procedure TCustomListView.DoAutoAdjustLayout(
-  const AMode: TLayoutAdjustmentPolicy; const AXProportion,
+  const AMode: TLayoutAdjustmentPolicy; const AXProportion, AYProportion: Double
-  AYProportion: Double; const AToDPI: Integer);
+  );
 var
   i: Integer;
   C: TListColumn;

lcl/include/statusbar.inc

@@ -148,7 +148,7 @@ begin
 end;
 
 procedure TStatusBar.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-  const AXProportion, AYProportion: Double; const AToDPI: Integer);
+  const AXProportion, AYProportion: Double);
 var
   I: Integer;
 begin

lcl/include/toolbar.inc

@@ -342,7 +342,7 @@ begin
 end;
 
 procedure TToolBar.DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-  const AXProportion, AYProportion: Double; const AToDPI: Integer);
+  const AXProportion, AYProportion: Double);
 begin
   inherited;
 

lcl/stdctrls.pp

@@ -551,7 +551,7 @@ type
     procedure SetStyle(Val: TListBoxStyle); virtual;
     procedure DrawItem(Index: Integer; ARect: TRect; State: TOwnerDrawState); virtual;
     procedure DoAutoAdjustLayout(const AMode: TLayoutAdjustmentPolicy;
-      const AXProportion, AYProportion: Double; const AToDPI: Integer); override;
+      const AXProportion, AYProportion: Double); override;
     procedure DoSelectionChange(User: Boolean); virtual;
     procedure SendItemIndex;
   public