lazarus-ccr/components/gridprinter/examples/dbgrid/main.pas

unit main;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, memds, DB, BufDataset, Forms, Controls, Graphics, Dialogs,
  DBGrids, ExtCtrls, StdCtrls, GridPrn, GridPrnPreviewDlg, Grids;

type

  { TForm1 }

  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

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
var
  i: Integer;
begin
  // Create some dummy dataset
  BufDataset1.FieldDefs.Add('Text', ftString, 20);
  BufDataset1.FieldDefs.Add('Value', ftInteger);
  BufDataset1.FieldDefs.Add('Date', ftDate);
  BufDataset1.CreateDataset;
  BufDataset1.Open;
  for i := 1 to 100 do
    BufDataset1.AppendRecord(['Record ' + IntToStr(i), 100*i, Date()-i]);
  BufDataset1.First;

  // 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
  DBGrid1.DataSource.Dataset.First;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  bm: TBookmark;
begin
  // Store currently active record so that we can return to it after preview/print.
  bm := BufDataset1.GetBookmark;
  try
    // Disable scrolling of grid
    BufDataset1.DisableControls;
    try
      // Show the grid printpreview
      GridPrintPreviewDialog1.Execute;
    finally
      // Allow scrolling again
      BufDataset1.EnableControls;
    end;
    // Return to the stored record position.
    BufDataset1.GotoBookmark(bm);
  finally
    BufDataset1.FreeBookmark(bm);
  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
  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 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;

{ 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
  dbGrid := AGrid as TDBGrid;
  if dgTitles in dbGrid.Options then
    dbGrid.DataSource.Dataset.RecNo := ARow
    // RecNo starts at 1. ARow starts at 1, too, since we display the header row
  else
    dbGrid.Datasource.Dataset.RecNo := ARow + 1;
    // We must add 1 to the row index since the header row is hidder here.
end;

end.