pjgrid.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.014                            *)
(*  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 PJGrid;

interface

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

const
  rowHeader = -MaxInt;
  rowFooter = MaxInt;
  colIndex = -1;

type

  TCellBorder = (cbTop,cbLeft,cbRight,cbBottom);
  TCellBorders = set of TCellBorder;

  TCellType = (ctTable,ctHeader,ctPage,ctFooter);

  TColWidthEvent = procedure (Sender: TObject; TheCanvas: TCanvas; ACol: Integer; var ColWidth: Integer) of object;
  TColSubpageEvent = procedure(Sender: TObject; ACol: Integer; var ColSubpage: Integer) of object;
  TDrawCellEvent = procedure (Sender: TObject; TheCanvas: TCanvas; TheRect: TRect; PageIndex,ACol,ARow: Integer; Target: TDrawTarget) of object;
  TCustomizeCellCanvas = procedure (Sender: TObject; ACol,ARow: Integer; TheCanvas: TCanvas) of object;

  TCustomGridPrintJob = class(TCustomPrintJob)
  private
    { Private declarations }
    FColCount: Integer;
    FRowCount: Integer;
    FRowsPerPage: Integer;
    FPagesPerRow: Integer;
    FTableBorders: TCellBorders;
    FHeaderCellBorders: TCellBorders;
    FPageCellBorders: TCellBorders;
    FFooterCellBorders: TCellBorders;
    FIndexColumn: Boolean;
    FIndexStart: Integer;
    FOnColSubpage: TColSubpageEvent;
    FOnCustomizeCellCanvas: TCustomizeCellCanvas;
    procedure SetColCount(const Value: Integer);
    procedure SetRowCount(const Value: Integer);
    procedure SetRowsPerPage(const Value: Integer);
    procedure SetPagesPerRow(const Value: Integer);
    procedure SetTableBorders(const Value: TCellBorders);
    procedure SetHeaderCellBorders(const Value: TCellBorders);
    procedure SetPageCellBorders(const Value: TCellBorders);
    procedure SetFooterCellBorders(const Value: TCellBorders);
    procedure SetIndexColumn(const Value: Boolean);
    procedure SetIndexStart(const Value: Integer);
    function GetRowTop(R: TRect; PageIndex,Row: Integer): Integer;
  protected
    { Protected declarations }
    property ColCount: Integer read FColCount write SetColCount default 1;
    property RowCount: Integer read FRowCount write SetRowCount default 1;
    property RowsPerPage: Integer read FRowsPerPage write SetRowsPerPage default 1;
    property PagesPerRow: Integer read FPagesPerRow write SetPagesPerRow default 1;
    property TableBorders: TCellBorders read FTableBorders write SetTableBorders default [];
    property HeaderCellBorders: TCellBorders read FHeaderCellBorders write SetHeaderCellBorders default [];
    property PageCellBorders: TCellBorders read FPageCellBorders write SetPageCellBorders default [];
    property FooterCellBorders: TCellBorders read FFooterCellBorders write SetFooterCellBorders default [];
    property IndexColumn: Boolean read FIndexColumn write SetIndexColumn default False;
    property IndexStart: Integer read FIndexStart write SetIndexStart default 0;
    property OnColSubpage: TColSubpageEvent read FOnColSubpage write FOnColSubpage;
    property OnCustomizeCellCanvas: TCustomizeCellCanvas read FOnCustomizeCellCanvas write FOnCustomizeCellCanvas;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    procedure DrawCell(TheCanvas: TCanvas; TheRect: TRect; PageIndex,ACol,ARow: Integer; Target: TDrawTarget); virtual; abstract;
    procedure CustomizeCellCanvas(ACol,ARow: Integer; TheCanvas: TCanvas); virtual;
    procedure DrawBorders(TheCanvas: TCanvas; TheRect: TRect; CellType: TCellType; Target: TDrawTarget); virtual;
    procedure DrawArea(TheCanvas: TCanvas; PageIndex: Integer; TheRect: TRect; Area: TDrawArea; Target: TDrawTarget); override;
    function GetColWidth(TheCanvas: TCanvas; ACol: Integer): Integer; virtual;
    function GetColSubpage(ACol: Integer): Integer; virtual;
  published
    { Published declarations }
  end;

implementation

function TCustomGridPrintJob.GetRowTop(R: TRect; PageIndex,Row: Integer): Integer;
begin
  with R do
    Result:=Pred(Top+(Row-Pred(PageIndex)*FRowsPerPage)*Pred(Bottom-Top) div FRowsPerPage);
end;

procedure TCustomGridPrintJob.SetColCount(const Value: Integer);
var
  I: Integer;
begin
  I:=Value;
  if I<1 then I:=1;
  if I<>FColCount then
  begin
    FColCount:=I;
    Update;
  end;
end;

procedure TCustomGridPrintJob.SetRowCount(const Value: Integer);
var
  I: Integer;
begin
  I:=Value;
  if I<1 then I:=1;
  if I<>FRowCount then
  begin
    FRowCount:=I;
    PageCount:=FPagesPerRow*(FRowCount div FRowsPerPage+
      Integer(FRowCount mod FRowsPerPage > 0));
  end;
end;

procedure TCustomGridPrintJob.SetRowsPerPage(const Value: Integer);
var
  I: Integer;
begin
  I:=Value;
  if I<1 then I:=1;
  if I<>FRowsPerPage then
  begin
    FRowsPerPage:=I;
    LockUpdate;
    try
      PageCount:=FPagesPerRow*(FRowCount div FRowsPerPage+
        Integer(FRowCount mod FRowsPerPage > 0));
    finally
      UnlockUpdate;
    end;
    Update;
  end;
end;

procedure TCustomGridPrintJob.SetPagesPerRow(const Value: Integer);
var
  I: Integer;
begin
  I:=Value;
  if I<1 then I:=1;
  if I<>FPagesPerRow then
  begin
    FPagesPerRow:=I;
    LockUpdate;
    try
      PageCount:=FPagesPerRow*(FRowCount div FRowsPerPage+
        Integer(FRowCount mod FRowsPerPage > 0));
    finally
      UnlockUpdate;
    end;
    Update;
  end;
end;

procedure TCustomGridPrintJob.SetTableBorders(const Value: TCellBorders);
begin
  if Value<>FTableBorders then
  begin
    FTableBorders:=Value;
    Update;
  end;
end;

procedure TCustomGridPrintJob.SetHeaderCellBorders(const Value: TCellBorders);
begin
  if Value<>FHeaderCellBorders then
  begin
    FHeaderCellBorders:=Value;
    Update;
  end;
end;

procedure TCustomGridPrintJob.SetPageCellBorders(const Value: TCellBorders);
begin
  if Value<>FPageCellBorders then
  begin
    FPageCellBorders:=Value;
    Update;
  end;
end;

procedure TCustomGridPrintJob.SetFooterCellBorders(const Value: TCellBorders);
begin
  if Value<>FFooterCellBorders then
  begin
    FFooterCellBorders:=Value;
    Update;
  end;
end;

procedure TCustomGridPrintJob.SetIndexColumn(const Value: Boolean);
begin
  if Value<>FIndexColumn then
  begin
    FIndexColumn:=Value;
    Update;
  end;
end;

procedure TCustomGridPrintJob.SetIndexStart(const Value: Integer);
begin
  if Value<>FIndexStart then
  begin
    FIndexStart:=Value;
    Update;
  end;
end;

procedure TCustomGridPrintJob.CustomizeCellCanvas(ACol,ARow: Integer; TheCanvas: TCanvas);
begin
  if Assigned(FOnCustomizeCellCanvas) then FOnCustomizeCellCanvas(Self,ACol,ARow,TheCanvas);
end;

procedure TCustomGridPrintJob.DrawBorders(TheCanvas: TCanvas; TheRect: TRect;
  CellType: TCellType; Target: TDrawTarget);
var
  Options: TCellBorders;
begin
  case CellType of
    ctTable: Options:=FTableBorders;
    ctHeader: Options:=FHeaderCellBorders;
    ctFooter: Options:=FFooterCellBorders;
  else Options:=FPageCellBorders;
  end;
  with TheCanvas,TheRect do
  begin
    with Pen do
    begin
      Width:=0;
      Color:=clBlack;
      Mode:=pmCopy;
    end;
    if cbTop in Options then
    begin
      MoveTo(Left,Top);
      LineTo(Right,Top);
    end;
    if cbBottom in Options then
    begin
      MoveTo(Left,Bottom);
      LineTo(Right,Bottom);
    end;
    if cbLeft in Options then
    begin
      MoveTo(Left,Top);
      LineTo(Left,Bottom);
    end;
    if cbRight in Options then
    begin
      MoveTo(Right,Top);
      LineTo(Right,Bottom);
    end;
  end;
end;

constructor TCustomGridPrintJob.Create(AOwner: TComponent);
begin
  inherited;
  FColCount:=1;
  FRowCount:=1;
  FRowsPerPage:=1;
  FPagesPerRow:=1;
end;

procedure TCustomGridPrintJob.DrawArea(TheCanvas: TCanvas;
  PageIndex: Integer; TheRect: TRect; Area: TDrawArea; Target: TDrawTarget);
var
  AR: TRect;
  C,R,L,Subpage: Integer;
begin
  if FPagesPerRow>1 then Subpage:=Pred(PageIndex) mod FPagesPerRow
  else Subpage:=0;
  PageIndex:=Succ(Pred(PageIndex) div FPagesPerRow);
  with TheCanvas,TheRect do
  begin
    case Area of
      daHeader:
      begin
        L:=Left;
        if IndexColumn then
        begin
          DrawBorders(
            TheCanvas,
            Rect(L,Top,(L+GetColWidth(TheCanvas,colIndex)),Bottom),
            ctHeader,
            Target);
          Inc(L,GetColWidth(TheCanvas,colIndex));
        end;
        for C:=0 to Pred(FColCount) do
          if GetColSubpage(C)=Subpage then
          begin
            DrawBorders(
              TheCanvas,
              Rect(L,Top,(L+GetColWidth(TheCanvas,C)),Bottom),
              ctHeader,
              Target);
            Inc(L,GetColWidth(TheCanvas,C));
          end;
        L:=Left;
        if IndexColumn then
        begin
          DrawCell(
            TheCanvas,
            Rect(L,Top,(L+GetColWidth(TheCanvas,colIndex)),Bottom),
            PageIndex,colIndex,rowHeader,Target);
          Inc(L,GetColWidth(TheCanvas,colIndex));
        end;
        for C:=0 to Pred(FColCount) do
          if GetColSubpage(C)=Subpage then
          begin
            DrawCell(
              TheCanvas,
              Rect(L,Top,(L+GetColWidth(TheCanvas,C)),Bottom),
              PageIndex,C,rowHeader,Target);
            Inc(L,GetColWidth(TheCanvas,C));
          end;
      end;
      daPage:
      begin
        for R:=Pred(PageIndex)*FRowsPerPage to Pred(PageIndex*FRowsPerPage) do
        begin
          if R>=FRowCount then Break;
          L:=Left;
          if IndexColumn then
          begin
            DrawBorders(
              TheCanvas,
              Rect(
                L,
                GetRowTop(TheRect,PageIndex,R),
                (L+GetColWidth(TheCanvas,colIndex)),
                GetRowTop(TheRect,PageIndex,Succ(R))),
              ctPage,
              Target);
            Inc(L,GetColWidth(TheCanvas,colIndex));
          end;
          for C:=0 to Pred(FColCount) do
            if GetColSubpage(C)=Subpage then
            begin
              DrawBorders(
                TheCanvas,
                Rect(
                  L,
                  GetRowTop(TheRect,PageIndex,R),
                  (L+GetColWidth(TheCanvas,C)),
                  GetRowTop(TheRect,PageIndex,Succ(R))),
                ctPage,
                Target);
              Inc(L,GetColWidth(TheCanvas,C));
            end;
        end;
        for R:=Pred(PageIndex)*FRowsPerPage to Pred(PageIndex*FRowsPerPage) do
        begin
          if R>=FRowCount then Break;
          L:=Left;
          if IndexColumn then
          begin
            DrawCell(
              TheCanvas,
              Rect(
                L,
                GetRowTop(TheRect,PageIndex,R),
                (L+GetColWidth(TheCanvas,colIndex)),
                GetRowTop(TheRect,PageIndex,Succ(R))),
              PageIndex,colIndex,R,Target);
            Inc(L,GetColWidth(TheCanvas,colIndex));
          end;
          for C:=0 to Pred(FColCount) do
            if GetColSubpage(C)=Subpage then
            begin
              DrawCell(
                TheCanvas,
                Rect(
                  L,
                  GetRowTop(TheRect,PageIndex,R),
                  (L+GetColWidth(TheCanvas,C)),
                  GetRowTop(TheRect,PageIndex,Succ(R))),
                PageIndex,C,R,Target);
              Inc(L,GetColWidth(TheCanvas,C));
            end;
        end;
        AR:=GetMarginRect;
        with AR do
        begin
          Right:=Left;
          if IndexColumn then Inc(Right,GetColWidth(TheCanvas,colIndex));
          for C:=0 to Pred(FColCount) do
            Inc(Right,GetColWidth(TheCanvas,C));
          if PageIndex=PageCount then Bottom:=GetRowTop(TheRect,PageIndex,FRowCount);
        end;
        DrawBorders(TheCanvas,AR,ctTable,Target);
      end;
      daFooter:
      begin
        L:=Left;
        if IndexColumn then
        begin
          DrawBorders(
            TheCanvas,
            Rect(L,Top,(L+GetColWidth(TheCanvas,colIndex)),Bottom),
            ctFooter,
            Target);
          Inc(L,GetColWidth(TheCanvas,colIndex));
        end;
        for C:=0 to Pred(FColCount) do
          if GetColSubpage(C)=Subpage then
          begin
            DrawBorders(
              TheCanvas,
              Rect(
                L,
                Top,
                (L+GetColWidth(TheCanvas,C)),
                Bottom),
              ctFooter,
              Target);
            Inc(L,GetColWidth(TheCanvas,C));
          end;
        L:=Left;
        if IndexColumn then
        begin
          DrawCell(
            TheCanvas,
            Rect(L,Top,(L+GetColWidth(TheCanvas,colIndex)),Bottom),
            PageIndex,colIndex,rowFooter,Target);
          Inc(L,GetColWidth(TheCanvas,colIndex));
        end;
        for C:=0 to Pred(FColCount) do
          if GetColSubpage(C)=Subpage then
          begin
            DrawCell(
              TheCanvas,
              Rect(L,Top,(L+GetColWidth(TheCanvas,C)),Bottom),
              PageIndex,C,rowFooter,Target);
            Inc(L,GetColWidth(TheCanvas,C));
          end;
      end;
    end;
  end;
end;

function TCustomGridPrintJob.GetColWidth(TheCanvas: TCanvas; ACol: Integer): Integer;
begin
  with GetMarginRect do Result:=(Right-Left) div ColCount;
end;

function TCustomGridPrintJob.GetColSubpage(ACol: Integer): Integer;
begin
  Result:=0;
  if Assigned(FOnColSubpage) then FOnColSubpage(Self,ACol,Result);
end;

end.