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

GridPrinter: Improvements in dbgrid printing. New event OnNewLine.

Browse Source 
git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@8634 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
wp_xxyyzz
2022-12-03 00:12:07 +00:00
parent debd0c4b9c
commit 2d4523c259
4 changed files with 154 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

36
components/gridprinter/examples/dbgrid/main.lfm
View File

@ -44,6 +44,35 @@ object Form1: TForm1
OnClick = Button1Click
TabOrder = 0
end
object cbShowTitles: TCheckBox
AnchorSideLeft.Control = Button1
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
Left = 116
Height = 19
Top = 9
Width = 75
BorderSpacing.Around = 6
Caption = 'Show titles'
OnChange = cbShowTitlesChange
TabOrder = 1
end
object cbShowIndicator: TCheckBox
AnchorSideLeft.Control = cbShowTitles
AnchorSideLeft.Side = asrBottom
AnchorSideTop.Control = Panel1
AnchorSideTop.Side = asrCenter
Left = 203
Height = 19
Top = 9
Width = 141
BorderSpacing.Left = 6
BorderSpacing.Around = 6
Caption = 'Show indicator column'
OnChange = cbShowIndicatorChange
TabOrder = 2
end
end
object DataSource1: TDataSource
DataSet = BufDataset1
@ -51,14 +80,17 @@ object Form1: TForm1
Top = 64
end
object GridPrinter1: TGridPrinter
Footer.Font.Height = -11
Header.Font.Height = -11
Footer.FontSize = 0
Header.FontSize = 0
OnBeforePrint = GridPrinter1BeforePrint
OnGetCellText = GridPrinter1GetCellText
OnGetRowCount = GridPrinter1GetRowCount
OnNewLine = GridPrinter1NewLine
Left = 167
Top = 136
end
object GridPrintPreviewDialog1: TGridPrintPreviewDialog
FormParams.PixelsPerInch = 96
GridPrinter = GridPrinter1
Left = 167
Top = 208

116
components/gridprinter/examples/dbgrid/main.pas
View File

