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

GridPrinter: Add options to center grid on page horizontally and/or vertically.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8606 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-11-10 23:45:31 +00:00
parent dd77f6adb4
commit 058c1adfc7
1 changed files with 135 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

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

@ -23,6 +23,9 @@ type
TGridPrnHeaderFooterSection = (hfsLeft, hfsCenter, hfsRight);
TGridPrnOption = (gpoCenterHor, gpoCenterVert);
TGridPrnOptions = set of TGridPrnOption;
TGridPrnOrder = (poRowsFirst, poColsFirst);
TGridPrnOutputDevice = (odPrinter, odPreview);
@ -109,6 +112,7 @@ type
FFooter: TGridPrnHeaderFooter;
FMargins: TGridPrnMargins;
FMonochrome: Boolean;
FOptions: TGridPrnOptions;
FPadding: Integer;
FPageHeight: Integer;
FPageWidth: Integer;
@ -144,6 +148,7 @@ type
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
@ -174,6 +179,8 @@ type
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 DoPrepareCanvas(ACol, ARow: Integer); virtual;
procedure DoUpdatePreview; virtual;
procedure Execute(ACanvas: TCanvas);
@ -191,12 +198,12 @@ type
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: Integer);
procedure PrintColHeaders(ACanvas: TCanvas; ACol1, ACol2, Y: Integer);
procedure PrintFooter(ACanvas: TCanvas);
procedure PrintHeader(ACanvas: TCanvas);
procedure PrintGridLines(ACanvas: TCanvas; AFirstCol, AFirstRow, XEnd, YEnd: Integer);
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; Y: Double);
procedure PrintRowHeader(ACanvas: TCanvas; ARow: Integer; X, Y: Double);
procedure ScaleColWidths(AFactor: Double);
procedure ScaleRowHeights(AFactor: Double);
procedure SelectFont(ACanvas: TCanvas; AFont: TFont);
@ -234,6 +241,7 @@ type
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 [];
property Orientation: TPrinterOrientation read GetOrientation write SetOrientation stored IsOrientationStored;
property PrintOrder: TGridPrnOrder read FPrintOrder write FPrintOrder default poRowsFirst;
property ShowPrintDialog: TGridPrnDialog read FShowPrintDialog write FShowPrintDialog default gpdNone;
@ -565,6 +573,61 @@ begin
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
@ -1179,32 +1242,35 @@ 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: Integer);
procedure TGridPrinter.PrintColHeaders(ACanvas: TCanvas; ACol1, ACol2, Y: Integer);
var
R: TRect;
col, row: Integer;
x, y, x2, y2: Double;
x, x2, y1, y2: Double;
fixedColsLeft: Integer = 0;
fixedColsRight: Integer = 0;
begin
x := FLeftMargin;
y := FTopMargin;
CalcFixedColPos(ACol1, ACol2, fixedColsLeft, fixedColsRight);
x := fixedColsLeft;
y1 := Y;
for row := 0 to FFixedRows-1 do
begin
y2 := FTopMargin + FRowHeights[row];
y2 := Y + FRowHeights[row];
for col := 0 to FFixedCols-1 do
begin
x2 := x + FColWidths[col];
R := Rect(round(x), round(y), round(x2), round(y2));
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(y), round(x2), round(y2));
R := Rect(round(x), round(y1), round(x2), round(y2));
PrintCell(ACanvas, col, row, R);
x := x2;
end;
y := y2;
y1 := y2;
end;
end;
@ -1276,14 +1342,20 @@ begin
end;
procedure TGridPrinter.PrintGridLines(ACanvas: TCanvas;
AFirstCol, AFirstRow, XEnd, YEnd: Integer);
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;
@ -1294,22 +1366,22 @@ begin
begin
ACanvas.Pen.Width := GetGridLineWidthVert;
col := 1;
x := FLeftMargin;
x := fixedColsLeft;
while col < lGrid.FixedCols do
begin
x := x + FColWidths[col-1];
xr := round(x);
ACanvas.Line(xr, FTopMargin, xr, YEnd);
ACanvas.Line(xr, fixedRowsTop, xr, YEnd);
inc(col);
end;
col := AFirstCol;
x := FFixedColPos;
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, FTopMargin, xr, FFixedRowPos);
ACanvas.Line(xr, fixedRowsTop, xr, fixedRowsBottom);
inc(col);
end;
end;
@ -1317,14 +1389,14 @@ begin
if (goVertLine in lGrid.Options) then
begin
ACanvas.Pen.Width := GetGridLineWidthVert;
col := AFirstCol;
x := FFixedColPos;
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, FFixedRowPos, xr, YEnd);
ACanvas.Line(xr, fixedRowsBottom, xr, YEnd);
inc(col);
end;
end;
@ -1333,23 +1405,23 @@ begin
begin
ACanvas.Pen.Width := GetGridLineWidthHor;
row := 1;
y := FTopMargin;
y := fixedRowsTop;
yr := round(y);
while row < lGrid.FixedRows do
begin
y := y + FRowHeights[row];
yr := round(y);
ACanvas.Line(FLeftMargin, yr, XEnd, yr);
ACanvas.Line(fixedColsLeft, yr, XEnd, yr);
inc(row);
end;
row := AFirstRow;
y := FFixedRowPos;
row := AStartRow;
y := fixedRowsBottom;
yr := round(y);
while (yr < YEnd) and (row < FRowCount) do
begin
y := y + FRowHeights[row];
yr := round(y);
ACanvas.Line(FLeftMargin, yr, FFixedColPos, yr);
ACanvas.Line(fixedColsLeft, yr, fixedColsRight, yr);
inc(row);
end;
end;
@ -1357,14 +1429,14 @@ begin
if (goHorzLine in lGrid.Options) then
begin
ACanvas.Pen.Width := GetGridLineWidthHor;
row := AFirstRow;
y := FFixedRowPos;
row := AStartRow;
y := fixedRowsBottom;
yr := round(y);
while (yr < YEnd) and (row < FRowCount) do
begin
y := y + FRowHeights[row];
yr := round(y);
ACanvas.Line(FFixedColPos, yr, XEnd, yr);
ACanvas.Line(fixedColsRight, yr, XEnd, yR);
inc(row);
end;
end;
@ -1374,10 +1446,10 @@ begin
ACanvas.Pen.Style := psSolid;
ACanvas.Pen.Color := GetPenColor(FFixedLineColor);
ACanvas.Pen.Width := GetFixedLineWidthHor;
ACanvas.Line(FLeftMargin, FFixedRowPos, XEnd, FFixedRowPos);
ACanvas.Line(fixedColsLeft, fixedRowsBottom, XEnd, fixedRowsBottom);
// ... vertical
ACanvas.Pen.Width := GetFixedLineWidthVert;
ACanvas.Line(FFixedColPos, FTopMargin, FFixedColPos, YEnd);
ACanvas.Line(fixedColsRight, fixedRowsTop, fixedColsRight, YEnd);
// Print outer border lines
ACanvas.Pen.EndCap := pecRound;
@ -1385,12 +1457,12 @@ begin
ACanvas.Pen.Color := GetPenColor(FBorderLineColor);
// ... horizontal
ACanvas.Pen.Width := GetBorderLineWidthHor;
ACanvas.Line(FLeftMargin, FTopMargin, XEnd, FTopMargin);
ACanvas.Line(FLeftMargin, YEnd, XEnd, YEnd);
ACanvas.Line(fixedColsLeft, fixedRowsTop, XEnd, fixedRowsTop);
ACanvas.Line(fixedColsLeft, YEnd, XEnd, YEnd);
// ... vertical
ACanvas.Pen.Width := GetBorderLineWidthVert;
ACanvas.Line(FLeftMargin, FTopMargin, FLeftMargin, YEnd);
ACanvas.Line(XEnd, FTopMargin, XEnd, YEnd);
ACanvas.Line(fixedColsLeft, fixedRowsTop, fixedColsLeft, YEnd);
ACanvas.Line(XEnd, fixedRowsTop, XEnd, YEnd);
end;
procedure TGridPrinter.PrintHeader(ACanvas: TCanvas);
@ -1466,19 +1538,26 @@ 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);
PrintColHeaders(ACanvas, AStartCol, AEndCol, fixedRowsTop);
// Print grid cells
y := FFixedRowPos;
y := fixedRowsBottom;
for row := AStartRow to AEndRow do
begin
y2 := y + FRowHeights[row];
PrintRowHeader(ACanvas, row, y);
x := FFixedColPos;
PrintRowHeader(ACanvas, row, fixedColsLeft, y);
x := fixedColsRight;
for col := AStartCol to AEndCol do
begin
x2 := x + FColWidths[col];
@ -1490,7 +1569,7 @@ begin
end;
// Print cell grid lines
PrintGridLines(ACanvas, AStartCol, AStartRow, round(x2), round(y2));
PrintGridLines(ACanvas, AStartCol, AStartRow, AEndCol, AEndRow, round(x2), round(y2));
// Print header and footer
PrintHeader(ACanvas);
@ -1504,24 +1583,23 @@ 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. }
the canvas. X is the position of the left edge of the grid. }
procedure TGridPrinter.PrintRowHeader(ACanvas: TCanvas; ARow: Integer;
Y: Double);
X, Y: Double);
var
R: TRect;
col: Integer;
y1, y2: Integer;
x, x2: Double;
x2: Double;
begin
x := FLeftMargin; // left side of the row
y1 := round(Y); // upper end of the row
y2 := round(Y + FRowHeights[ARow]); // lower end of the row
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);
x2 := X + FColWidths[col];
R := Rect(round(X), y1, round(x2), y2);
PrintCell(ACanvas, col, ARow, R);
x := x2;
X := x2;
end;
end;
@ -1662,6 +1740,15 @@ begin
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