pjdbgrid.pas

GREATIS Print Suite Pro for Delphi (3-7,2005,2006,2007) and C++ Builder (3-6) Set of components for

(*  GREATIS PRINT SUITE PRO                          *)
(*  unit version 1.85.015                            *)
(*  Copyright (C) 2001-2007 Greatis Software         *)
(*  http://www.greatis.com/delphicb/printsuite/      *)
(*  http://www.greatis.com/delphicb/printsuite/faq/  *)
(*  http://www.greatis.com/bteam.html                *)

unit PJDBGrid;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  PSJob, PJGrid, PJTextGrid, Db;

type

  TPrintJobDataLink = class(TDataLink)
  private
    FPrintJob: TCustomPrintJob;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
  public
    constructor Create(APrintJob: TCustomPrintJob);
    destructor Destroy; override;
  end;

  TFieldTextEvent = procedure(Sender: TObject; Field: TField; var Text: string) of object;

  TCustomDBGridPrintJob = class(TSpecialTextGridPrintJob)
  private
    { Private declarations }
    FOnGetFieldText: TFieldTextEvent;
    FDataLink: TDataLink;
    function GetDataSource: TDataSource;
    procedure SetDataSource(const Value: TDataSource);
    function VisibleFieldCount: Integer;
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetField(ACol: Integer): TField;
    property DataSource: TDataSource read GetDataSource write SetDataSource;
    property OnGetFieldText: TFieldTextEvent read FOnGetFieldText write FOnGetFieldText;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Update; override;
    procedure Draw(TheCanvas: TCanvas; PageIndex: Integer; Target: TDrawTarget); override;
    function GetColWidth(TheCanvas: TCanvas; ACol: Integer): Integer; override;
    function GetCellText(APageIndex,ACol,ARow: Integer): string; override;
    function GetCellAlignment(ACol,ARow: Integer): TAlignment; override;
  published
    { Published declarations }
  end;

  TDBGridPrintJob = class(TCustomDBGridPrintJob)
  published
    // TCustomDBGridPrintJob properties
    property DataSource;
    // TCustomTextGridPrintJob properties
    property HeaderFont;
    property PageFont;
    property FooterFont;
    property ClipMode;
    property Multiline;
    // TCustomGridPrintJob properties
    property RowsPerPage;
    property TableBorders;
    property HeaderCellBorders;
    property PageCellBorders;
    property FooterCellBorders;
    property IndexColumn;
    property IndexStart;
    property OnCustomizeCellCanvas;
    // TCustomPrintJob properties
    property MultiDoc;
    property Title;
    property Margins;
    property MarginsUnits;
    property MarginsError;
    property Header;
    property HeaderUnits;
    property Footer;
    property FooterUnits;
    property PageMode;
    property PageWidth;
    property PageHeight;
    property PageUnits;
    property Orientation;
    property Options;
    property RelativeCoords;
    property DefaultDrawing;
    // TCustomPrintJob events
    property OnCreate;
    property OnDestroy;
    property OnDraw;
    property OnPrinterSetupChange;
    property OnStartPrint;
    property OnEndPrint;
    property OnPrintProgress;
    property OnStartPrintPage;
    property OnEndPrintPage;
    property OnUpdate;
    // TCustomDBGridPrintJob events
    property OnGetFieldText;
  end;

procedure Register;

implementation

procedure TPrintJobDataLink.ActiveChanged;
begin
  inherited;
  if Assigned(FPrintJob) then FPrintJob.Update;
end;

procedure TPrintJobDataLink.DataSetChanged;
begin
  inherited;
  if Assigned(FPrintJob) then FPrintJob.Update;
end;

constructor TPrintJobDataLink.Create(APrintJob: TCustomPrintJob);
begin
  inherited Create;
  FPrintJob:=APrintJob;
end;

destructor TPrintJobDataLink.Destroy;
begin
  inherited;
end;

function TCustomDBGridPrintJob.GetDataSource: TDataSource;
begin
  Result:=FDataLink.DataSource;
end;

procedure TCustomDBGridPrintJob.SetDataSource(const Value: TDataSource);
begin
  FDataLink.DataSource:=Value;
  if Assigned(Value) then Update;
end;

function TCustomDBGridPrintJob.GetField(ACol: Integer): TField;
var
  i,C: Integer;
begin
  Result:=nil;
  with FDataLink do
    if Assigned(DataSource) and Assigned(DataSource.DataSet) then
      with DataSource.DataSet do
      begin
        C:=-1;
        for i:=0 to Pred(FieldCount) do
        begin
          if Fields[i].Visible then Inc(C);
          if C=ACol then
          begin
            Result:=Fields[i];
            Break;
          end;
        end;
      end;
end;

function TCustomDBGridPrintJob.VisibleFieldCount: Integer;
var
  i: Integer;
begin
  Result:=0;
  with FDataLink do
    if Assigned(DataSource) and Assigned(DataSource.DataSet) then
      with DataSource.DataSet do
        for i:=0 to Pred(FieldCount) do
          if Fields[i].Visible then Inc(Result);
end;

procedure TCustomDBGridPrintJob.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation=opRemove) and Assigned(FDataLink) and (AComponent=DataSource) then
    DataSource:=nil;
end;

constructor TCustomDBGridPrintJob.Create(AOwner: TComponent);
begin
  inherited;
  FDataLink:=TPrintJobDataLink.Create(Self);
end;

destructor TCustomDBGridPrintJob.Destroy;
begin
  FDataLink.Free;
  FDataLink:=nil;
  inherited;
end;

procedure TCustomDBGridPrintJob.Update;
begin
  if not UpdateLocked then
  begin
    if Assigned(DataSource) and
      Assigned(DataSource.DataSet)
      and DataSource.DataSet.Active then
      with DataSource.DataSet do
      begin
        ColCount:=VisibleFieldCount;
        RowCount:=RecordCount;
      end
      else
      begin
        ColCount:=0;
        RowCount:=0;
      end;
    inherited;
  end;
end;

procedure TCustomDBGridPrintJob.Draw(TheCanvas: TCanvas; PageIndex: Integer; Target: TDrawTarget);
begin
  LockUpdate;
  try
    inherited;
  finally
    UnlockUpdate;
  end;
end;

function TCustomDBGridPrintJob.GetColWidth(TheCanvas: TCanvas; ACol: Integer): Integer;
var
  OldFont: TFont;
  F: TField;
  C,CW,W: Integer;
begin
  if Assigned(DataSource) and Assigned(DataSource.DataSet) then
    with TheCanvas do
    begin
      OldFont:=TFont.Create;
      try
        OldFont.Assign(Font);
        Font.Assign(PageFont);
        try
          if ACol=colIndex then Result:=inherited GetColWidth(TheCanvas,ACol)
          else
          begin
            with GetPageRect do W:=Right-Left;
            if IndexColumn then Dec(W,inherited GetColWidth(TheCanvas,colIndex));
            CW:=0;
            with DataSource.DataSet do
            begin
              for C:=0 to Pred(ColCount) do
              begin
                F:=GetField(C);
                if Assigned(F) then Inc(CW,F.DisplayWidth);
              end;
              F:=GetField(ACol);
              if Assigned(F) then Result:=Pred(W*F.DisplayWidth div CW)
              else Result:=0;
            end;
          end;
        finally
          Font.Assign(OldFont);
        end;
      finally
        OldFont.Free;
      end;
    end
  else Result:=100;
end;

function TCustomDBGridPrintJob.GetCellText(APageIndex,ACol,ARow: Integer): string;
var
  F: TField;
begin
  if ACol=colIndex then Result:=inherited GetCellText(APageIndex,ACol,ARow)
  else
  begin
    F:=GetField(ACol);
    if Assigned(F) then
    begin
      case ARow of
        rowHeader: Result:=F.DisplayLabel;
        rowFooter: Result:=inherited GetCellText(APageIndex,ACol,ARow);
      else
      begin
        if Assigned(DataSource) and
          Assigned(DataSource.DataSet) and
          DataSource.DataSet.Active then
        begin
          {$IFDEF PSNORECNO}
          with DataSource.DataSet do
          begin
            First;
            MoveBy(ARow);
          end;
          {$ELSE}
          DataSource.DataSet.RecNo:=Succ(ARow);
          {$ENDIF}
        end;
        Result:=F.DisplayText;
        if Assigned(FOnGetFieldText) then FOnGetFieldText(Self,F,Result);
      end;
      end;
    end
    else Result:='';
  end;
end;

function TCustomDBGridPrintJob.GetCellAlignment(ACol,ARow: Integer): TAlignment;
var
  F: TField;
begin
  if (ACol=colIndex) or (ARow=rowFooter) then Result:=taRightJustify
  else
  begin
    F:=GetField(ACol);
    if Assigned(F) then Result:=F.Alignment
    else Result:=taLeftJustify;
  end;
end;

procedure Register;
begin
  RegisterComponents('Print Jobs', [TDBGridPrintJob]);
end;

end.