@ -15,17 +15,24 @@ type
TForm1 = class(TForm)
BufDataset1: TBufDataset;
Button1: TButton;
cbShowIndicator: TCheckBox;
cbShowTitles: TCheckBox;
DataSource1: TDataSource;
DBGrid1: TDBGrid;
GridPrinter1: TGridPrinter;
GridPrintPreviewDialog1: TGridPrintPreviewDialog;
Panel1: TPanel;
procedure Button1Click(Sender: TObject);
procedure cbShowIndicatorChange(Sender: TObject);
procedure cbShowTitlesChange(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure GridPrinter1BeforePrint(Sender: TObject);
procedure GridPrinter1GetCellText(Sender: TObject; AGrid: TCustomGrid;
ACol, ARow: Integer; var AText: String);
procedure GridPrinter1GetRowCount(Sender: TObject; AGrid: TCustomGrid;
var ARowCount: Integer);
procedure GridPrinter1NewLine(Sender: TObject; AGrid: TCustomGrid;
ARow: Integer);
private
public
@ -55,9 +62,18 @@ begin
BufDataset1.AppendRecord(['Record ' + IntToStr(i), 100*i, Date()-i]);
BufDataset1.First;
// Since the GridPrinter accesses the DBGrid assign it to the Grid property
// only after the Dataset is ready and the DBGrid can display valid data.
// Since the GridPrinter accesses the DBGrid we must assign it to the Grid
// property only after the Dataset is ready and the DBGrid is able to display
// valid data.
GridPrinter1.Grid := DBGrid1;
cbShowTitles.Checked := dgTitles in DBGrid1.Options;
cbShowIndicator.Checked := dgIndicator in DBGrid1.Options;
end;
procedure TForm1.GridPrinter1BeforePrint(Sender: TObject);
begin
BufDataset1.First;
end;
procedure TForm1.Button1Click(Sender: TObject);
@ -83,32 +99,94 @@ begin
end;
end;
procedure TForm1.cbShowIndicatorChange(Sender: TObject);
begin
if cbShowIndicator.Checked then
DBGrid1.Options := DBGrid1.Options + [dgIndicator]
else
DBGrid1.Options := DBGrid1.Options - [dgIndicator];
end;
procedure TForm1.cbShowTitlesChange(Sender: TObject);
begin
if cbShowTitles.Checked then
DBGrid1.Options := DBGrid1.Options + [dgTitles]
else
DBGrid1.Options := DBGrid1.Options - [dgTitles];
end;
{ The OnGetCellText event fires whenever the printer needs the cell text from
the givel col/row. We don't care about row here because the dataset record
for this row has been selected already in the OnNewLine event.
As for the col, we use the field from the DBGrid.Columns rather than from the
dataset directly since this accounts for rearranging of the column order in
the grid. The cell text is obtained from this field.
Note that special care must be taken to correct for offsets due to indicator
column and title row. }
procedure TForm1.GridPrinter1GetCellText(Sender: TObject; AGrid: TCustomGrid;
ACol, ARow: Integer; var AText: String);
var
field: TField;
dbGrid: TDBGrid;
col: TColumn;
colOffs: Integer;
begin
AText := '';
dbGrid := AGrid as TDBGrid;
if (dgIndicator in dbGrid.Options) then
colOffs := 1
else
colOffs := 0;
if ACol < colOffs then
exit;
col := dbGrid.Columns[ACol - colOffs];
if (ARow = 0) and (dgTitles in dbGrid.Options) then
begin
AText := col.FieldName;
exit;
end;
AText := col.Field.AsString;
end;
{ Since the DBGrid does not load all records, but we want to print all
of them, we must tell the printer the real number of rows to print. }
procedure TForm1.GridPrinter1GetRowCount(Sender: TObject; AGrid: TCustomGrid;
var ARowCount: Integer);
var
dbGrid: TDBGrid;
begin
dbGrid := AGrid as TDBGrid;
if ACol >= dbGrid.FixedCols then
begin
// We need something to find the row to be printed and use the dataset's
// RecNo for this purpose which is a number starting at 1.
// BUT BEWARE: RecNo is no good parameter for many dataset types!
BufDataset1.RecNo := ARow;
// Using the field from the DBGrid.Columns rather than from the dataset
// directly accounts for rearranging the column order in the grid.
field := dbGrid.Columns[ACol - dbGrid.FixedCols].Field;
AText := field.AsString;
end;
if dgTitles in dbGrid.Options then
ARowCount := dbGrid.Datasource.Dataset.RecordCount + 1 // we must 1 for the header row
else
ARowCount := dbGrid.Datasource.Dataset.RecordCount;
end;
procedure TForm1.GridPrinter1GetRowCount(Sender: TObject; AGrid: TCustomGrid;
var ARowCount: Integer);
{ The event OnNewLine fires whenever the printer begins printing a new row
of cells. This is when the dataset must move on to the next record. But note
that the records are not necessarily printed in linear order, from first to
last, because of the GridPrinter's PrintOrder setting. Therefore, we need
something to identify the row to be printed in the new line. We use the
dataset's RecNo for this purpose which is a number starting at 1.
BUT BEWARE: RecNo is not a good parameter for many dataset types, usually
only for the standard file-based databases! }
procedure TForm1.GridPrinter1NewLine(Sender: TObject; AGrid: TCustomGrid;
ARow: Integer);
var
dbGrid: TDBGrid;
begin
// Since the DBGrid does not load all records, but we want to print all
// of them, we must tell the printer the real number of rows to print
ARowCount := BufDataset1.RecordCount + 1; // added 1 for the header row
dbGrid := AGrid as TDBGrid;
if dgTitles in dbGrid.Options then
BufDataset1.RecNo := ARow
// RecNo starts at 1. ARow starts at 1, too, since we display the header row
else
BufDataset1.RecNo := ARow + 1;
// We must add 1 to the row index since the header row is hidder here.
end;
end.

15
components/gridprinter/examples/dbgrid2/main.pas
View File

@ -155,18 +155,21 @@ procedure TForm1.GridPrinter1GetCellText(Sender: TObject; AGrid: TCustomGrid;
var
dbGrid: TDBGrid;
col: TColumn;
colOffs: Integer;
begin
AText := '';
dbGrid := AGrid as TDBGrid;
if (dgIndicator in dbGrid.Options) then
begin
if ACol = 0 then
exit;
col := dbGrid.Columns[ACol - 1];
end else
col := dbGrid.Columns[ACol];
colOffs := 1
else
colOffs := 0;
if ACol < colOffs then
exit;
col := dbGrid.Columns[ACol - colOffs];
if (ARow = 0) and (dgTitles in dbGrid.Options) then
begin

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

@ -24,6 +24,9 @@ type
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;
@ -156,6 +159,7 @@ type
FOnGetColCount: TGridPrnGetColCountEvent;
FOnGetRowCount: TGridPrnGetRowCountEvent;
FOnLinePrinted: TGridPrnLinePrintedEvent;
FOnNewLine: TGridPrnNewLineEvent;
FOnNewPage: TGridPrnNewPageEvent;
FOnPrepareCanvas: TOnPrepareCanvasEvent;
FOnPrintCell: TGridPrnPrintCellEvent;
@ -218,6 +222,7 @@ type
procedure CalcFixedColPos(AStartCol, AEndCol: Integer; var ALeft, ARight: Integer);
procedure CalcFixedRowPos(AStartRow, AEndRow: Integer; var ATop, ABottom: Integer);
procedure DoLinePrinted(ARow, ALastCol: Integer); 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;
@ -303,6 +308,7 @@ type
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 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;
@ -740,6 +746,12 @@ begin
FOnLinePrinted(Self, FGrid, ARow, ALastCol);
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
@ -852,7 +864,7 @@ begin
exit;
lGrid := TGridAccess(FGrid);
if lGrid.Columns.Enabled and (FFixedCols > 0) and (ACol >= FFixedCols) and (ARow = 0) then
if lGrid.Columns.Enabled and (FFixedCols > 0) and (ACol >= FFixedCols) and (ARow = 0) and (FFixedRows > 0) then
begin
col := lGrid.Columns[ACol - FFixedCols];
Result := col.Title.Caption;
@ -1700,6 +1712,7 @@ begin
y := fixedRowsBottom;
for row := AStartRow to AEndRow do
begin
DoNewLine(row);
y2 := y + FRowHeights[row];
PrintRowHeader(ACanvas, row, fixedColsLeft, y);
x := fixedColsRight;