GridPrinter: Implement scaling factor for printer (in addition to already existing preview scaling factor).

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

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

components/gridprinter/examples/multi-language/multilanguage_demo.lpi

@@ -45,6 +45,7 @@
       <Unit0>
         <Filename Value="multilanguage_demo.lpr"/>
         <IsPartOfProject Value="True"/>
+        <UnitName Value="MultiLanguage_Demo"/>
       </Unit0>
       <Unit1>
         <Filename Value="main.pas"/>

components/gridprinter/examples/multi-language/multilanguage_demo.lpr

@@ -10,8 +10,7 @@ uses
   athreads,
   {$ENDIF}
   Interfaces, // this includes the LCL widgetset
-  Forms, Main, printer4lazarus
+  Forms, Main;
-  { you can add units after this };
 
 {$R *.res}
 

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;
+  FFactorX := XDpi / ScreenInfo.PixelsPerInchX * FPrintScaleFactor;
-  FFactorY := YDpi / ScreenInfo.PixelsPerInchY;
+  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;
+    fontSize := round(abs(fd.Height) * 72 / ScreenInfo.PixelsPerInchY * AScaleFactor);
-  end;
+  end else
+    fontSize := round(ACanvas.Font.Size * AScaleFactor);
+  if fontSize < 3 then fontSize := 3;
+  ACanvas.Font.Size := fontSize;
 end;
 
 procedure TGridPrinter.SetBorderLineColor(AValue: TColor);