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

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

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8621 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-11-14 18:49:55 +00:00
parent 1e79d006f9
commit 822873cffb
4 changed files with 30 additions and 14 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
components/gridprinter/examples/multi-language/main.pas
View File

@ -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

1
components/gridprinter/examples/multi-language/multilanguage_demo.lpi
View File

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

3
components/gridprinter/examples/multi-language/multilanguage_demo.lpr
View File

@ -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}

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

@ -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);