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

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

@@ -14,6 +14,7 @@ type
{ TMainForm } { TMainForm }
TMainForm = class(TForm) TMainForm = class(TForm)
Bevel1: TBevel;
btnPrint: TButton; btnPrint: TButton;
btnPreview: TButton; btnPreview: TButton;
btnOpenFile: TButton; btnOpenFile: TButton;
@@ -70,6 +71,13 @@ procedure TMainForm.GridPrinter1AfterPrint(Sender: TObject);
begin begin
sWorksheetGrid1.Canvas := FGridCanvas; sWorksheetGrid1.Canvas := FGridCanvas;
varCellPadding := FOldPadding; varCellPadding := FOldPadding;
// Restore drawing of the grid lines by the grid printer.
GridPrinter1.Options := GridPrinter1.Options + [
gpoHorGridLines, gpoVertGridLines,
gpoFixedHorGridLines, gpoFixedVertGridLines,
gpoHeaderBorderLines
];
end; end;
procedure TMainForm.GridPrinter1BeforePrint(Sender: TObject); procedure TMainForm.GridPrinter1BeforePrint(Sender: TObject);
@@ -78,6 +86,15 @@ begin
sWorksheetGrid1.Canvas := GridPrinter1.Canvas; sWorksheetGrid1.Canvas := GridPrinter1.Canvas;
FOldPadding := varCellPadding; FOldPadding := varCellPadding;
FNewPadding := GridPrinter1.Padding - 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; end;
procedure TMainForm.btnPrintClick(Sender: TObject); procedure TMainForm.btnPrintClick(Sender: TObject);

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

