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

GridPrinter: Fix drawing of too-wide grid lines in TsWorksheetGrid preview.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8626 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-11-16 22:41:22 +00:00
parent fcb139c902
commit 3a6f3503fe
3 changed files with 76 additions and 32 deletions
Download Patch File Download Diff File Expand all files Collapse all files

24
components/gridprinter/examples/fpspreadsheet/main.lfm
View File

@ -60,22 +60,24 @@ object MainForm: TMainForm
end
end
object sWorkbookTabControl1: TsWorkbookTabControl
Left = 0
Height = 461
Top = 0
Width = 719
Left = 6
Height = 446
Top = 6
Width = 707
TabPosition = tpBottom
TabIndex = 0
Tabs.Strings = (
'Sheet1'
)
Align = alClient
BorderSpacing.Around = 6
TabOrder = 0
WorkbookSource = sWorkbookSource1
object sWorksheetGrid1: TsWorksheetGrid
Left = 2
Height = 436
Top = 23
Width = 715
Height = 421
Top = 2
Width = 703
FrozenCols = 0
FrozenRows = 0
PageBreakPen.Color = clBlue
@ -89,6 +91,14 @@ object MainForm: TMainForm
TabOrder = 0
end
end
object Bevel1: TBevel
Left = 0
Height = 3
Top = 458
Width = 719
Align = alBottom
Shape = bsBottomLine
end
object GridPrinter1: TGridPrinter
Grid = sWorksheetGrid1
Footer.Font.Height = -11

17
components/gridprinter/examples/fpspreadsheet/main.pas
View File

@ -14,6 +14,7 @@ type
{ TMainForm }
TMainForm = class(TForm)
Bevel1: TBevel;
btnPrint: TButton;
btnPreview: TButton;
btnOpenFile: TButton;
@ -70,6 +71,13 @@ procedure TMainForm.GridPrinter1AfterPrint(Sender: TObject);
begin
sWorksheetGrid1.Canvas := FGridCanvas;
varCellPadding := FOldPadding;
// Restore drawing of the grid lines by the grid printer.
GridPrinter1.Options := GridPrinter1.Options + [
gpoHorGridLines, gpoVertGridLines,
gpoFixedHorGridLines, gpoFixedVertGridLines,
gpoHeaderBorderLines
];
end;
procedure TMainForm.GridPrinter1BeforePrint(Sender: TObject);
@ -78,6 +86,15 @@ begin
sWorksheetGrid1.Canvas := GridPrinter1.Canvas;
FOldPadding := varCellPadding;
FNewPadding := GridPrinter1.Padding - varCellPadding;
// The TsWorksheetGrid paints the grid lines in the DrawCell method. To
// avoid duplicate drawing (which, BTW, is offset by 1 pixel) we turn off
// painting of the grid lines by the grid printer.
GridPrinter1.Options := GridPrinter1.Options - [
gpoHorGridLines, gpoVertGridLines,
gpoFixedHorGridLines, gpoFixedVertGridLines,
gpoHeaderBorderLines
];
end;
procedure TMainForm.btnPrintClick(Sender: TObject);

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

@ -26,9 +26,19 @@ type
TGridPrnHeaderFooterSection = (hfsLeft, hfsCenter, hfsRight);
TGridPrnOption = (gpoCenterHor, gpoCenterVert);
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);
@ -263,7 +273,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 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;
@ -603,6 +613,7 @@ begin
FHeader := TGridPrnHeaderFooter.Create(Self);
FFooter := TGridPrnHeaderFooter.Create(Self);
FOptions := DEFAULT_GRIDPRNOPTIONS;
FPrintOrder := poRowsFirst;
FPrintScaleFactor := 1.0;
FPrintScaleToNumHorPages := 1;
@ -1430,7 +1441,7 @@ begin
ACanvas.Pen.Style := lGrid.GridLineStyle;
ACanvas.Pen.Color := GetPenColor(IfThen(FGridLineColor = clDefault, lGrid.GridLineColor, FGridLineColor));
// ... vertical fixed cell lines
if (goFixedVertLine in lGrid.Options) then
if (goFixedVertLine in lGrid.Options) and (gpoFixedVertGridLines in FOptions) then
begin
ACanvas.Pen.Width := GetGridLineWidthVert;
col := 1;
@ -1454,7 +1465,7 @@ begin
end;
end;
// ... vertical grid lines
if (goVertLine in lGrid.Options) then
if (goVertLine in lGrid.Options) and (gpoVertGridLines in FOptions) then
begin
ACanvas.Pen.Width := GetGridLineWidthVert;
col := AStartCol;
@ -1469,7 +1480,7 @@ begin
end;
end;
// ... horizontal fixed cell lines
if (goFixedHorzLine in lGrid.Options) then
if (goFixedHorzLine in lGrid.Options) and (gpoFixedHorGridLines in FOptions) then
begin
ACanvas.Pen.Width := GetGridLineWidthHor;
row := 1;
@ -1494,7 +1505,7 @@ begin
end;
end;
// ... horizontal grid lines
if (goHorzLine in lGrid.Options) then
if (goHorzLine in lGrid.Options) and (gpoHorGridLines in FOptions) then
begin
ACanvas.Pen.Width := GetGridLineWidthHor;
row := AStartRow;
@ -1511,26 +1522,32 @@ begin
// Print header border lines between fixed and normal cells
// ... horizontal
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);
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;
// 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);
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);