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

unit main;

{$mode objfpc}{$H+}

interface

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

type

  { TForm1 }

  TForm1 = class(TForm)
    BufDataset1: TBufDataset;
    Button1: TButton;
    cbShowTitles: TCheckBox;
    cbShowIndicator: 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 GridPrinter1AfterPrint(Sender: TObject);
    procedure GridPrinter1GetCellText(Sender: TObject; AGrid: TCustomGrid;
      ACol, ARow: Integer; var AText: String);
    procedure GridPrinter1GetRowCount(Sender: TObject; {%H-}AGrid: TCustomGrid;
      var ARowCount: Integer);
    procedure GridPrinter1LinePrinted(Sender: TObject; AGrid: TCustomGrid;
      ARow, ALastCol: Integer);
    procedure GridPrinter1NewPage(Sender: TObject; {%H-}AGrid: TCustomGrid;
      {%H-}APageNo: Integer; AStartCol, AStartRow, AEndCol, AEndRow: Integer);
  private
    FPageStartBookmark: TBookmark;
    FPageStartCol: Integer;
    FPageStartRow: Integer;
    FPageEndCol: Integer;
    FPageEndRow: Integer;

  public

  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

function RandomString(Len: Integer): String;
var
  i: Integer;
begin
  SetLength(Result, Len);
  Result[1] := Char(ord('A') + Random(26));
  for i := 2 to Len do
    Result[i] := Char(ord('a') + Random(26));
end;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
const
  NUM_RECORDS = 100;
var
  i: Integer;
begin
  // Create some dummy dataset
  BufDataset1.FieldDefs.Add('TextField1', ftString, 20);
  BufDataset1.FieldDefs.Add('TextField2', ftString, 15);
  BufDataset1.FieldDefs.Add('IntField', ftInteger);
  BufDataset1.FieldDefs.Add('FloatField', ftFloat);
  BufDataset1.FieldDefs.Add('BoolField', ftBoolean);
  BufDataset1.FieldDefs.Add('DateField', ftDate);
  BufDataset1.FieldDefs.Add('TimeField', ftTime);
  BufDataset1.CreateDataset;
  BufDataset1.Open;
  for i := 1 to NUM_RECORDS do
    BufDataset1.AppendRecord([
      'Record ' + IntToStr(i),
      RandomString(Random(10) + 5),
      100*i,
      0.1*i,
      Boolean(Random(2)),
      Date()-i,
      TTime(Random)
    ]);
  BufDataset1.First;

  (BufDataset1.FieldByName('FloatField') as TFloatField).precision := 4;
  // 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.
  GridPrinter1.Grid := DBGrid1;

  cbShowTitles.Checked := dgTitles in DBGrid1.Options;
  cbShowIndicator.Checked := dgIndicator in DBGrid1.Options;
end;

{ The OnAfterPrint event fires after printing/preview. We use it to free the
  bookmark needed for storing the top record of each page. }
procedure TForm1.GridPrinter1AfterPrint(Sender: TObject);
begin
  BufDataset1.FreeBookmark(FPageStartBookmark);
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 fires whenever a cell is printed and the printer needs to
  know the cell text. }
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);
begin
  BufDataset1.Last;
  BufDataset1.First;
  ARowCount := BufDataset1.RecordCount;
  if dgTitles in TDBGrid(AGrid).Options then
    inc(ARowCount);    // added 1 for the header row
end;

{ The event OnLinePrinted fires when the row with the specified index is
  completely printed. The last printed cell has the index ALastCol.
  The purpose of this event is to advance the dataset cursor to the next
  record for printing. This normally is done by Dataset.Next, except for
  the very last row of each page requiring special treatment - see below. }
procedure TForm1.GridPrinter1LinePrinted(Sender: TObject; AGrid: TCustomGrid;
  ARow, ALastCol: Integer);
begin
  case GridPrinter1.PrintOrder of
    poRowsFirst:
      // When the last row of a "rows first" page has been printed we return
      // to the record of the first line of that page if more pages are following
      // along the row. If we printed the last page of that row we must advance
      // to the next record.
      if (ARow = FPageEndRow) and (ALastCol <> GridPrinter1.ColCount - 1) then
        BufDataset1.GotoBookmark(FPageStartBookmark)
      else
        BufDataset1.Next;
    poColsFirst:
      // When the last row of a "cols first" page has been printed we normally
      // advance to the next record, unless the rows are continued on other
      // pages where we return to the first record of the dataset.
      if (ARow = GridPrinter1.RowCount-1) then
        BufDataset1.First
      else
        BufDataset1.Next;
  end;
end;

{ The event OnNewPage fires when the printer is about to begin a new page.
  The page will contain cells between AStartCol, AStartRow in the top/left corner,
  and AEndCol/AEndRow in the bottom/right corner.
  We are setting a bookmark so that the dataset can return to this record
  in case of page-breaks in "rows-first" print order. }
procedure TForm1.GridPrinter1NewPage(Sender: TObject; AGrid: TCustomGrid;
  APageNo: Integer; AStartCol, AStartRow, AEndCol, AEndRow: Integer);
begin
  FPageStartCol := AStartCol;
  FPageStartRow := AStartRow;
  FPageEndCol := AEndCol;
  FPageEndRow := AEndRow;

  BufDataset1.FreeBookmark(FPageStartBookmark);
  FPageStartBookmark := BufDataset1.GetBookmark;
end;

end.