@@ -26,9 +26,19 @@ type
TGridPrnHeaderFooterSection = (hfsLeft, hfsCenter, hfsRight); TGridPrnHeaderFooterSection = (hfsLeft, hfsCenter, hfsRight);
TGridPrnOption = (gpoCenterHor, gpoCenterVert); TGridPrnOption = (gpoCenterHor, gpoCenterVert,
gpoHorGridLines, gpoVertGridLines,
gpoFixedHorGridLines, gpoFixedVertGridLines,
gpoHeaderBorderLines, gpoOuterBorderLines
);
TGridPrnOptions = set of TGridPrnOption; TGridPrnOptions = set of TGridPrnOption;
const
DEFAULT_GRIDPRNOPTIONS = [gpoHorGridLines, gpoVertGridLines,
gpoFixedHorGridLines, gpoFixedVertGridLines, gpoHeaderBorderLines,
gpoOuterBorderLines];
type
TGridPrnOrder = (poRowsFirst, poColsFirst); TGridPrnOrder = (poRowsFirst, poColsFirst);
TGridPrnOutputDevice = (odPrinter, odPreview); TGridPrnOutputDevice = (odPrinter, odPreview);
@@ -263,7 +273,7 @@ type
property Header: TGridPrnHeaderFooter read FHeader write FHeader; property Header: TGridPrnHeaderFooter read FHeader write FHeader;
property Margins: TGridPrnMargins read FMargins write FMargins; property Margins: TGridPrnMargins read FMargins write FMargins;
property Monochrome: Boolean read FMonochrome write FMonochrome default false; 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 Orientation: TPrinterOrientation read GetOrientation write SetOrientation stored IsOrientationStored;
property PrintOrder: TGridPrnOrder read FPrintOrder write FPrintOrder default poRowsFirst; property PrintOrder: TGridPrnOrder read FPrintOrder write FPrintOrder default poRowsFirst;
property PrintScaleFactor: Double read FPrintScaleFactor write FPrintScaleFactor stored IsPrintScaleFactorStored; property PrintScaleFactor: Double read FPrintScaleFactor write FPrintScaleFactor stored IsPrintScaleFactorStored;
@@ -603,6 +613,7 @@ begin
FHeader := TGridPrnHeaderFooter.Create(Self); FHeader := TGridPrnHeaderFooter.Create(Self);
FFooter := TGridPrnHeaderFooter.Create(Self); FFooter := TGridPrnHeaderFooter.Create(Self);
FOptions := DEFAULT_GRIDPRNOPTIONS;
FPrintOrder := poRowsFirst; FPrintOrder := poRowsFirst;
FPrintScaleFactor := 1.0; FPrintScaleFactor := 1.0;
FPrintScaleToNumHorPages := 1; FPrintScaleToNumHorPages := 1;
@@ -1430,7 +1441,7 @@ begin
ACanvas.Pen.Style := lGrid.GridLineStyle; ACanvas.Pen.Style := lGrid.GridLineStyle;
ACanvas.Pen.Color := GetPenColor(IfThen(FGridLineColor = clDefault, lGrid.GridLineColor, FGridLineColor)); ACanvas.Pen.Color := GetPenColor(IfThen(FGridLineColor = clDefault, lGrid.GridLineColor, FGridLineColor));
// ... vertical fixed cell lines // ... vertical fixed cell lines
if (goFixedVertLine in lGrid.Options) then if (goFixedVertLine in lGrid.Options) and (gpoFixedVertGridLines in FOptions) then
begin begin
ACanvas.Pen.Width := GetGridLineWidthVert; ACanvas.Pen.Width := GetGridLineWidthVert;
col := 1; col := 1;
@@ -1454,7 +1465,7 @@ begin
end; end;
end; end;
// ... vertical grid lines // ... vertical grid lines
if (goVertLine in lGrid.Options) then if (goVertLine in lGrid.Options) and (gpoVertGridLines in FOptions) then
begin begin
ACanvas.Pen.Width := GetGridLineWidthVert; ACanvas.Pen.Width := GetGridLineWidthVert;
col := AStartCol; col := AStartCol;
@@ -1469,7 +1480,7 @@ begin
end; end;
end; end;
// ... horizontal fixed cell lines // ... horizontal fixed cell lines
if (goFixedHorzLine in lGrid.Options) then if (goFixedHorzLine in lGrid.Options) and (gpoFixedHorGridLines in FOptions) then
begin begin
ACanvas.Pen.Width := GetGridLineWidthHor; ACanvas.Pen.Width := GetGridLineWidthHor;
row := 1; row := 1;
@@ -1494,7 +1505,7 @@ begin
end; end;
end; end;
// ... horizontal grid lines // ... horizontal grid lines
if (goHorzLine in lGrid.Options) then if (goHorzLine in lGrid.Options) and (gpoHorGridLines in FOptions) then
begin begin
ACanvas.Pen.Width := GetGridLineWidthHor; ACanvas.Pen.Width := GetGridLineWidthHor;
row := AStartRow; row := AStartRow;
@@ -1511,26 +1522,32 @@ begin
// Print header border lines between fixed and normal cells // Print header border lines between fixed and normal cells
// ... horizontal // ... horizontal
ACanvas.Pen.Style := psSolid; if gpoHeaderBorderLines in FOptions then
ACanvas.Pen.Color := GetPenColor(FFixedLineColor); begin
ACanvas.Pen.Width := GetFixedLineWidthHor; ACanvas.Pen.Style := psSolid;
ACanvas.Line(fixedColsLeft, fixedRowsBottom, XEnd, fixedRowsBottom); ACanvas.Pen.Color := GetPenColor(FFixedLineColor);
// ... vertical ACanvas.Pen.Width := GetFixedLineWidthHor;
ACanvas.Pen.Width := GetFixedLineWidthVert; ACanvas.Line(fixedColsLeft, fixedRowsBottom, XEnd, fixedRowsBottom);
ACanvas.Line(fixedColsRight, fixedRowsTop, fixedColsRight, YEnd); // ... vertical
ACanvas.Pen.Width := GetFixedLineWidthVert;
ACanvas.Line(fixedColsRight, fixedRowsTop, fixedColsRight, YEnd);
end;
// Print outer border lines if gpoOuterBorderLines in FOptions then
ACanvas.Pen.EndCap := pecRound; begin
ACanvas.Pen.Style := psSolid; // Print outer border lines
ACanvas.Pen.Color := GetPenColor(FBorderLineColor); ACanvas.Pen.EndCap := pecRound;
// ... horizontal ACanvas.Pen.Style := psSolid;
ACanvas.Pen.Width := GetBorderLineWidthHor; ACanvas.Pen.Color := GetPenColor(FBorderLineColor);
ACanvas.Line(fixedColsLeft, fixedRowsTop, XEnd, fixedRowsTop); // ... horizontal
ACanvas.Line(fixedColsLeft, YEnd, XEnd, YEnd); ACanvas.Pen.Width := GetBorderLineWidthHor;
// ... vertical ACanvas.Line(fixedColsLeft, fixedRowsTop, XEnd, fixedRowsTop);
ACanvas.Pen.Width := GetBorderLineWidthVert; ACanvas.Line(fixedColsLeft, YEnd, XEnd, YEnd);
ACanvas.Line(fixedColsLeft, fixedRowsTop, fixedColsLeft, YEnd); // ... vertical
ACanvas.Line(XEnd, fixedRowsTop, XEnd, YEnd); ACanvas.Pen.Width := GetBorderLineWidthVert;
ACanvas.Line(fixedColsLeft, fixedRowsTop, fixedColsLeft, YEnd);
ACanvas.Line(XEnd, fixedRowsTop, XEnd, YEnd);
end;
end; end;
procedure TGridPrinter.PrintHeader(ACanvas: TCanvas); procedure TGridPrinter.PrintHeader(ACanvas: TCanvas);