diff --git a/components/gridprinter/examples/multi-language/main.pas b/components/gridprinter/examples/multi-language/main.pas index 3d4243755..b319849d1 100644 --- a/components/gridprinter/examples/multi-language/main.pas +++ b/components/gridprinter/examples/multi-language/main.pas @@ -140,6 +140,8 @@ begin finally StringGrid1.EndUpdate; end; + +// GridPrinter1.PrintScaleFactor := 0.5; end; { Populates the languages combobox: reads the names of the app's .po files diff --git a/components/gridprinter/examples/multi-language/multilanguage_demo.lpi b/components/gridprinter/examples/multi-language/multilanguage_demo.lpi index c2f450cc3..3894ff124 100644 --- a/components/gridprinter/examples/multi-language/multilanguage_demo.lpi +++ b/components/gridprinter/examples/multi-language/multilanguage_demo.lpi @@ -45,6 +45,7 @@ + diff --git a/components/gridprinter/examples/multi-language/multilanguage_demo.lpr b/components/gridprinter/examples/multi-language/multilanguage_demo.lpr index c58f71e41..91f1d57c4 100644 --- a/components/gridprinter/examples/multi-language/multilanguage_demo.lpr +++ b/components/gridprinter/examples/multi-language/multilanguage_demo.lpr @@ -10,8 +10,7 @@ uses athreads, {$ENDIF} Interfaces, // this includes the LCL widgetset - Forms, Main, printer4lazarus - { you can add units after this }; + Forms, Main; {$R *.res} diff --git a/components/gridprinter/source/gridprn.pas b/components/gridprinter/source/gridprn.pas index 390f4a7f9..e098ae7b1 100644 --- a/components/gridprinter/source/gridprn.pas +++ b/components/gridprinter/source/gridprn.pas @@ -145,6 +145,7 @@ type function IsFixedLineWidthStored: Boolean; function IsGridLineWidthStored: Boolean; function IsOrientationStored: Boolean; + function IsPrintScaleFactorStored: Boolean; procedure SetBorderLineColor(AValue: TColor); procedure SetBorderLineWidth(AValue: Double); procedure SetFileName(AValue: String); @@ -179,6 +180,7 @@ type FPreviewBitmap: TBitmap; // Bitmap to which the preview image is printed FPreviewPage: Integer; // Page request for the preview bitmap FPreviewPercent: Integer; // Scaling factor for preview bitmap + FPrintScaleFactor: Double; // Scaling factor for printing FColCount: Integer; FRowCount: Integer; FFixedCols: Integer; @@ -212,7 +214,7 @@ type procedure PrintRowHeader(ACanvas: TCanvas; ARow: Integer; X, Y: Double); procedure ScaleColWidths(AFactor: Double); procedure ScaleRowHeights(AFactor: Double); - procedure SelectFont(ACanvas: TCanvas; AFont: TFont); + procedure SelectFont(ACanvas: TCanvas; AFont: TFont; AScaleFactor: Double = 1.0); property OutputDevice: TGridPrnOutputDevice read FOutputDevice; public constructor Create(AOwner: TComponent); override; @@ -250,6 +252,7 @@ type property Options: TGridPrnOptions read FOptions write SetOptions default []; property Orientation: TPrinterOrientation read GetOrientation write SetOrientation stored IsOrientationStored; property PrintOrder: TGridPrnOrder read FPrintOrder write FPrintOrder default poRowsFirst; + property PrintScaleFactor: Double read FPrintScaleFactor write FPrintScaleFactor stored IsPrintScaleFactorStored; property ShowPrintDialog: TGridPrnDialog read FShowPrintDialog write FShowPrintDialog default gpdNone; property ToPage: Integer read FToPage write FToPage default 0; property OnAfterPrint: TNotifyEvent read FOnAfterPrint write FOnAfterPrint; @@ -500,7 +503,7 @@ begin if FLineWidth = 0 then Result := FOwner.ScaleY(1) else - Result := mm2px(FLineWidth, FOwner.PixelsPerInchY); + Result := mm2px(FLineWidth/FOwner.PrintScaleFactor, FOwner.PixelsPerInchY); end; procedure TGridPrnHeaderFooter.SetFont(AValue: TFont); @@ -586,6 +589,7 @@ begin FFooter := TGridPrnHeaderFooter.Create(Self); FPrintOrder := poRowsFirst; + FPrintScaleFactor := 1.0; FBorderLineColor := clDefault; FFixedLineColor := clDefault; FGridLineColor := clDefault; @@ -852,6 +856,11 @@ begin Result := GetOrientation <> poPortrait; end; +function TGridPrinter.IsPrintScaleFactorStored: Boolean; +begin + Result := FPrintScaleFactor <> 1.0; +end; + { Find the column and row indices before which page breaks are occuring. Store them in the arrays FPageBreakCols and FPageBreakRows. Note that the indices do not contain the fixed columns/rows. } @@ -911,8 +920,8 @@ end; procedure TGridPrinter.Measure(APageWidth, APageHeight, XDpi, YDpi: Integer); begin // Multiplication factor needed by ScaleX and ScaleY - FFactorX := XDpi / ScreenInfo.PixelsPerInchX; - FFactorY := YDpi / ScreenInfo.PixelsPerInchY; + FFactorX := XDpi / ScreenInfo.PixelsPerInchX * FPrintScaleFactor; + FFactorY := YDpi / ScreenInfo.PixelsPerInchY * FPrintScaleFactor; // Margins in the new pixel density units. FLeftMargin := mm2px(FMargins.Left, XDpi); @@ -996,7 +1005,7 @@ begin ACanvas.Brush.Color := GetBrushColor(lGrid.AlternateColor); end; // Font - SelectFont(ACanvas, lGrid.Font); + SelectFont(ACanvas, lGrid.Font, FPrintScaleFactor); ACanvas.Font.Color := GetFontColor(lGrid.Font.Color); FixFontSize(ACanvas.Font); // Text style @@ -1113,7 +1122,7 @@ begin firstPrintPage := IfThen((FFromPage < 1) or (FFromPage > FPageCount), 1, FFromPage); lastPrintPage := IfThen((FToPage < 1) or (FToPage > FPageCount), FPageCount, FToPage); - SelectFont(ACanvas, FGrid.Font); + SelectFont(ACanvas, FGrid.Font, FPrintScaleFactor); FPageNumber := 1; for horPage := 0 to High(FPageBreakCols) do @@ -1159,7 +1168,7 @@ begin firstPrintPage := IfThen((FFromPage < 1) or (FFromPage > FPageCount), 1, FFromPage); lastPrintPage := IfThen((FToPage < 1) or (FToPage > FPageCount), FPageCount, FToPage); - SelectFont(ACanvas, FGrid.Font); + SelectFont(ACanvas, FGrid.Font, FPrintScaleFactor); FPageNumber := 1; for vertPage := 0 to High(FPageBreakRows) do @@ -1324,7 +1333,7 @@ begin if not FFooter.IsShown then exit; - SelectFont(ACanvas, FFooter.Font); + SelectFont(ACanvas, FFooter.Font, 1.0); ACanvas.Font.Color := GetFontColor(FFooter.Font.Color); printableWidth := FPageRect.Width; if (FFooter.SectionText[hfsLeft] <> '') and (FFooter.SectionText[hfsCenter] = '') and (FFooter.SectionText[hfsRight] = '') then @@ -1515,7 +1524,7 @@ begin if not FHeader.IsShown then exit; - SelectFont(ACanvas, FHeader.Font); + SelectFont(ACanvas, FHeader.Font, 1.0); ACanvas.Font.Color := GetFontColor(FHeader.Font.Color); printableWidth := FPageRect.Width; if (FHeader.SectionText[hfsLeft] <> '') and (FHeader.SectionText[hfsCenter] = '') and (FHeader.SectionText[hfsRight] = '') then @@ -1687,17 +1696,22 @@ begin Result := Round(FFactorY * AValue); end; -procedure TGridPrinter.SelectFont(ACanvas: TCanvas; AFont: TFont); +procedure TGridPrinter.SelectFont(ACanvas: TCanvas; AFont: TFont; + AScaleFactor: Double = 1.0); var fd: TFontData; + fontSize: Integer; begin ACanvas.Font.Assign(AFont); ACanvas.Font.PixelsPerInch := FPixelsPerInchY; if AFont.Size = 0 then begin fd := GetFontData(AFont.Reference.Handle); - ACanvas.Font.Size := abs(fd.Height) * 72 div ScreenInfo.PixelsPerInchY; - end; + fontSize := round(abs(fd.Height) * 72 / ScreenInfo.PixelsPerInchY * AScaleFactor); + end else + fontSize := round(ACanvas.Font.Size * AScaleFactor); + if fontSize < 3 then fontSize := 3; + ACanvas.Font.Size := fontSize; end; procedure TGridPrinter.SetBorderLineColor(AValue: TColor);