pjstringgrid.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.009                            *)
(*  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 PJStringGrid;

interface

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

type
  TCustomStringGridPrintJob = class(TSpecialTextGridPrintJob)
  private
    { Private declarations }
    FStringGrid: TStringGrid;
    procedure SetStringGrid(const Value: TStringGrid);
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property StringGrid: TStringGrid read FStringGrid write SetStringGrid;
  public
    { Public declarations }
    procedure Update; override;
    function GetColWidth(TheCanvas: TCanvas; ACol: Integer): Integer; override;
    function GetCellText(APageIndex,ACol,ARow: Integer): string; override;
  published
    { Published declarations }
  end;

  TStringGridPrintJob = class(TCustomStringGridPrintJob)
  published
    // TCustomStringGridPrintJob properties
    property StringGrid;
    // TCustomTextGridPrintJob properties
    property HeaderFont;
    property PageFont;
    property FooterFont;
    property ClipMode;
    property Multiline;
    // TCustomGridPrintJob properties
    property RowsPerPage;
    property PagesPerRow;
    property TableBorders;
    property HeaderCellBorders;
    property PageCellBorders;
    property FooterCellBorders;
    property IndexColumn;
    property IndexStart;
    // TCustomGridPrintJob events
    property OnColSubpage;
    // 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;
  end;

procedure Register;

implementation

procedure TCustomStringGridPrintJob.SetStringGrid(const Value: TStringGrid);
begin
  if Value<>FStringGrid then
  begin
    FStringGrid:=Value;
    Update;
  end;
end;

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

procedure TCustomStringGridPrintJob.Update;
begin
  if Assigned(FStringGrid) then
  begin
    ColCount:=FStringGrid.ColCount;
    RowCount:=FStringGrid.RowCount-Integer(joHeader in Options);
  end
  else
  begin
    ColCount:=0;
    RowCount:=0;
  end;
  inherited;
end;

function TCustomStringGridPrintJob.GetColWidth(TheCanvas: TCanvas; ACol: Integer): Integer;
var
  W,CW,C: Integer;
  OldFont: TFont;
  Subpage: Integer;
begin
  if PagesPerRow>1 then Subpage:=GetColSubpage(ACol)
  else Subpage:=0;
  if Assigned(FStringGrid) then
    with FStringGrid,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;
            for C:=0 to Pred(ColCount) do
              if GetColSubpage(C)=Subpage then Inc(CW,ColWidths[C]);
            if ACol<ColCount then Result:=Pred(W*ColWidths[ACol] div CW)
            else Result:=0;
          end;
        finally
          Font.Assign(OldFont);
        end;
      finally
        OldFont.Free;
      end;
    end
  else Result:=100;
end;

function TCustomStringGridPrintJob.GetCellText(APageIndex,ACol,ARow: Integer): string;
begin
  if Assigned(FStringGrid) then
    with FStringGrid do
      if ACol=colIndex then Result:=inherited GetCellText(APageIndex,ACol,ARow)
      else
        case ARow of
          rowHeader: Result:=Cells[ACol,0];
          rowFooter: Result:=inherited GetCellText(APageIndex,ACol,ARow);
        else
        begin
          if joHeader in Self.Options then Inc(ARow);
          Result:=Cells[ACol,ARow];
        end;
        end
  else Result:='';
end;

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

end.