pascal/lazarus-ccr
1
0
Fork 0
Code Issues Releases Activity

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8614 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-11-12 22:37:56 +00:00
parent 5323141bda
commit 998ea63b35
1 changed files with 58 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files

69
components/gridprinter/source/gridprn.pas
View File

@ -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,14 +1748,23 @@ end;
procedure TGridPrinter.SetGrid(AValue: TCustomGrid);
begin
FGrid := AValue;
FColCount := TGridAccess(FGrid).ColCount;
FRowCount := TGridAccess(FGrid).RowCount;
FFixedCols := TGridAccess(FGrid).FixedCols;
FFixedRows := TGridAccess(FGrid).FixedRows;
if Assigned(FOnGetColCount) then
FOnGetColCount(Self, FGrid, FColCount);
if Assigned(FOnGetRowCount) then
FOnGetRowCount(self, FGrid, FRowCount);
if FGrid <> nil then
begin
FColCount := TGridAccess(FGrid).ColCount;
FRowCount := TGridAccess(FGrid).RowCount;
FFixedCols := TGridAccess(FGrid).FixedCols;
FFixedRows := TGridAccess(FGrid).FixedRows;
if Assigned(FOnGetColCount) then
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;