GridPrinter: (Hopefully) fix non-functional LCLScaling for header/footer font size.

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8614 8e941d3f-bd1b-0410-a28a-d453659cc2b4

components/gridprinter/source/gridprn.pas

@@ -53,6 +53,7 @@ type
   TGridPrnHeaderFooter = class(TPersistent)
   private
     FFont: TFont;
+    FFontSize: Integer;
     FLineColor: TColor;
     FLineWidth: Double;
     FShowLine: Boolean;
@@ -75,6 +76,9 @@ type
     procedure SetVisible(AValue: Boolean);
   protected
     procedure Changed(Sender: TObject);
+    procedure DefineProperties(Filer: TFiler); override;
+    procedure ReadFontSize(Reader: TReader);
+    procedure WriteFontSize(Writer: TWriter);
   public
     constructor Create(AOwner: TGridPrinter);
     destructor Destroy; override;
@@ -82,6 +86,7 @@ type
     function IsTextEmpty: Boolean;
     function RealLineColor: TColor;
     function RealLineWidth: Integer;
+    property FontSize: Integer read FFontSize write FFontSize;
     property ProcessedText[AIndex: TGridPrnHeaderFooterSection]: String read GetProcessedText;
     property SectionText[AIndex: TGridPrnHeaderFooterSection]: String read GetSectionText;
   published
@@ -188,6 +193,7 @@ type
     function GetFontColor(AColor: TColor): TColor;
     function GetPenColor(AColor: TCOlor): TColor;
     procedure LayoutPagebreaks;
+    procedure Loaded; override;
     procedure Measure(APageWidth, APageHeight, XDpi, YDpi: Integer);
     procedure NewPage;
     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
@@ -297,7 +303,7 @@ function DefaultFontSize(AFont: TFont): Integer;
 var
   fontData: TFontData;
 begin
-  fontData := GetFontData(AFont.Handle);
+  fontData := GetFontData(AFont.Reference.Handle);
   Result := abs(fontData.Height) * 72 div ScreenInfo.PixelsPerInchY;
 end;
 
@@ -391,6 +397,18 @@ begin
     FOwner.UpdatePreview;
 end;
 
+{ Since TGridPrinter does not descend from TControl it does not react on
+  LCLScaling. The problem is that the header/footer font size does not
+  scale correctly because the PixelsPerInch are always applied without scaling
+  the height. A workaround is to store the FontSize separately so that it is
+  not affected by the changed PPI, and to apply it to the Font.Size in the
+  GridPrinter's Loaded procedure. }
+procedure TGridPrnHeaderFooter.DefineProperties(Filer: TFiler);
+begin
+  inherited DefineProperties(Filer);
+  Filer.DefineProperty('FontSize', @ReadFontSize, @WriteFontSize, true);
+end;
+
 function TGridPrnHeaderFooter.GetProcessedText(AIndex: TGridPrnHeaderFooterSection): String;
 const
   UNKNOWN = '<unknown>';
@@ -464,6 +482,11 @@ begin
   Result := not IsTextEmpty;
 end;
 
+procedure TGridPrnHeaderFooter.ReadFontSize(Reader: TReader);
+begin
+  FFontSize := Reader.ReadInteger;
+end;
+
 function TGridPrnHeaderFooter.RealLineColor: TColor;
 begin
   if ((FOwner <> nil) and FOwner.Monochrome) or (FLineColor = clDefault) then
@@ -545,6 +568,12 @@ begin
   end;
 end;
 
+procedure TGridPrnHeaderFooter.WriteFontSize(Writer: TWriter);
+begin
+  FFontSize := FFont.Size;
+  Writer.WriteInteger(FFontSize);
+end;
+
 
 { TGridPrinter }
 
@@ -869,6 +898,15 @@ begin
   FPageCount := Length(FPageBreakCols) * Length(FPageBreakRows);
 end;
 
+procedure TGridPrinter.Loaded;
+begin
+  inherited;
+  // The next lines override the change of Font.Size because LCLScaling does
+  // not apply here.
+  FHeader.Font.Size := FHeader.FontSize;
+  FFooter.Font.Size := FFooter.FontSize;
+end;
+
 { Converts length properties to the specified pixel density. }
 procedure TGridPrinter.Measure(APageWidth, APageHeight, XDpi, YDpi: Integer);
 begin
@@ -876,7 +914,7 @@ begin
   FFactorX := XDpi / ScreenInfo.PixelsPerInchX;
   FFactorY := YDpi / ScreenInfo.PixelsPerInchY;
 
-  // Margins in the new pixeld density units.
+  // Margins in the new pixel density units.
   FLeftMargin := mm2px(FMargins.Left, XDpi);
   FTopMargin := mm2px(FMargins.Top, YDpi);
   FRightMargin := mm2px(FMargins.Right, XDpi);
@@ -1657,7 +1695,7 @@ begin
   ACanvas.Font.PixelsPerInch := FPixelsPerInchY;
   if AFont.Size = 0 then
   begin
-    fd := GetFontData(AFont.Handle);
+    fd := GetFontData(AFont.Reference.Handle);
     ACanvas.Font.Size := abs(fd.Height) * 72 div ScreenInfo.PixelsPerInchY;
   end;
 end;
@@ -1710,6 +1748,8 @@ end;
 procedure TGridPrinter.SetGrid(AValue: TCustomGrid);
 begin
   FGrid := AValue;
+  if FGrid <> nil then
+  begin
     FColCount := TGridAccess(FGrid).ColCount;
     FRowCount := TGridAccess(FGrid).RowCount;
     FFixedCols := TGridAccess(FGrid).FixedCols;
@@ -1718,6 +1758,13 @@ begin
       FOnGetColCount(Self, FGrid, FColCount);
     if Assigned(FOnGetRowCount) then
       FOnGetRowCount(self, FGrid, FRowCount);
+  end else
+  begin
+    FColCount := 0;
+    FRowCount := 0;
+    FFixedCols := 0;
+    FFixedRows := 0;
+  end;
   FPageNumber := 0;
   FPageCount := 0;
 end;