From 058c1adfc77288e33f2b15ebfb9544548a6e577f Mon Sep 17 00:00:00 2001 From: wp_xxyyzz Date: Thu, 10 Nov 2022 23:45:31 +0000 Subject: [PATCH] GridPrinter: Add options to center grid on page horizontally and/or vertically. git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8606 8e941d3f-bd1b-0410-a28a-d453659cc2b4 --- components/gridprinter/source/gridprn.pas | 183 ++++++++++++++++------ 1 file changed, 135 insertions(+), 48 deletions(-) diff --git a/components/gridprinter/source/gridprn.pas b/components/gridprinter/source/gridprn.pas index e5307803a..c895acf2f 100644 --- a/components/gridprinter/source/gridprn.pas +++ b/components/gridprinter/source/gridprn.pas @@ -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