fddd97d93e
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@9183 8e941d3f-bd1b-0410-a28a-d453659cc2b4
2053 lines
62 KiB
ObjectPascal
2053 lines
62 KiB
ObjectPascal
unit GridPrn;
|
|
|
|
{$mode ObjFPC}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LCLType, LCLIntf, LCLVersion, Types, Graphics, StdCtrls, Grids,
|
|
Printers, PrintersDlgs;
|
|
|
|
type
|
|
TGridPrinter = class; // forward declaration
|
|
|
|
TGridPrnDialog = (gpdNone, gpdPageSetup, gpdPrintDialog, gpdPrinterSetup);
|
|
|
|
TGridPrnPrintCellEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
|
|
ACanvas: TCanvas; ACol, ARow: Integer; ARect: TRect) of object;
|
|
|
|
TGridPrnGetCellTextEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
|
|
ACol, ARow: Integer; var AText: String) of object;
|
|
|
|
TGridPrnGetColCountEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
|
|
var AColCount: Integer) of object;
|
|
|
|
TGridPrnGetRowCountEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
|
|
var ARowCount: Integer) of object;
|
|
|
|
TGridPrnNewLineEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
|
|
ARow: Integer) of object;
|
|
|
|
TGridPrnLinePrintedEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
|
|
ARow, ALastCol: Integer) of object;
|
|
|
|
TGridPrnNewPageEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
|
|
APageNo: Integer; AStartCol, AStartRow, AEndCol, AEndRow: Integer) of object;
|
|
|
|
TGridPrnManualPageBreakEvent = procedure (Sender: TObject; AGrid: TCustomGrid;
|
|
IsCol: Boolean; AColRowIndex: Integer; var NewPage: Boolean) of object;
|
|
|
|
TGridPrnHeaderFooterSection = (hfsLeft, hfsCenter, hfsRight);
|
|
|
|
TGridPrnOption = (gpoCenterHor, gpoCenterVert,
|
|
gpoHorGridLines, gpoVertGridLines,
|
|
gpoFixedHorGridLines, gpoFixedVertGridLines,
|
|
gpoHeaderBorderLines, gpoOuterBorderLines
|
|
);
|
|
TGridPrnOptions = set of TGridPrnOption;
|
|
|
|
const
|
|
DEFAULT_GRIDPRNOPTIONS = [gpoHorGridLines, gpoVertGridLines,
|
|
gpoFixedHorGridLines, gpoFixedVertGridLines, gpoHeaderBorderLines,
|
|
gpoOuterBorderLines];
|
|
|
|
type
|
|
TGridPrnOrder = (poRowsFirst, poColsFirst);
|
|
|
|
TGridPrnOutputDevice = (odPrinter, odPreview);
|
|
|
|
TGridPrnScalingMode = (smManual, smFitToWidth, smFitToHeight, smFitAll);
|
|
|
|
TGridPrnMargins = class(TPersistent)
|
|
private
|
|
FMargins: array[0..5] of Double;
|
|
FOwner: TGridPrinter;
|
|
function GetMargin(AIndex: Integer): Double;
|
|
function IsStoredMargin(AIndex: Integer): Boolean;
|
|
procedure SetMargin(AIndex: Integer; AValue: Double);
|
|
protected
|
|
procedure Changed;
|
|
public
|
|
constructor Create(AOwner: TGridPrinter);
|
|
published
|
|
property Left: Double index 0 read GetMargin write SetMargin stored IsStoredMargin;
|
|
property Top: Double index 1 read GetMargin write SetMargin stored IsStoredMargin;
|
|
property Right: Double index 2 read GetMargin write SetMargin stored IsStoredMargin;
|
|
property Bottom: Double index 3 read GetMargin write SetMargin stored IsStoredMargin;
|
|
property Header: Double index 4 read GetMargin write SetMargin stored IsStoredMargin;
|
|
property Footer: Double index 5 read GetMargin write SetMargin stored IsStoredMargin;
|
|
end;
|
|
|
|
TGridPrnHeaderFooter = class(TPersistent)
|
|
private
|
|
FFont: TFont;
|
|
FFontSize: Integer;
|
|
FLineColor: TColor;
|
|
FLineWidth: Double;
|
|
FShowLine: Boolean;
|
|
FOwner: TGridPrinter;
|
|
FSectionSeparator: String;
|
|
FSectionText: array[TGridPrnHeaderFooterSection] of string;
|
|
FVisible: Boolean;
|
|
function GetProcessedText(AIndex: TGridPrnHeaderFooterSection): String;
|
|
function GetSectionText(AIndex: TGridPrnHeaderFooterSection): String;
|
|
function GetText: String;
|
|
function IsLineWidthStored: Boolean;
|
|
function IsSectionSepStored: Boolean;
|
|
function IsTextStored: Boolean;
|
|
procedure SetFont(AValue: TFont);
|
|
procedure SetLineColor(AValue: TColor);
|
|
procedure SetLineWidth(AValue: Double);
|
|
procedure SetSectionText(AIndex: TGridPrnHeaderFooterSection; AValue: String);
|
|
procedure SetShowLine(AValue: Boolean);
|
|
procedure SetText(AValue: String);
|
|
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;
|
|
function IsShown: Boolean;
|
|
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
|
|
property Font: TFont read FFont write SetFont;
|
|
property LineColor: TColor read FLineColor write SetLineColor default clDefault;
|
|
property LineWidth: Double read FLineWidth write SetLineWidth stored IsLineWidthStored;
|
|
property SectionSeparator: String read FSectionSeparator write FSectionSeparator stored IsSectionSepStored;
|
|
property ShowLine: Boolean read FShowLine write SetShowLine default true;
|
|
property Text: String read GetText write SetText stored IsTextStored;
|
|
property Visible: Boolean read FVisible write SetVisible default true;
|
|
end;
|
|
|
|
|
|
{ TGridPrinter }
|
|
|
|
TGridPrinter = class(TComponent)
|
|
private
|
|
FBorderLineColor: Integer;
|
|
FBorderLineWidth: Double;
|
|
FFixedLineColor: TColor;
|
|
FFixedLineWidth: Double;
|
|
FFromPage: Integer;
|
|
FGrid: TCustomGrid;
|
|
FGridLineColor: TColor;
|
|
FGridLineWidth: Double;
|
|
FHeader: TGridPrnHeaderFooter;
|
|
FFileName: String; // to be used by header/footer
|
|
FFooter: TGridPrnHeaderFooter;
|
|
FMargins: TGridPrnMargins;
|
|
FMonochrome: Boolean;
|
|
FOptions: TGridPrnOptions;
|
|
FPadding: Integer;
|
|
FPageHeight: Integer;
|
|
FPageWidth: Integer;
|
|
FPreviewPercent: Integer; // Scaling factor for preview bitmap
|
|
FPrintDateTime: TDateTime;
|
|
FPrintOrder: TGridPrnOrder;
|
|
FPrintScaleFactor: Double; // Scaling factor for printing
|
|
FPrintScaleToNumHorPages: Integer;
|
|
FPrintScaleToNumVertPages: Integer;
|
|
FPrintScalingMode: TGridPrnScalingMode;
|
|
FShowPrintDialog: TGridPrnDialog;
|
|
FToPage: Integer;
|
|
FOnAfterPrint: TNotifyEvent;
|
|
FOnBeforePrint: TNotifyEvent;
|
|
FOnGetCellText: TGridPrnGetCellTextEvent;
|
|
FOnGetColCount: TGridPrnGetColCountEvent;
|
|
FOnGetRowCount: TGridPrnGetRowCountEvent;
|
|
FOnLinePrinted: TGridPrnLinePrintedEvent;
|
|
FOnManualPageBreak: TGridPrnManualPageBreakEvent;
|
|
FOnNewLine: TGridPrnNewLineEvent;
|
|
FOnNewPage: TGridPrnNewPageEvent;
|
|
FOnPrepareCanvas: TOnPrepareCanvasEvent;
|
|
FOnPrintCell: TGridPrnPrintCellEvent;
|
|
FOnUpdatePreview: TNotifyEvent;
|
|
function GetBorderLineWidthHor: Integer;
|
|
function GetBorderLineWidthVert: Integer;
|
|
function GetCanvas: TCanvas;
|
|
function GetColWidth(AIndex: Integer): Double;
|
|
function GetFixedLineWidthHor: Integer;
|
|
function GetFixedLineWidthVert: Integer;
|
|
function GetGridLineWidthHor: Integer;
|
|
function GetGridLineWidthVert: Integer;
|
|
function GetOrientation: TPrinterOrientation;
|
|
function GetPageCount: Integer;
|
|
function GetPageNumber: Integer;
|
|
function GetRowHeight(AIndex: Integer): Double;
|
|
function IsBorderLineWidthStored: Boolean;
|
|
function IsFixedLineWidthStored: Boolean;
|
|
function IsGridLineWidthStored: Boolean;
|
|
function IsOrientationStored: Boolean;
|
|
function IsPrintScaleFactorStored: Boolean;
|
|
procedure SetBorderLineColor(AValue: TColor);
|
|
procedure SetBorderLineWidth(AValue: Double);
|
|
procedure SetFileName(AValue: String);
|
|
procedure SetFixedLineColor(AValue: TColor);
|
|
procedure SetFixedLineWidth(AValue: Double);
|
|
procedure SetGrid(AValue: TCustomGrid);
|
|
procedure SetGridLineColor(AValue: TColor);
|
|
procedure SetGridLineWidth(AValue: Double);
|
|
procedure SetOptions(AValue: TGridPrnOptions);
|
|
procedure SetOrientation(AValue: TPrinterOrientation);
|
|
protected
|
|
FFactorX: Double; // Multiply to convert screen to printer/preview pixels
|
|
FFactorY: Double;
|
|
FLeftMargin: Integer; // Scaled page margins
|
|
FTopMargin: Integer;
|
|
FRightMargin: Integer;
|
|
FBottomMargin: Integer;
|
|
FHeaderMargin: Integer;
|
|
FFooterMargin: Integer;
|
|
FColWidths: array of Double; // Array of scaled grid column widts
|
|
FRowHeights: array of Double; // Array of scaled grid row heights
|
|
FFixedColPos: Integer; // Scaled right end of the fixed cols
|
|
FFixedRowPos: Integer; // Scaled bottom end of the fixed rows
|
|
FOutputDevice: TGridPrnOutputDevice;
|
|
FPageBreakRows: array of Integer; // Indices of first row on new page
|
|
FPageBreakCols: array of Integer; // Indices of first columns on new page
|
|
FPageNumber: Integer;
|
|
FPageCount: Integer;
|
|
FPageRect: TRect; // Bounds of printable rectangle
|
|
FPixelsPerInchX: Integer;
|
|
FPixelsPerInchY: Integer;
|
|
FPreviewBitmap: TBitmap; // Bitmap to which the preview image is printed
|
|
FPreviewPage: Integer; // Page request for the preview bitmap
|
|
FColCount: Integer;
|
|
FRowCount: Integer;
|
|
FFixedCols: Integer;
|
|
FFixedRows: Integer;
|
|
FPrinting: Boolean;
|
|
procedure CalcFixedColPos(AStartCol, AEndCol: Integer; var ALeft, ARight: Integer);
|
|
procedure CalcFixedRowPos(AStartRow, AEndRow: Integer; var ATop, ABottom: Integer);
|
|
procedure DoLinePrinted(ARow, ALastCol: Integer); virtual;
|
|
function DoManualPageBreak(IsCol: Boolean; AColRow: Integer): Boolean; virtual;
|
|
procedure DoNewLine(ARow: Integer); virtual;
|
|
procedure DoNewPage(AStartCol, AStartRow, AEndCol, AEndRow: Integer); virtual;
|
|
procedure DoPrepareCanvas(ACol, ARow: Integer); virtual;
|
|
procedure DoPrintCell(ACanvas: TCanvas; ACol, ARow: Integer; ARect: TRect;
|
|
var Done: boolean); virtual;
|
|
procedure DoUpdatePreview; virtual;
|
|
procedure Execute(ACanvas: TCanvas);
|
|
function GetBrushColor(AColor: TColor): TColor;
|
|
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;
|
|
procedure Prepare;
|
|
procedure PrepareCanvas(ACanvas: TCanvas; ACol, ARow: Integer); virtual;
|
|
procedure PrintByCols(ACanvas: TCanvas);
|
|
procedure PrintByRows(ACanvas: TCanvas);
|
|
procedure PrintCell(ACanvas: TCanvas; ACol, ARow: Integer; ARect: TRect); virtual;
|
|
procedure PrintCheckbox(ACanvas: TCanvas; {%H-}ACol, {%H-}ARow: Integer; ARect: TRect;
|
|
ACheckState: TCheckboxstate); virtual;
|
|
procedure PrintColHeaders(ACanvas: TCanvas; ACol1, ACol2, Y: Integer);
|
|
procedure PrintFooter(ACanvas: TCanvas);
|
|
procedure PrintHeader(ACanvas: TCanvas);
|
|
procedure PrintHeaderFooter(ACanvas: TCanvas; HF: TGridPrnHeaderFooter);
|
|
procedure PrintGridLines(ACanvas: TCanvas; AStartCol, AStartRow, AEndCol, AEndRow, XEnd, YEnd: Integer);
|
|
procedure PrintPage(ACanvas: TCanvas; AStartCol, AStartRow, AEndCol, AEndRow: Integer);
|
|
procedure PrintRowHeader(ACanvas: TCanvas; ARow: Integer; X, Y: Double);
|
|
procedure ScaleColWidths(AFactor: Double);
|
|
procedure ScaleRowHeights(AFactor: Double);
|
|
procedure SelectFont(ACanvas: TCanvas; AFont: TFont; AScaleFactor: Double = 1.0);
|
|
property OutputDevice: TGridPrnOutputDevice read FOutputDevice;
|
|
public
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
function CreatePreviewBitmap(APageNo, APercentage: Integer): TBitmap;
|
|
function GetCellText(ACol, ARow: Integer): String; virtual;
|
|
procedure Print;
|
|
procedure ScaleToPages(NumHor, NumVert: Integer);
|
|
function ScaleX(AValue: Integer): Integer; inline;
|
|
function ScaleY(AValue: Integer): Integer; inline;
|
|
procedure UpdatePreview;
|
|
property Canvas: TCanvas read GetCanvas;
|
|
property ColCount: Integer read FColCount;
|
|
property ColWidth[AIndex: Integer]: Double read GetColWidth;
|
|
property FooterMargin: Integer read FFooterMargin;
|
|
property HeaderMargin: Integer read FHeaderMargin;
|
|
property PageHeight: Integer read FPageHeight;
|
|
property PageWidth: Integer read FPageWidth;
|
|
property PageRect: TRect read FPageRect;
|
|
property PixelsPerInchX: Integer read FPixelsPerInchX;
|
|
property PixelsPerInchY: Integer read FPixelsPerInchY;
|
|
property Padding: Integer read FPadding;
|
|
property PageCount: Integer read GetPageCount;
|
|
property PageNumber: Integer read FPageNumber;
|
|
property PrintDateTime: TDateTime read FPrintDateTime;
|
|
property PrintScaleToNumHorPages: Integer read FPrintScaleToNumHorPages write FPrintScaleToNumHorPages;
|
|
property PrintScaleToNumVertPages: Integer read FPrintScaleToNumVertPages write FPrintScaleToNumVertPages;
|
|
property PrintScalingMode: TGridPrnScalingMode read FPrintScalingMode write FPrintScalingMode;
|
|
property RowCount: Integer read FRowCount;
|
|
property RowHeight[AIndex: Integer]: Double read GetRowHeight;
|
|
published
|
|
property Grid: TCustomGrid read FGrid write SetGrid;
|
|
property BorderLineColor: TColor read FBorderLineColor write SetBorderLineColor default clDefault;
|
|
property BorderLineWidth: Double read FBorderLineWidth write SetBorderLineWidth stored IsBorderLineWidthStored;
|
|
property FileName: String read FFileName write SetFileName;
|
|
property FixedLineColor: TColor read FFixedLineColor write SetFixedLineColor default clDefault;
|
|
property FixedLineWidth: Double read FFixedLineWidth write SetFixedLineWidth stored IsFixedLineWidthStored;
|
|
property Footer: TGridPrnHeaderFooter read FFooter write FFooter;
|
|
property FromPage: Integer read FFromPage write FFromPage default 0;
|
|
property GridLineColor: TColor read FGridLineColor write SetGridLineColor default clDefault;
|
|
property GridLineWidth: Double read FGridLineWidth write SetGridLineWidth stored IsGridLineWidthStored;
|
|
property Header: TGridPrnHeaderFooter read FHeader write FHeader;
|
|
property Margins: TGridPrnMargins read FMargins write FMargins;
|
|
property Monochrome: Boolean read FMonochrome write FMonochrome default false;
|
|
property Options: TGridPrnOptions read FOptions write SetOptions default DEFAULT_GRIDPRNOPTIONS;
|
|
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;
|
|
property OnBeforePrint: TNotifyEvent read FOnBeforePrint write FOnBeforePrint;
|
|
property OnGetCellText: TGridPrnGetCellTextEvent read FOnGetCellText write FOnGetCellText;
|
|
property OnGetRowCount: TGridPrnGetRowCountEvent read FOnGetRowCount write FOnGetRowCount;
|
|
property OnGetColCount: TGridPrnGetColCountEvent read FOnGetColCount write FOnGetColCount;
|
|
property OnLinePrinted: TGridPrnLinePrintedEvent read FOnLinePrinted write FOnLinePrinted; // Finished printing a line
|
|
property OnManualPageBreak: TGridPrnManualPageBreakEvent read FOnManualPageBreak write FOnManualPageBreak;
|
|
property OnNewLine: TGridPrnNewLineEvent read FOnNewLine write FOnNewLine; // Started printing a new row of cells.
|
|
property OnNewPage: TGridPrnNewPageEvent read FOnNewPage write FOnNewPage; // Started printing a new page
|
|
property OnPrepareCanvas: TOnPrepareCanvasEvent read FOnPrepareCanvas write FOnPrepareCanvas;
|
|
property OnPrintCell: TGridPrnPrintCellEvent read FOnPrintCell write FOnPrintCell;
|
|
property OnUpdatePreview: TNotifyEvent read FOnUpdatePreview write FOnUpdatePreview;
|
|
end;
|
|
|
|
function mm2px(mm: Double; dpi: Integer): Integer;
|
|
function px2mm(px: Integer; dpi: Integer): Double;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Dialogs, OSPrinters, Themes, Math;
|
|
|
|
type
|
|
TGridAccess = class(TCustomGrid);
|
|
|
|
const
|
|
INCH = 25.4; // 1" = 25.4 mm
|
|
|
|
DefaultTextStyle: TTextStyle = (
|
|
Alignment: taLeftJustify;
|
|
Layout: tlCenter;
|
|
SingleLine: true;
|
|
Clipping: true;
|
|
ExpandTabs: false;
|
|
ShowPrefix: false;
|
|
WordBreak: false;
|
|
Opaque: false;
|
|
SystemFont: false;
|
|
RightToLeft: false;
|
|
EndEllipsis: false
|
|
);
|
|
|
|
function IfThen(cond: Boolean; a, b: Integer): Integer;
|
|
begin
|
|
if cond then Result := a else Result := b;
|
|
end;
|
|
|
|
function IfThen(cond: Boolean; a, b: TColor): TColor;
|
|
begin
|
|
if cond then Result := a else Result := b;
|
|
end;
|
|
|
|
function DefaultFontSize(AFont: TFont): Integer;
|
|
var
|
|
fontData: TFontData;
|
|
begin
|
|
fontData := GetFontData(AFont.Reference.Handle);
|
|
Result := abs(fontData.Height) * 72 div ScreenInfo.PixelsPerInchY;
|
|
end;
|
|
|
|
procedure FixFontSize(AFont: TFont);
|
|
begin
|
|
if AFont.Size = 0 then
|
|
AFont.Size := DefaultFontSize(AFont);
|
|
end;
|
|
|
|
function mm2px(mm: Double; dpi: Integer): Integer;
|
|
begin
|
|
Result := round(mm/INCH * dpi);
|
|
end;
|
|
|
|
function px2mm(px: Integer; dpi: Integer): Double;
|
|
begin
|
|
Result := px * INCH / dpi;
|
|
end;
|
|
|
|
|
|
{ TGridPrnMargins }
|
|
|
|
constructor TGridPrnMargins.Create(AOwner: TGridPrinter);
|
|
var
|
|
i: Integer;
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
for i := 0 to 3 do FMargins[i] := 20.0;
|
|
for i := 4 to 5 do FMargins[i] := 10.0;
|
|
end;
|
|
|
|
procedure TGridPrnMargins.Changed;
|
|
begin
|
|
if (FOwner <> nil) then
|
|
FOwner.UpdatePreview;
|
|
end;
|
|
|
|
function TGridPrnMargins.GetMargin(AIndex: Integer): Double;
|
|
begin
|
|
Result := FMargins[AIndex];
|
|
end;
|
|
|
|
function TGridPrnMargins.IsStoredMargin(AIndex: Integer): Boolean;
|
|
begin
|
|
case AIndex of
|
|
0..3: Result := FMargins[AIndex] <> 20.0;
|
|
4..5: Result := FMargins[AIndex] <> 10.0;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrnMargins.SetMargin(AIndex: Integer; AValue: Double);
|
|
begin
|
|
if FMargins[AIndex] <> AValue then
|
|
begin
|
|
FMargins[AIndex] := AValue;
|
|
Changed;
|
|
end;
|
|
end;
|
|
|
|
|
|
{ TGridPrnHeaderFooter }
|
|
|
|
constructor TGridPrnHeaderFooter.Create(AOwner: TGridPrinter);
|
|
begin
|
|
inherited Create;
|
|
FOwner := AOwner;
|
|
|
|
FSectionSeparator := '|';
|
|
|
|
FFont := TFont.Create;
|
|
FixFontSize(FFont);
|
|
FFont.Size := FFont.Size - 1;
|
|
FFont.OnChange := @Changed;
|
|
|
|
FLineColor := clDefault;
|
|
FLineWidth := 0;
|
|
FShowLine := true;
|
|
FVisible := true;
|
|
end;
|
|
|
|
destructor TGridPrnHeaderFooter.Destroy;
|
|
begin
|
|
FFont.Free;
|
|
inherited;
|
|
end;
|
|
|
|
procedure TGridPrnHeaderFooter.Changed(Sender: TObject);
|
|
begin
|
|
if (FOwner <> nil) then
|
|
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>';
|
|
|
|
procedure Replace(AParam: String);
|
|
var
|
|
s: String;
|
|
begin
|
|
if FOwner <> nil then
|
|
case AParam of
|
|
'$PAGECOUNT': s := IntToStr(FOwner.PageCount);
|
|
'$PAGE': s := IntToStr(FOwner.PageNumber);
|
|
'$FULL_FILENAME': s := ExpandFileName(FOwner.FileName);
|
|
'$FILENAME': s := ExtractFileName(FOwner.FileName);
|
|
'$PATH': s := ExtractFilePath(ExpandFileName(FOwner.FileName));
|
|
end
|
|
else
|
|
s := UNKNOWN;
|
|
Result := StringReplace(Result, AParam, s, [rfReplaceAll, rfIgnoreCase]);
|
|
end;
|
|
|
|
begin
|
|
Result := FSectionText[AIndex];
|
|
Result := StringReplace(Result, '$DATE', DateToStr(FOwner.PrintDateTime), [rfReplaceAll, rfIgnoreCase]);
|
|
Result := StringReplace(Result, '$TIME', TimeToStr(FOwner.PrintDateTime), [rfReplaceAll, rfIgnoreCase]);
|
|
Replace('$PAGECOUNT');
|
|
Replace('$PAGE');
|
|
Replace('$FULL_FILENAME');
|
|
Replace('$FILENAME');
|
|
Replace('$PATH');
|
|
end;
|
|
|
|
function TGridPrnHeaderFooter.GetSectionText(AIndex: TGridPrnHeaderFooterSection): String;
|
|
begin
|
|
Result := FSectionText[AIndex];
|
|
end;
|
|
|
|
function TGridPrnHeaderFooter.GetText: String;
|
|
begin
|
|
Result :=
|
|
FSectionText[hfsLeft] + FSectionSeparator +
|
|
FSectionText[hfsCenter] + FSectionSeparator +
|
|
FSectionText[hfsRight];
|
|
end;
|
|
|
|
function TGridPrnHeaderFooter.IsLineWidthStored: Boolean;
|
|
begin
|
|
Result := FLineWidth > 0;
|
|
end;
|
|
|
|
function TGridPrnHeaderFooter.IsSectionSepStored: Boolean;
|
|
begin
|
|
Result := FSectionSeparator <> '|';
|
|
end;
|
|
|
|
function TGridPrnHeaderFooter.IsShown: Boolean;
|
|
begin
|
|
Result := FVisible and not IsTextEmpty;
|
|
end;
|
|
|
|
function TGridPrnHeaderFooter.IsTextEmpty: Boolean;
|
|
begin
|
|
Result :=
|
|
(FSectionText[hfsLeft] = '') and
|
|
(FSectionText[hfsCenter] = '') and
|
|
(FSectionText[hfsRight] = '');
|
|
end;
|
|
|
|
function TGridPrnHeaderFooter.IsTextStored: Boolean;
|
|
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
|
|
Result := clBlack
|
|
else
|
|
Result := FLineColor;
|
|
end;
|
|
|
|
function TGridPrnHeaderFooter.RealLineWidth: Integer;
|
|
begin
|
|
if FLineWidth <= 0 then
|
|
Result := FOwner{%H-}.ScaleY(1)
|
|
else
|
|
Result := mm2px(FLineWidth/FOwner.PrintScaleFactor, FOwner.PixelsPerInchY);
|
|
end;
|
|
|
|
procedure TGridPrnHeaderFooter.SetFont(AValue: TFont);
|
|
begin
|
|
FFont.Assign(AValue);
|
|
Changed(nil);
|
|
end;
|
|
|
|
procedure TGridPrnHeaderFooter.SetLineColor(AValue: TColor);
|
|
begin
|
|
if FLineColor <> AValue then
|
|
begin
|
|
FLineColor := AValue;
|
|
Changed(nil);
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrnHeaderFooter.SetLineWidth(AValue: Double);
|
|
begin
|
|
if FLineWidth <> AValue then
|
|
begin
|
|
FLineWidth := AValue;
|
|
Changed(nil);
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrnHeaderFooter.SetSectionText(AIndex: TGridPrnHeaderFooterSection;
|
|
AValue: String);
|
|
begin
|
|
if FSectionText[AIndex] <> AValue then
|
|
begin
|
|
FSectionText[AIndex] := AValue;
|
|
Changed(nil);
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrnHeaderFooter.SetShowLine(AValue: Boolean);
|
|
begin
|
|
if FShowLine <> AValue then
|
|
begin
|
|
FShowLine := AValue;
|
|
Changed(nil);
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrnHeaderFooter.SetText(AValue: String);
|
|
var
|
|
sa: TStringArray;
|
|
begin
|
|
if GetText = AValue then
|
|
exit;
|
|
sa := AValue.Split([FSectionSeparator]);
|
|
if Length(sa) > 0 then FSectionText[hfsLeft] := sa[0] else FSectionText[hfsLeft] := '';
|
|
if Length(sa) > 1 then FSectionText[hfsCenter] := sa[1] else FSectionText[hfsCenter] := '';
|
|
if Length(sa) > 2 then FSectionText[hfsRight] := sa[2] else FSectionText[hfsRight] := '';
|
|
Changed(self);
|
|
end;
|
|
|
|
procedure TGridPrnHeaderFooter.SetVisible(AValue: Boolean);
|
|
begin
|
|
if FVisible <> AValue then
|
|
begin
|
|
FVisible := AValue;
|
|
Changed(self);
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrnHeaderFooter.WriteFontSize(Writer: TWriter);
|
|
begin
|
|
FFontSize := FFont.Size;
|
|
Writer.WriteInteger(FFontSize);
|
|
end;
|
|
|
|
|
|
{ TGridPrinter }
|
|
|
|
constructor TGridPrinter.Create(AOwner: TComponent);
|
|
begin
|
|
inherited;
|
|
|
|
FMargins := TGridPrnMargins.Create(Self);
|
|
FHeader := TGridPrnHeaderFooter.Create(Self);
|
|
FFooter := TGridPrnHeaderFooter.Create(Self);
|
|
|
|
FOptions := DEFAULT_GRIDPRNOPTIONS;
|
|
FPrintOrder := poRowsFirst;
|
|
FPrintScaleFactor := 1.0;
|
|
FPrintScaleToNumHorPages := 1;
|
|
FPrintScaleToNumVertPages := 1;
|
|
FBorderLineColor := clDefault;
|
|
FFixedLineColor := clDefault;
|
|
FGridLineColor := clDefault;
|
|
FBorderLineWidth := -1;
|
|
FFixedLineWidth := -1;
|
|
FGridLineWidth := -1;
|
|
end;
|
|
|
|
destructor TGridPrinter.Destroy;
|
|
begin
|
|
FHeader.Free;
|
|
FFooter.Free;
|
|
FMargins.Free;
|
|
inherited;
|
|
end;
|
|
|
|
{ Calculates the extent (in printer/preview pixels) of the fixed ccolumns
|
|
(left edge of first and right edge of last fixed column).
|
|
Takes care of the optional horizontal centering of the grid. }
|
|
procedure TGridPrinter.CalcFixedColPos(AStartCol, AEndCol: Integer;
|
|
var ALeft, ARight: Integer);
|
|
var
|
|
col: Integer;
|
|
w: Double;
|
|
fixedColsWidth: Integer;
|
|
begin
|
|
if (gpoCenterHor in FOptions) then
|
|
begin
|
|
// Total width of all fixed columns
|
|
fixedColsWidth := FFixedColPos - FLeftMargin;
|
|
w := fixedColsWidth;
|
|
for col := AStartCol to AEndCol do
|
|
w := w + FColWidths[col];
|
|
// w is total column width on this page
|
|
ALeft := FLeftMargin + round((FPageRect.Width - w) / 2);
|
|
ARight := ALeft + fixedColsWidth;
|
|
end else
|
|
begin
|
|
ALeft := FLeftMargin;
|
|
ARight := FFixedColPos;
|
|
end;
|
|
end;
|
|
|
|
{ Calculates the extent (in printer/preview pixels) of the fixed rows
|
|
(top edge of first and bottom edge of last fixed row).
|
|
Takes care of the optional vertical centering of the grid. }
|
|
procedure TGridPrinter.CalcFixedRowPos(AStartRow, AEndRow: Integer;
|
|
var ATop, ABottom: Integer);
|
|
var
|
|
row: Integer;
|
|
h: Double;
|
|
fixedRowsHeight: Integer;
|
|
begin
|
|
if (gpoCenterVert in FOptions) then
|
|
begin
|
|
// Total height of all fixed rows
|
|
fixedRowsheight := FFixedRowPos - FTopMargin;
|
|
h := fixedRowsHeight;
|
|
for row := AStartRow to AEndRow do
|
|
h := h + FRowHeights[row];
|
|
// h is total row height on this page
|
|
ATop := FTopMargin + round((FPageRect.Height - h) / 2);
|
|
ABottom := ATop + fixedRowsHeight;
|
|
end else
|
|
begin
|
|
ATop := FTopMargin;
|
|
ABottom := FFixedRowPos;
|
|
end;
|
|
end;
|
|
|
|
|
|
function TGridPrinter.CreatePreviewBitmap(APageNo, APercentage: Integer): TBitmap;
|
|
begin
|
|
if FGrid = nil then
|
|
begin
|
|
Result := nil;
|
|
exit;
|
|
end;
|
|
|
|
FOutputDevice := odPreview;
|
|
|
|
FPreviewPercent := APercentage;
|
|
FPreviewPage := APageNo; // out-of-range values are handled by Prepare
|
|
SetGrid(FGrid);
|
|
Prepare;
|
|
|
|
FPreviewBitmap := TBitmap.Create;
|
|
FPreviewBitmap.SetSize(FPageWidth, FPageHeight);
|
|
FPreviewBitmap.Canvas.Brush.Color := clWhite;
|
|
FPreviewBitmap.Canvas.FillRect(0, 0, FPageWidth, FPageHeight);
|
|
|
|
Execute(FPreviewBitmap.Canvas);
|
|
|
|
Result := FPreviewBitmap;
|
|
end;
|
|
|
|
procedure TGridPrinter.DoLinePrinted(ARow, ALastCol: Integer);
|
|
begin
|
|
if Assigned(FOnLinePrinted) then
|
|
FOnLinePrinted(Self, FGrid, ARow, ALastCol);
|
|
end;
|
|
|
|
function TGridPrinter.DoManualPageBreak(IsCol: Boolean; AColRow: Integer): Boolean;
|
|
begin
|
|
Result := false;
|
|
if Assigned(OnManualPageBreak) then
|
|
OnManualPageBreak(Self, FGrid, IsCol, AColRow, Result);
|
|
end;
|
|
|
|
procedure TGridPrinter.DoNewLine(ARow: Integer);
|
|
begin
|
|
if Assigned(FOnNewLine) then
|
|
FOnNewLine(Self, FGrid, ARow);
|
|
end;
|
|
|
|
procedure TGridPrinter.DoNewPage(AStartCol, AStartRow, AEndCol, AEndRow: Integer);
|
|
begin
|
|
if Assigned(FOnNewPage) then
|
|
FOnNewPage(Self, FGrid, FPageNumber, AStartCol, AStartRow, AEndCol, AEndRow);
|
|
end;
|
|
|
|
procedure TGridPrinter.DoPrepareCanvas(ACol, ARow: Integer);
|
|
begin
|
|
if Assigned(FOnPrepareCanvas) then
|
|
FOnPrepareCanvas(Self, ACol, ARow, []);
|
|
end;
|
|
|
|
procedure TGridPrinter.DoPrintCell(ACanvas: TCanvas; ACol, ARow: Integer;
|
|
ARect: TRect; var Done: Boolean);
|
|
begin
|
|
if Assigned(FOnPrintCell) then
|
|
begin
|
|
FOnPrintCell(Self, FGrid, ACanvas, ACol, ARow, ARect);
|
|
Done := true;
|
|
end else
|
|
Done := false;
|
|
end;
|
|
|
|
procedure TGridPrinter.DoUpdatePreview;
|
|
begin
|
|
if Assigned(FOnUpdatePreview) and (FOutputDevice = odPreview) then
|
|
FOnUpdatePreview(Self);
|
|
end;
|
|
|
|
procedure TGridPrinter.Execute(ACanvas: TCanvas);
|
|
begin
|
|
FPrinting := true;
|
|
if Assigned(FOnBeforePrint) then
|
|
FOnBeforePrint(Self);
|
|
case FPrintOrder of
|
|
poRowsFirst: PrintByRows(ACanvas);
|
|
poColsFirst: PrintByCols(ACanvas);
|
|
end;
|
|
if Assigned(FOnAfterPrint) then
|
|
FOnAfterPrint(Self);
|
|
FPrinting := false;
|
|
end;
|
|
|
|
function TGridPrinter.GetBorderLineWidthHor: Integer;
|
|
begin
|
|
if FBorderLineWidth < 0.0 then
|
|
Result := {%H-}ScaleY(2)
|
|
else
|
|
Result := mm2px(FBorderLineWidth, FPixelsPerInchY);
|
|
end;
|
|
|
|
function TGridPrinter.GetBorderLineWidthVert: Integer;
|
|
begin
|
|
if FBorderLineWidth < 0.0 then
|
|
Result := {%H-}ScaleX(2)
|
|
else
|
|
Result := mm2px(FBorderLineWidth, FPixelsPerInchX);
|
|
end;
|
|
|
|
// Returns a bright brush even in dark mode
|
|
function TGridPrinter.GetBrushColor(AColor: TColor): TColor;
|
|
begin
|
|
if (AColor = clDefault) or (AColor = clWindow) or FMonochrome then
|
|
Result := clWhite
|
|
else
|
|
Result := ColorToRGB(AColor);
|
|
end;
|
|
|
|
// Returns a dark pen, even in dark mode
|
|
function TGridPrinter.GetFontColor(AColor: TColor): TColor;
|
|
begin
|
|
if (AColor = clDefault) or (AColor = clWindowText) or FMonochrome then
|
|
Result := clBlack
|
|
else
|
|
Result := ColorToRGB(AColor);
|
|
end;
|
|
|
|
// Returns a dark font, even in dark mode
|
|
function TGridPrinter.GetPenColor(AColor: TCOlor): TColor;
|
|
begin
|
|
if (AColor = clDefault) or (AColor = clWindowText) or FMonochrome then
|
|
Result := clBlack
|
|
else
|
|
Result := ColorToRGB(AColor);
|
|
end;
|
|
|
|
function TGridPrinter.GetCanvas: TCanvas;
|
|
begin
|
|
if FPrinting then
|
|
case FOutputDevice of
|
|
odPrinter: Result := Printer.Canvas;
|
|
odPreview: Result := FPreviewBitmap.Canvas;
|
|
end
|
|
else
|
|
Result := nil;
|
|
end;
|
|
|
|
function TGridPrinter.GetColWidth(AIndex: Integer): Double;
|
|
begin
|
|
Result := FColWidths[AIndex];
|
|
end;
|
|
|
|
function TGridPrinter.GetCellText(ACol, ARow: Integer): String;
|
|
var
|
|
col: TGridColumn;
|
|
lGrid: TGridAccess;
|
|
begin
|
|
Result := '';
|
|
if FGrid = nil then
|
|
exit;
|
|
|
|
lGrid := TGridAccess(FGrid);
|
|
if (ACol = 0) and (FFixedCols > 0) and (ARow >= FFixedRows) and (goFixedRowNumbering in lGrid.Options) then
|
|
begin
|
|
Result := IntToStr(ARow - FFixedRows + 1);
|
|
exit;
|
|
end;
|
|
|
|
if lGrid.Columns.Enabled and (ACol >= FFixedCols) and (ARow = 0) and (FFixedRows > 0) then
|
|
begin
|
|
col := lGrid.Columns[ACol - FFixedCols];
|
|
Result := col.Title.Caption;
|
|
exit;
|
|
end;
|
|
|
|
if Assigned(FOnGetCellText) then
|
|
FOnGetCellText(self, FGrid, ACol, ARow, Result)
|
|
else
|
|
Result := lGrid.GetCells(Acol, ARow);
|
|
end;
|
|
|
|
function TGridPrinter.GetFixedLineWidthHor: Integer;
|
|
begin
|
|
if FFixedLineWidth < 0.0 then
|
|
Result := {%H-}ScaleY(TGridAccess(FGrid).GridLineWidth)
|
|
else
|
|
Result := mm2px(FFixedLineWidth, FPixelsPerInchY);
|
|
end;
|
|
|
|
function TGridPrinter.GetFixedLineWidthVert: Integer;
|
|
begin
|
|
if FFixedLineWidth < 0.0 then
|
|
Result := {%H-}ScaleX(TGridAccess(FGrid).GridLineWidth)
|
|
else
|
|
Result := mm2px(FFixedLineWidth, FPixelsPerInchX);
|
|
end;
|
|
|
|
function TGridPrinter.GetGridLineWidthHor: Integer;
|
|
begin
|
|
if FGridLineWidth < 0.0 then
|
|
Result := {%H-}ScaleY(TGridAccess(FGrid).GridLineWidth)
|
|
else
|
|
Result := mm2px(FGridLineWidth, FPixelsPerInchY);
|
|
end;
|
|
|
|
function TGridPrinter.GetGridLineWidthVert: Integer;
|
|
begin
|
|
if FGridLineWidth < 0.0 then
|
|
Result := {%H-}ScaleX(TGridAccess(FGrid).GridLineWidth)
|
|
else
|
|
Result := mm2px(FGridLineWidth, FPixelsPerInchX);
|
|
end;
|
|
|
|
function TGridPrinter.GetOrientation: TPrinterOrientation;
|
|
begin
|
|
Result := Printer.Orientation;
|
|
end;
|
|
|
|
function TGridPrinter.GetPageCount: Integer;
|
|
begin
|
|
if FPageCount = 0 then
|
|
Prepare;
|
|
Result := FPageCount;
|
|
end;
|
|
|
|
function TGridPrinter.GetPageNumber: Integer;
|
|
begin
|
|
if FPageNumber <= 0 then
|
|
Prepare;
|
|
Result := FPageNumber;
|
|
end;
|
|
|
|
function TGridPrinter.GetRowHeight(AIndex: Integer): Double;
|
|
begin
|
|
Result := FRowHeights[AIndex];
|
|
end;
|
|
|
|
function TGridPrinter.IsBorderLineWidthStored: Boolean;
|
|
begin
|
|
Result := FBorderLineWidth >= 0.0;
|
|
end;
|
|
|
|
function TGridPrinter.IsFixedLineWidthStored: Boolean;
|
|
begin
|
|
Result := FFixedLineWidth >= 0.0;
|
|
end;
|
|
|
|
function TGridPrinter.IsGridLineWidthStored: Boolean;
|
|
begin
|
|
Result := FGridLineWidth >= 0.0;
|
|
end;
|
|
|
|
function TGridPrinter.IsOrientationStored: Boolean;
|
|
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. }
|
|
procedure TGridPrinter.LayoutPageBreaks;
|
|
var
|
|
col, row: Integer;
|
|
n: Integer;
|
|
totalWidth, totalHeight: Double;
|
|
begin
|
|
// Scanning horizontally --> get page break column indices
|
|
SetLength(FPageBreakCols, FColCount);
|
|
n := 0;
|
|
totalWidth := FFixedColPos;
|
|
FPageBreakCols[0] := FFixedCols;
|
|
for col := FFixedCols to FColCount-1 do
|
|
begin
|
|
totalWidth := totalWidth + FColWidths[col];
|
|
if ((totalWidth - FPageRect.Right) >= 1) or DoManualPageBreak(true, col) then // allow 1 pixel for rounding error
|
|
begin
|
|
inc(n);
|
|
FPageBreakCols[n] := col;
|
|
totalWidth := FFixedColPos + FColWidths[col];
|
|
end;
|
|
end;
|
|
SetLength(FPageBreakCols, n+1);
|
|
|
|
// Scanning vertically --> get page break row indices
|
|
SetLength(FPageBreakRows, FRowCount);
|
|
n := 0;
|
|
totalHeight := FFixedRowPos;
|
|
FPageBreakRows[0] := FFixedRows;
|
|
for row := FFixedRows to FRowCount-1 do
|
|
begin
|
|
totalHeight := totalHeight + FRowHeights[row];
|
|
if (totalHeight > FPageRect.Bottom) or DoManualPageBreak(false, row) then
|
|
begin
|
|
inc(n);
|
|
FPageBreakRows[n] := row;
|
|
totalHeight := FFixedRowPos + FRowHeights[row];
|
|
end;
|
|
end;
|
|
SetLength(FPageBreakRows, n+1);
|
|
|
|
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
|
|
// Multiplication factor needed by ScaleX and ScaleY
|
|
FFactorX := XDpi / ScreenInfo.PixelsPerInchX * FPrintScaleFactor;
|
|
FFactorY := YDpi / ScreenInfo.PixelsPerInchY * FPrintScaleFactor;
|
|
|
|
// Margins in the new pixel density units.
|
|
FLeftMargin := mm2px(FMargins.Left, XDpi);
|
|
FTopMargin := mm2px(FMargins.Top, YDpi);
|
|
FRightMargin := mm2px(FMargins.Right, XDpi);
|
|
FBottomMargin := mm2px(FMargins.Bottom, YDpi);
|
|
FHeaderMargin := mm2px(FMargins.Header, YDpi);
|
|
FFooterMargin := mm2px(FMargins.Footer, YDpi);
|
|
FPageRect := Rect(FLeftMargin, FTopMargin, APageWidth - FRightMargin, APageHeight - FBottomMargin);
|
|
FPadding := {%H-}ScaleX(varCellPadding);
|
|
|
|
// Calculates column widths and row heights in the new pixel density units
|
|
ScaleColWidths(FFactorX);
|
|
ScaleRowHeights(FFactorY);
|
|
end;
|
|
|
|
procedure TGridPrinter.NewPage;
|
|
begin
|
|
if FOutputDevice = odPrinter then
|
|
Printer.NewPage;
|
|
end;
|
|
|
|
procedure TGridPrinter.Notification(AComponent: TComponent;
|
|
Operation: TOperation);
|
|
begin
|
|
inherited;
|
|
if Operation = opRemove then
|
|
begin
|
|
if AComponent = FGrid then
|
|
FGrid := nil;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.Prepare;
|
|
begin
|
|
// Calculate grid indices at which page breaks occur. Since the font size is
|
|
// an integer, the zoomed preview may have slightly different values - which
|
|
// is not desired. Therefore, we calculate this for the printer resolution.
|
|
Measure(Printer.PageWidth, Printer.PageHeight, Printer.XDPI, Printer.YDPI);
|
|
LayoutPagebreaks;
|
|
|
|
case FOutputDevice of
|
|
odPrinter:
|
|
begin
|
|
FPixelsPerInchX := Printer.XDPI;
|
|
FPixelsPerInchY := Printer.YDPI;
|
|
FPageWidth := Printer.PageWidth;
|
|
FPageHeight := Printer.PageHeight;
|
|
end;
|
|
odPreview:
|
|
begin
|
|
if FPreviewPercent = 0 then
|
|
exit;
|
|
FPixelsPerInchX := ScreenInfo.PixelsPerInchX * FPreviewPercent div 100;
|
|
FPixelsPerInchY := ScreenInfo.PixelsPerInchY * FPreviewPercent div 100;
|
|
FPageWidth := round(Printer.PageWidth * FPixelsPerInchX / Printer.XDPI);
|
|
FPageHeight := round(Printer.PageHeight * FPixelsPerInchY / Printer.YDPI);
|
|
// Recalculates page dimensions and col/row sizes, now based on
|
|
// the "real" ppi of the preview.
|
|
Measure(FPageWidth, FPageHeight, FPixelsPerInchX, FPixelsPerInchY);
|
|
end;
|
|
end;
|
|
|
|
// Stores the current date/time so that all pages have the same date/time
|
|
// in the header/footer.
|
|
FPrintDateTime := Now();
|
|
end;
|
|
|
|
procedure TGridPrinter.PrepareCanvas(ACanvas: TCanvas; ACol, ARow: Integer);
|
|
var
|
|
lGrid: TGridAccess;
|
|
col: TGridColumn;
|
|
textStyle: TTextStyle;
|
|
font: TFont;
|
|
begin
|
|
lGrid := TGridAccess(FGrid);
|
|
|
|
// Background color
|
|
ACanvas.Brush.Style := bsSolid;
|
|
if (ACol < FFixedCols) or (ARow < FFixedRows) then
|
|
ACanvas.Brush.Color := GetBrushColor(IfThen(lGrid.FixedColor = clBtnFace, $E0E0E0, lGrid.FixedColor))
|
|
else
|
|
if lGrid.Columns.Enabled and (ACol >= FFixedCols) then
|
|
begin
|
|
col := lGrid.Columns[ACol - FFixedCols];
|
|
ACanvas.Brush.Color := GetBrushColor(col.Color);
|
|
end else
|
|
begin
|
|
if Odd(ARow) then
|
|
ACanvas.Brush.Color := GetBrushColor(lGrid.Color)
|
|
else
|
|
ACanvas.Brush.Color := GetBrushColor(lGrid.AlternateColor);
|
|
end;
|
|
|
|
// Font
|
|
if lGrid.Columns.Enabled and (ACol >= FFixedCols) then
|
|
begin
|
|
col := lGrid.Columns[ACol - FFixedCols];
|
|
if (ARow < FFixedRows) then
|
|
font := col.Title.Font
|
|
else
|
|
font := col.Font;
|
|
SelectFont(ACanvas, font, FPrintScaleFactor);
|
|
ACanvas.Font.Color := GetFontColor(font.Color);
|
|
end else
|
|
begin
|
|
SelectFont(ACanvas, lGrid.Font, FPrintScaleFactor);
|
|
ACanvas.Font.Color := GetFontColor(lGrid.Font.Color);
|
|
end;
|
|
FixFontSize(ACanvas.Font);
|
|
|
|
// Text style
|
|
textStyle := DefaultTextStyle;
|
|
if lGrid.Columns.Enabled and (ACol >= FFixedCols) then
|
|
begin
|
|
col := lGrid.Columns[ACol - FFixedCols];
|
|
if (ARow < FFixedRows) then
|
|
begin
|
|
textStyle.Alignment := col.Title.Alignment;
|
|
textStyle.Layout := col.Title.Layout;
|
|
if col.Title.MultiLine then
|
|
begin
|
|
textStyle.Wordbreak := true;
|
|
textStyle.SingleLine := false;
|
|
textStyle.EndEllipsis := false;
|
|
end;
|
|
end else
|
|
begin
|
|
textStyle.Alignment := col.Alignment;
|
|
textStyle.Layout := col.Layout;
|
|
end;
|
|
end;
|
|
if (goCellEllipsis in lGrid.Options) then
|
|
textStyle.EndEllipsis := true;
|
|
ACanvas.TextStyle := textStyle;
|
|
|
|
// Fire the event OnPrepareCanvas
|
|
DoPrepareCanvas(ACol, ARow);
|
|
end;
|
|
|
|
procedure TGridPrinter.Print;
|
|
var
|
|
pageDlg: TPageSetupDialog;
|
|
printDlg: TPrintDialog;
|
|
prnSetupDlg: TPrinterSetupDialog;
|
|
begin
|
|
if FGrid = nil then
|
|
exit;
|
|
|
|
if Printer.Printers.Count = 0 then
|
|
raise EPrinter.Create('No printer defined.');
|
|
|
|
SetGrid(FGrid);
|
|
|
|
case FShowPrintDialog of
|
|
gpdNone:
|
|
;
|
|
gpdPageSetup:
|
|
begin
|
|
pageDlg := TPageSetupDialog.Create(nil);
|
|
try
|
|
pageDlg.Units := pmMillimeters;
|
|
pageDlg.MarginLeft := round(FMargins.Left*100);
|
|
pageDlg.MarginTop := round(FMargins.Top*100);
|
|
pageDlg.MarginRight := round(FMargins.Right*100);
|
|
pageDlg.MarginBottom := round(FMargins.Bottom*100);
|
|
if pageDlg.Execute then
|
|
begin
|
|
FMargins.FMargins[0] := pageDlg.MarginLeft*0.01;
|
|
FMargins.FMargins[1] := pageDlg.MarginTop*0.01;
|
|
FMargins.FMargins[2] := pageDlg.MarginRight*0.01;
|
|
FMargins.FMargins[3] := pageDlg.MarginBottom*0.01;
|
|
FFromPage := 0; // all pages
|
|
FToPage := 0;
|
|
end else
|
|
exit;
|
|
finally
|
|
pageDlg.Free;
|
|
end;
|
|
end;
|
|
gpdPrintDialog:
|
|
begin
|
|
printDlg := TPrintDialog.Create(nil);
|
|
try
|
|
printDlg.MinPage := 1;
|
|
printDlg.MaxPage := PageCount;
|
|
printDlg.Options := printDlg.Options + [poPageNums];
|
|
if printDlg.Execute then
|
|
begin
|
|
Printer.Copies := printDlg.Copies;
|
|
if printDlg.PrintRange = prAllPages then
|
|
begin
|
|
FFromPage := 0; // all pages
|
|
FToPage := 0;
|
|
end else
|
|
begin
|
|
FFromPage := printDlg.FromPage;
|
|
FToPage := printDlg.ToPage;
|
|
end;
|
|
end else
|
|
exit;
|
|
finally
|
|
printDlg.Free;
|
|
end;
|
|
end;
|
|
gpdPrinterSetup:
|
|
begin
|
|
prnSetupDlg := TPrinterSetupDialog.Create(nil);
|
|
try
|
|
if prnSetupDlg.Execute then
|
|
begin
|
|
//
|
|
end else
|
|
exit;
|
|
finally
|
|
prnSetupDlg.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
FOutputDevice := odPrinter;
|
|
Prepare;
|
|
Printer.BeginDoc;
|
|
try
|
|
Execute(Printer.Canvas);
|
|
finally
|
|
Printer.EndDoc;
|
|
end;
|
|
end;
|
|
|
|
{ Advances first along rows when handling page-breaks. }
|
|
procedure TGridPrinter.PrintByCols(ACanvas: TCanvas);
|
|
var
|
|
vertPage, horPage: Integer;
|
|
col1, col2: Integer;
|
|
row1, row2, row: Integer;
|
|
firstPrintPage, lastPrintPage: Integer;
|
|
printThisPage: Boolean;
|
|
begin
|
|
firstPrintPage := IfThen((FFromPage < 1) or (FFromPage > FPageCount), 1, FFromPage);
|
|
lastPrintPage := IfThen((FToPage < 1) or (FToPage > FPageCount), FPageCount, FToPage);
|
|
|
|
SelectFont(ACanvas, FGrid.Font, FPrintScaleFactor);
|
|
FPageNumber := 1;
|
|
|
|
for horPage := 0 to High(FPageBreakCols) do
|
|
begin
|
|
col1 := FPageBreakCols[horPage];
|
|
if horPage < High(FPageBreakCols) then
|
|
col2 := FPageBreakCols[horPage+1] - 1
|
|
else
|
|
col2 := FColCount-1;
|
|
|
|
for vertPage := 0 to High(FPageBreakRows) do
|
|
begin
|
|
row1 := FPageBreakRows[vertPage];
|
|
if vertPage < High(FPageBreakRows) then
|
|
row2 := FPageBreakRows[vertPage+1] - 1
|
|
else
|
|
row2 := FRowCount-1;
|
|
// Print page beginning at col1/row1
|
|
case FOutputDevice of
|
|
odPrinter: // Render all requested pages
|
|
printThisPage := (FPageNumber >= firstPrintPage) and (FPageNumber <= lastPrintPage);
|
|
odPreview: // Preview can render only a single page
|
|
printThisPage := (FPageNumber = FPreviewPage);
|
|
else
|
|
raise Exception.Create('[TGridPrinter.PrintByCols] Unknown output device.');
|
|
end;
|
|
DoNewPage(col1, row1, col2, row2);
|
|
if printThisPage then
|
|
PrintPage(ACanvas, col1, row1, col2, row2)
|
|
else
|
|
for row := row1 to row2 do
|
|
DoLinePrinted(row, col2);
|
|
inc(FPageNumber);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ Advances first along columns when handling page-breaks. }
|
|
procedure TGridPrinter.PrintByRows(ACanvas: TCanvas);
|
|
var
|
|
vertPage, horPage: Integer;
|
|
col1, col2: Integer;
|
|
row1, row2, row: Integer;
|
|
firstPrintPage, lastPrintPage: Integer;
|
|
printThisPage: Boolean;
|
|
begin
|
|
firstPrintPage := IfThen((FFromPage < 1) or (FFromPage > FPageCount), 1, FFromPage);
|
|
lastPrintPage := IfThen((FToPage < 1) or (FToPage > FPageCount), FPageCount, FToPage);
|
|
|
|
SelectFont(ACanvas, FGrid.Font, FPrintScaleFactor);
|
|
FPageNumber := 1;
|
|
|
|
for vertPage := 0 to High(FPageBreakRows) do
|
|
begin
|
|
row1 := FPageBreakRows[vertPage];
|
|
if vertPage < High(FPageBreakRows) then
|
|
row2 := FPageBreakRows[vertPage+1] - 1
|
|
else
|
|
row2 := FRowCount-1;
|
|
|
|
for horPage := 0 to High(FPageBreakCols) do
|
|
begin
|
|
col1 := FPageBreakCols[horPage];
|
|
if horPage < High(FPageBreakCols) then
|
|
col2 := FPageBreakCols[horPage+1] - 1
|
|
else
|
|
col2 := FColCount-1;
|
|
// Print the page beginning at col1/row1
|
|
case FOutputDevice of
|
|
odPrinter: // Render all requested pages
|
|
printThisPage := (FPageNumber >= firstPrintPage) and (FPageNumber <= lastPrintPage);
|
|
odPreview: // Preview can render only a single page
|
|
printThisPage := (FPageNumber = FPreviewPage);
|
|
else
|
|
raise Exception.Create('[TGridPrinter.PrintByRows] Unknown output device.');
|
|
end;
|
|
DoNewPage(col1, row1, col2, row2);
|
|
if printThisPage then
|
|
PrintPage(ACanvas, col1, row1, col2, row2)
|
|
else
|
|
for row := row1 to row2 do
|
|
DoLinePrinted(row, col2);
|
|
inc(FPageNumber);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
{ Prints the cell at ACol/ARow. The cell will appear in the given rectangle. }
|
|
procedure TGridPrinter.PrintCell(ACanvas: TCanvas; ACol, ARow: Integer;
|
|
ARect: TRect);
|
|
var
|
|
s: String;
|
|
col: TGridColumn;
|
|
lGrid: TGridAccess;
|
|
checkedState: TCheckboxState;
|
|
done: Boolean = false;
|
|
begin
|
|
DoPrintCell(ACanvas, ACol, ARow, ARect, done);
|
|
if done then
|
|
exit;
|
|
|
|
lGrid := TGridAccess(FGrid);
|
|
|
|
PrepareCanvas(ACanvas, ACol, ARow);
|
|
if not FMonochrome then
|
|
ACanvas.FillRect(ARect);
|
|
|
|
s := GetCellText(ACol, ARow);
|
|
InflateRect(ARect, -FPadding, 0);
|
|
|
|
// Handle checkbox columns
|
|
if lGrid.Columns.Enabled and (ACol >= FFixedCols) and (ARow >= FFixedRows) then
|
|
begin
|
|
col := lGrid.Columns[ACol - FFixedCols];
|
|
if col.Buttonstyle = cbsCheckboxColumn
|
|
then begin
|
|
if s = col.ValueChecked then
|
|
checkedState := cbChecked
|
|
else
|
|
if s = col.ValueUnChecked then
|
|
checkedState := cbUnchecked
|
|
else
|
|
checkedState := cbGrayed;
|
|
PrintCheckbox(ACanvas, ACol, ARow, ARect, checkedState);
|
|
exit;
|
|
end;
|
|
end;
|
|
|
|
// Normal text output
|
|
ACanvas.TextRect(ARect, ARect.Left, ARect.Top, s);
|
|
end;
|
|
|
|
procedure TGridPrinter.PrintCheckbox(ACanvas: TCanvas; ACol, ARow: Integer;
|
|
ARect: TRect; ACheckState: TCheckboxstate);
|
|
const
|
|
arrtb:array[TCheckboxState] of TThemedButton =
|
|
(tbCheckBoxUncheckedNormal, tbCheckBoxCheckedNormal, tbCheckBoxMixedNormal);
|
|
var
|
|
details: TThemedElementDetails;
|
|
cSize: TSize;
|
|
R: TRect;
|
|
P: Array[0..2] of TPoint;
|
|
begin
|
|
// Determine size of checkbox
|
|
details := ThemeServices.GetElementDetails(arrtb[ACheckState]);
|
|
{$IF LCL_FullVersion >= 2030000}
|
|
cSize := ThemeServices.GetDetailSizeForPPI(Details, ScreenInfo.PixelsPerInchX);
|
|
{$ELSE}
|
|
cSize := ThemeServices.GetDetailSize(Details);
|
|
{$IFEND}
|
|
cSize.cx := {%H-}ScaleX(cSize.cx);
|
|
cSize.cy := {%H-}ScaleY(cSize.cy);
|
|
// Position the checkbox within the given rectangle, ARect.
|
|
case ACanvas.TextStyle.Alignment of
|
|
taLeftJustify: R.Left := ARect.Left + FPadding;
|
|
taCenter: R.Left := (ARect.Left + ARect.Right - cSize.cx) div 2;
|
|
taRightJustify: R.Left := ARect.Right - cSize.cx - FPadding;
|
|
end;
|
|
case ACanvas.TextStyle.Layout of
|
|
tlTop: R.Top := ARect.Top + FPadding;
|
|
tlCenter: R.Top := (ARect.Top + ARect.Bottom - cSize.cy) div 2;
|
|
tlBottom: R.Top := ARect.Bottom - cSize.cy - FPadding;
|
|
end;
|
|
R.BottomRight := Point(R.Left + cSize.cx, R.Top + cSize.cy);
|
|
// Prepare pen and brush
|
|
ACanvas.Pen.Width := ScaleX(1){%H-};
|
|
ACanvas.Pen.Color := clBlack;
|
|
ACanvas.Pen.Style := psSolid;
|
|
if ACheckState = cbGrayed then
|
|
ACanvas.Brush.Color := clSilver
|
|
else
|
|
ACanvas.Brush.Color := clWhite;
|
|
ACanvas.Brush.Style := bsSolid;
|
|
// Draw checkbox border (= unchecked state)
|
|
InflateRect(R, -ACanvas.Pen.Width div 2, -ACanvas.Pen.Width div 2);
|
|
ACanvas.Rectangle(R);
|
|
InflateRect(R, -ACanvas.Pen.Width div 2, -ACanvas.Pen.Width div 2);
|
|
// Draw checkmark if checked or grayed
|
|
if ACheckState in [cbChecked, cbGrayed] then
|
|
begin
|
|
if ACheckState = cbGrayed then ACanvas.Pen.Color := clGray;
|
|
ACanvas.Pen.Width := ScaleX(2){%H-};
|
|
P[0] := Point(R.Left + cSize.cx div 6, R.Top + cSize.cy div 2);
|
|
P[1] := Point(R.Left + cSize.cx div 3, R.Bottom - cSize.cy div 6);
|
|
P[2] := Point(R.Right - cSize.cx div 6, R.Top + cSize.cy div 6);
|
|
ACanvas.PolyLine(P);
|
|
end;
|
|
end;
|
|
|
|
{ Prints the column headers: at first the fixed column headers, then the
|
|
headers between ACol1 and ACol2. }
|
|
procedure TGridPrinter.PrintColHeaders(ACanvas: TCanvas; ACol1, ACol2, Y: Integer);
|
|
var
|
|
R: TRect;
|
|
col, row: Integer;
|
|
x, x2, y1, y2: Double;
|
|
fixedColsLeft: Integer = 0;
|
|
fixedColsRight: Integer = 0;
|
|
begin
|
|
CalcFixedColPos(ACol1, ACol2, fixedColsLeft, fixedColsRight);
|
|
x := fixedColsLeft;
|
|
y1 := Y;
|
|
for row := 0 to FFixedRows-1 do
|
|
begin
|
|
y2 := Y + FRowHeights[row];
|
|
for col := 0 to FFixedCols-1 do
|
|
begin
|
|
x2 := x + FColWidths[col];
|
|
R := Rect(round(x), round(y1), round(x2), round(y2));
|
|
PrintCell(ACanvas, col, row, R);
|
|
x := x2;
|
|
end;
|
|
for col := ACol1 to ACol2 do
|
|
begin
|
|
x2 := x + FColWidths[col];
|
|
R := Rect(round(x), round(y1), round(x2), round(y2));
|
|
PrintCell(ACanvas, col, row, R);
|
|
x := x2;
|
|
end;
|
|
y1 := y2;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.PrintFooter(ACanvas: TCanvas);
|
|
begin
|
|
PrintHeaderFooter(ACanvas, FFooter);
|
|
end;
|
|
|
|
procedure TGridPrinter.PrintGridLines(ACanvas: TCanvas;
|
|
AStartCol, AStartRow, AEndCol, AEndRow, XEnd, YEnd: Integer);
|
|
var
|
|
x, y: Double;
|
|
xr, yr: Integer; // x, y rounded to integer
|
|
col, row: Integer;
|
|
lGrid: TGridAccess;
|
|
fixedColsLeft: Integer = 0;
|
|
fixedColsRight: Integer = 0;
|
|
fixedRowsTop: Integer = 0;
|
|
fixedRowsBottom: Integer = 0;
|
|
begin
|
|
lGrid := TGridAccess(FGrid);
|
|
CalcFixedColPos(AStartCol, AEndCol, fixedColsLeft, fixedColsRight);
|
|
CalcFixedRowPos(AStartRow, AEndRow, fixedRowsTop, fixedRowsBottom);
|
|
|
|
// Print inner grid lines
|
|
ACanvas.Pen.EndCap := pecFlat;
|
|
ACanvas.Pen.Style := lGrid.GridLineStyle;
|
|
ACanvas.Pen.Color := GetPenColor(IfThen(FGridLineColor = clDefault, lGrid.GridLineColor, FGridLineColor));
|
|
// ... vertical fixed cell lines
|
|
if (goFixedVertLine in lGrid.Options) and (gpoFixedVertGridLines in FOptions) then
|
|
begin
|
|
ACanvas.Pen.Width := GetGridLineWidthVert;
|
|
col := 1;
|
|
x := fixedColsLeft;
|
|
while col < lGrid.FixedCols do
|
|
begin
|
|
x := x + FColWidths[col-1];
|
|
xr := round(x);
|
|
ACanvas.Line(xr, fixedRowsTop, xr, YEnd);
|
|
inc(col);
|
|
end;
|
|
col := AStartCol;
|
|
x := fixedColsRight;
|
|
xr := round(x);
|
|
while (xr < XEnd) and (col < lGrid.ColCount) do
|
|
begin
|
|
x := x + FColWidths[col];
|
|
xr := round(x);
|
|
ACanvas.Line(xr, fixedRowsTop, xr, fixedRowsBottom);
|
|
inc(col);
|
|
end;
|
|
end;
|
|
// ... vertical grid lines
|
|
if (goVertLine in lGrid.Options) and (gpoVertGridLines in FOptions) then
|
|
begin
|
|
ACanvas.Pen.Width := GetGridLineWidthVert;
|
|
col := AStartCol;
|
|
x := fixedColsRight;
|
|
xr := round(x);
|
|
while (xr < XEnd) and (col < FColCount) do
|
|
begin
|
|
x := x + FColWidths[col];
|
|
xr := round(x);
|
|
ACanvas.Line(xr, fixedRowsBottom, xr, YEnd);
|
|
inc(col);
|
|
end;
|
|
end;
|
|
// ... horizontal fixed cell lines
|
|
if (goFixedHorzLine in lGrid.Options) and (gpoFixedHorGridLines in FOptions) then
|
|
begin
|
|
ACanvas.Pen.Width := GetGridLineWidthHor;
|
|
row := 1;
|
|
y := fixedRowsTop;
|
|
yr := round(y);
|
|
while row < lGrid.FixedRows do
|
|
begin
|
|
y := y + FRowHeights[row];
|
|
yr := round(y);
|
|
ACanvas.Line(fixedColsLeft, yr, XEnd, yr);
|
|
inc(row);
|
|
end;
|
|
row := AStartRow;
|
|
y := fixedRowsBottom;
|
|
yr := round(y);
|
|
while (yr < YEnd) and (row < FRowCount) do
|
|
begin
|
|
y := y + FRowHeights[row];
|
|
yr := round(y);
|
|
ACanvas.Line(fixedColsLeft, yr, fixedColsRight, yr);
|
|
inc(row);
|
|
end;
|
|
end;
|
|
// ... horizontal grid lines
|
|
if (goHorzLine in lGrid.Options) and (gpoHorGridLines in FOptions) then
|
|
begin
|
|
ACanvas.Pen.Width := GetGridLineWidthHor;
|
|
row := AStartRow;
|
|
y := fixedRowsBottom;
|
|
yr := round(y);
|
|
while (yr < YEnd) and (row < FRowCount) do
|
|
begin
|
|
y := y + FRowHeights[row];
|
|
yr := round(y);
|
|
ACanvas.Line(fixedColsRight, yr, XEnd, yR);
|
|
inc(row);
|
|
end;
|
|
end;
|
|
|
|
// Print header border lines between fixed and normal cells
|
|
// ... horizontal
|
|
if gpoHeaderBorderLines in FOptions then
|
|
begin
|
|
ACanvas.Pen.Style := psSolid;
|
|
ACanvas.Pen.Color := GetPenColor(FFixedLineColor);
|
|
ACanvas.Pen.Width := GetFixedLineWidthHor;
|
|
ACanvas.Line(fixedColsLeft, fixedRowsBottom, XEnd, fixedRowsBottom);
|
|
// ... vertical
|
|
ACanvas.Pen.Width := GetFixedLineWidthVert;
|
|
ACanvas.Line(fixedColsRight, fixedRowsTop, fixedColsRight, YEnd);
|
|
end;
|
|
|
|
if gpoOuterBorderLines in FOptions then
|
|
begin
|
|
// Print outer border lines
|
|
ACanvas.Pen.EndCap := pecRound;
|
|
ACanvas.Pen.Style := psSolid;
|
|
ACanvas.Pen.Color := GetPenColor(FBorderLineColor);
|
|
// ... horizontal
|
|
ACanvas.Pen.Width := GetBorderLineWidthHor;
|
|
ACanvas.Line(fixedColsLeft, fixedRowsTop, XEnd, fixedRowsTop);
|
|
ACanvas.Line(fixedColsLeft, YEnd, XEnd, YEnd);
|
|
// ... vertical
|
|
ACanvas.Pen.Width := GetBorderLineWidthVert;
|
|
ACanvas.Line(fixedColsLeft, fixedRowsTop, fixedColsLeft, YEnd);
|
|
ACanvas.Line(XEnd, fixedRowsTop, XEnd, YEnd);
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.PrintHeader(ACanvas: TCanvas);
|
|
begin
|
|
PrintHeaderFooter(ACanvas, FHeader);
|
|
end;
|
|
|
|
procedure TGridPrinter.PrintHeaderFooter(ACanvas: TCanvas;
|
|
HF: TGridPrnHeaderFooter);
|
|
var
|
|
Widths: array[TGridPrnHeaderFooterSection] of Integer = (0, 0, 0);
|
|
Heights: array[TGridPrnHeaderFooterSection] of Integer = (0, 0, 0);
|
|
Flags: array[TGridPrnHeaderFooterSection] of Integer;
|
|
TextRects: array[TGridPrnHeaderFooterSection] of TRect;
|
|
printableWidth: Integer;
|
|
hfs: TGridPrnHeaderFooterSection;
|
|
y: Integer;
|
|
s: String;
|
|
begin
|
|
if not HF.IsShown then
|
|
exit;
|
|
|
|
SelectFont(ACanvas, HF.Font, 1.0);
|
|
ACanvas.Font.Color := GetFontColor(HF.Font.Color);
|
|
printableWidth := FPageRect.Width;
|
|
if (HF.SectionText[hfsLeft] <> '') and (HF.SectionText[hfsCenter] = '') and (HF.SectionText[hfsRight] = '') then
|
|
Widths[hfsLeft] := printableWidth
|
|
else
|
|
if (HF.SectionText[hfsLeft] = '') and (HF.SectionText[hfsCenter] <> '') and (HF.SectionText[hfsRight] = '') then
|
|
Widths[hfsCenter] := printableWidth
|
|
else
|
|
if (HF.SectionText[hfsLeft] <> '') and (HF.SectionText[hfsCenter] = '') and (HF.SectionText[hfsRight] <> '') then
|
|
begin
|
|
Widths[hfsLeft] := printableWidth div 2;
|
|
Widths[hfsRight] := printableWidth div 2;
|
|
end else
|
|
if (HF.SectionText[hfsLeft] = '') and (HF.SectionText[hfsCenter] = '') and (HF.SectionText[hfsRight] <> '') then
|
|
Widths[hfsRight] := printableWidth
|
|
else begin
|
|
for hfs in TGridPrnHeaderFooterSection do
|
|
Widths[hfs] := printableWidth div 3;
|
|
end;
|
|
|
|
// Measure sections
|
|
if HF.SectionText[hfsLeft] <> '' then
|
|
begin
|
|
s := HF.ProcessedText[hfsLeft];
|
|
TextRects[hfsLeft] := Rect(0, 0, Widths[hfsLeft], 0);
|
|
Flags[hfsLeft] := DT_LEFT or DT_TOP or DT_WORDBREAK;
|
|
DrawText(ACanvas.Handle, PChar(s), Length(s), TextRects[hfsLeft], Flags[hfsLeft] or DT_CALCRECT);
|
|
Heights[hfsLeft] := TextRects[hfsLeft].Bottom;
|
|
end;
|
|
|
|
if HF.SectionText[hfsCenter] <> '' then
|
|
begin
|
|
s := HF.ProcessedText[hfsCenter];
|
|
TextRects[hfsCenter] := Rect(0, 0, Widths[hfsCenter], 0);
|
|
Flags[hfsCenter] := DT_CENTER or DT_TOP or DT_WORDBREAK;
|
|
DrawText(ACanvas.Handle, PChar(s), Length(s), TextRects[hfsCenter], Flags[hfsCenter] or DT_CALCRECT);
|
|
Heights[hfsCenter] := TextRects[hfsCenter].Bottom;
|
|
end;
|
|
|
|
if HF.SectionText[hfsRight] <> '' then
|
|
begin
|
|
s := HF.ProcessedText[hfsRight];
|
|
TextRects[hfsRight] := Rect(0, 0, Widths[hfsRight], 0);
|
|
Flags[hfsRight] := DT_RIGHT or DT_TOP or DT_WORDBREAK;
|
|
DrawText(ACanvas.Handle, PChar(s), Length(s), TextRects[hfsRight], Flags[hfsRight] or DT_CALCRECT);
|
|
Heights[hfsRight] := TextRects[hfsRight].Bottom;
|
|
end;
|
|
|
|
if HF = FHeader then
|
|
y := FHeaderMargin
|
|
else
|
|
y := FPageHeight - FFooterMargin - MaxValue(Heights);
|
|
|
|
// Prepare print rect
|
|
OffsetRect(TextRects[hfsLeft], FLeftMargin, y);
|
|
OffsetRect(TextRects[hfsCenter], (FPageRect.Left + FPageRect.Right - TextRects[hfsCenter].Right) div 2, y);
|
|
OffsetRect(TextRects[hfsRight], FPageRect.Right - TextRects[hfsRight].Width, y);
|
|
|
|
// Print header/footer text
|
|
for hfs in TGridPrnHeaderFooterSection do
|
|
if HF.SectionText[hfs] <> '' then
|
|
begin
|
|
s := HF.ProcessedText[hfs];
|
|
DrawText(ACanvas.Handle, PChar(s), Length(s), TextRects[hfs], Flags[hfs]);
|
|
end;
|
|
|
|
// Draw header/footer line
|
|
if FHeader.ShowLine then
|
|
begin
|
|
ACanvas.Pen.Color := FHeader.RealLineColor;
|
|
ACanvas.Pen.Width := FHeader.RealLineWidth;
|
|
ACanvas.Pen.Style := psSolid;
|
|
if HF = FHeader then
|
|
inc(y, {%H-}MaxValue(Heights) + (ACanvas.Pen.Width+1) div 2)
|
|
else
|
|
dec(y, (ACanvas.Pen.Width+1) div 2);
|
|
ACanvas.Line(FPageRect.Left, y, FPageRect.Right, y);
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.PrintPage(ACanvas: TCanvas;
|
|
AStartCol, AStartRow, AEndCol, AEndRow: Integer);
|
|
var
|
|
x, y: Double;
|
|
x2, y2: Double;
|
|
row, col: Integer;
|
|
fixedColsLeft: Integer = 0;
|
|
fixedColsRight: Integer = 0;
|
|
fixedRowsTop: Integer = 0;
|
|
fixedRowsBottom: Integer = 0;
|
|
lastPagePrinted: Boolean;
|
|
R: TRect;
|
|
begin
|
|
CalcFixedColPos(AStartCol, AEndCol, fixedColsLeft, fixedColsRight);
|
|
CalcFixedRowPos(AStartRow, AEndRow, fixedRowsTop, fixedRowsBottom);
|
|
|
|
// Print column headers
|
|
PrintColHeaders(ACanvas, AStartCol, AEndCol, fixedRowsTop);
|
|
|
|
// Print grid cells
|
|
y := fixedRowsBottom;
|
|
for row := AStartRow to AEndRow do
|
|
begin
|
|
DoNewLine(row);
|
|
y2 := y + FRowHeights[row];
|
|
PrintRowHeader(ACanvas, row, fixedColsLeft, y);
|
|
x := fixedColsRight;
|
|
for col := AStartCol to AEndCol do
|
|
begin
|
|
x2 := x + FColWidths[col];
|
|
R := Rect(round(x), round(y), round(x2), round(y2));
|
|
PrintCell(ACanvas, col, row, R);
|
|
x := x2;
|
|
end;
|
|
DoLinePrinted(row, AEndCol);
|
|
y := y2;
|
|
end;
|
|
|
|
// Print cell grid lines
|
|
PrintGridLines(ACanvas, AStartCol, AStartRow, AEndCol, AEndRow, round(x2), round(y2));
|
|
|
|
// Print header and footer
|
|
PrintHeader(ACanvas);
|
|
PrintFooter(ACanvas);
|
|
|
|
// Unless we printed the last cell we must send a pagebreak to the printer.
|
|
lastPagePrinted := (AEndCol = FColCount-1) and (AEndRow = FRowCount-1);
|
|
if not lastPagePrinted then
|
|
NewPage;
|
|
end;
|
|
|
|
{ Prints the row headers of the specified row. Row headers are the cells in the
|
|
FixedCols of that row. The row is positioned at the given y coordinate on
|
|
the canvas. X is the position of the left edge of the grid. }
|
|
procedure TGridPrinter.PrintRowHeader(ACanvas: TCanvas; ARow: Integer;
|
|
X, Y: Double);
|
|
var
|
|
R: TRect;
|
|
col: Integer;
|
|
y1, y2: Integer;
|
|
x2: Double;
|
|
begin
|
|
y1 := round(Y); // upper edge of the row
|
|
y2 := round(Y + FRowHeights[ARow]); // lower edge of the row
|
|
for col := 0 to FFixedCols-1 do
|
|
begin
|
|
x2 := X + FColWidths[col];
|
|
R := Rect(round(X), y1, round(x2), y2);
|
|
PrintCell(ACanvas, col, ARow, R);
|
|
X := x2;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.ScaleColWidths(AFactor: Double);
|
|
var
|
|
i: Integer;
|
|
w: Double;
|
|
fixed: Double;
|
|
begin
|
|
fixed := FLeftMargin;
|
|
SetLength(FColWidths, FColCount);
|
|
for i := 0 to FColCount-1 do
|
|
begin
|
|
w := AFactor * TGridAccess(FGrid).ColWidths[i];
|
|
FColWidths[i] := w;
|
|
if i < FFixedCols then
|
|
fixed := fixed + w;
|
|
end;
|
|
FFixedColPos := round(fixed);
|
|
end;
|
|
|
|
procedure TGridPrinter.ScaleRowHeights(AFactor: Double);
|
|
var
|
|
i: Integer;
|
|
h: Double;
|
|
fixed: Double;
|
|
begin
|
|
fixed := FTopMargin;
|
|
SetLength(FRowHeights, FRowCount);
|
|
for i := 0 to FRowCount-1 do
|
|
begin
|
|
h := AFactor * TGridAccess(FGrid).RowHeights[i];
|
|
FRowHeights[i] := h;
|
|
if i < FFixedRows then
|
|
fixed := fixed + h;
|
|
end;
|
|
FFixedRowPos := round(fixed);
|
|
end;
|
|
|
|
procedure TGridPrinter.ScaleToPages(NumHor, NumVert: Integer);
|
|
var
|
|
i: Integer;
|
|
hFixed, wFixed: Double;
|
|
hTotal, wTotal: Double;
|
|
hFactor, wFactor: Double;
|
|
begin
|
|
if (FGrid = nil) or (Printer = nil) or (Printer.Printers.Count = 0) then
|
|
exit;
|
|
|
|
FPrintScaleFactor := 1.0;
|
|
Measure(Printer.PageWidth, Printer.PageHeight, Printer.XDPI, Printer.YDPI);
|
|
|
|
if NumHor > 0 then
|
|
begin
|
|
FPrintScaleToNumHorPages := NumHor;
|
|
wFixed := FFixedColPos - FLeftmargin;
|
|
wTotal := NumHor * wFixed;
|
|
for i := FFixedCols to FColCount-1 do
|
|
wTotal := wTotal + FColWidths[i];
|
|
wFactor := (NumHor * FPageRect.Width) / wTotal;
|
|
end else
|
|
begin
|
|
wFactor := 1.0;
|
|
FPrintScaleToNumHorPages := -1;
|
|
end;
|
|
|
|
if NumVert > 0 then
|
|
begin
|
|
FPrintScaleToNumVertPages := NumVert;
|
|
hFixed := FFixedRowPos - FTopMargin;
|
|
hTotal := NumVert * hFixed;
|
|
for i := FFixedRows to FRowCount-1 do
|
|
hTotal := hTotal + FRowHeights[i];
|
|
hFactor := (NumVert * FPageRect.Height) / hTotal;
|
|
end else
|
|
begin
|
|
hFactor := 1.0;
|
|
FPrintScaleToNumVertPages := -1;
|
|
end;
|
|
|
|
if (NumHor > 0) and (NumVert > 0) then
|
|
FPrintScalingMode := smFitAll
|
|
else if (NumHor > 0) then
|
|
FPrintScalingMode := smFitToWidth
|
|
else if (NumVert > 0) then
|
|
FPrintScalingMode := smFitToHeight
|
|
else
|
|
FPrintScalingMode := smManual;
|
|
|
|
FPrintScaleFactor := Min(wFactor, hFactor);
|
|
|
|
if FPrintScaleFactor > 1.0 then
|
|
FPrintScalefactor := 1.0; // do not magnify
|
|
end;
|
|
|
|
function TGridPrinter.ScaleX(AValue: Integer): Integer;
|
|
begin
|
|
Result := Round(FFactorX * AValue);
|
|
end;
|
|
|
|
function TGridPrinter.ScaleY(AValue: Integer): Integer;
|
|
begin
|
|
Result := Round(FFactorY * AValue);
|
|
end;
|
|
|
|
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);
|
|
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);
|
|
begin
|
|
if FBorderLineColor <> AValue then
|
|
begin
|
|
FBorderLineColor := AValue;
|
|
UpdatePreview;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.SetBorderLineWidth(AValue: Double);
|
|
begin
|
|
if FBorderLineWidth <> AValue then
|
|
begin
|
|
FBorderLineWidth := AValue;
|
|
UpdatePreview;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.SetFileName(AValue: String);
|
|
begin
|
|
if FFileName <> AValue then
|
|
begin
|
|
FFileName := AValue;
|
|
UpdatePreview;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.SetFixedLineColor(AValue: TColor);
|
|
begin
|
|
if FFixedLineColor <> AValue then
|
|
begin
|
|
FFixedLineColor := AValue;
|
|
UpdatePreview;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.SetFixedLineWidth(AValue: Double);
|
|
begin
|
|
if FFixedLineWidth <> AValue then
|
|
begin
|
|
FFixedLineWidth := AValue;
|
|
UpdatePreview;
|
|
end;
|
|
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;
|
|
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;
|
|
|
|
procedure TGridPrinter.SetGridLineColor(AValue: TColor);
|
|
begin
|
|
if FGridLineColor <> AValue then
|
|
begin
|
|
FGridLineColor := AValue;
|
|
UpdatePreview;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.SetGridLineWidth(AValue: Double);
|
|
begin
|
|
if FGridLineWidth <> AValue then
|
|
begin
|
|
FGridLineWidth := AValue;
|
|
UpdatePreview;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.SetOptions(AValue: TGridPrnOptions);
|
|
begin
|
|
if FOptions <> AValue then
|
|
begin
|
|
FOptions := AValue;
|
|
UpdatePreview;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.SetOrientation(AValue: TPrinterOrientation);
|
|
begin
|
|
if GetOrientation <> AValue then
|
|
begin
|
|
Printer.Orientation := AValue;
|
|
UpdatePreview;
|
|
end;
|
|
end;
|
|
|
|
procedure TGridPrinter.UpdatePreview;
|
|
begin
|
|
if FOutputDevice = odPreview then
|
|
DoUpdatePreview;
|
|
end;
|
|
|
|
end.
|
|
|