pjtextgrid.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.007                            *)
(*  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 PJTextGrid;

interface

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

type

  TClipMode = (cmNone,cmClip,cmEllipsis);

  TCustomTextGridPrintJob = class(TCustomGridPrintJob)
  private
    { Private declarations }
    FHeaderFont: TFont;
    FPageFont: TFont;
    FFooterFont: TFont;
    FClipMode: TClipMode;
    FMultiline: Boolean;
    procedure SetHeaderFont(const Value: TFont);
    procedure SetPageFont(const Value: TFont);
    procedure SetFooterFont(const Value: TFont);
    procedure SetClipMode(const Value: TClipMode);
    procedure SetMultiline(const Value: Boolean);
  protected
    { Protected declarations }
    property HeaderFont: TFont read FHeaderFont write SetHeaderFont;
    property PageFont: TFont read FPageFont write SetPageFont;
    property FooterFont: TFont read FFooterFont write SetFooterFont;
    property ClipMode: TClipMode read FClipMode write SetClipMode default cmEllipsis;
    property Multiline: Boolean read FMultiline write SetMultiline default False;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure DrawCell(TheCanvas: TCanvas; TheRect: TRect; APageIndex,ACol,ARow: Integer; Target: TDrawTarget); override;
    function GetColWidth(TheCanvas: TCanvas; ACol: Integer): Integer; override;
    function GetCellText(APageIndex,ACol,ARow: Integer): string; virtual;
    function GetCellAlignment(ACol,ARow: Integer): TAlignment; virtual;
  published
    { Published declarations }
  end;

  TSpecialTextGridPrintJob = class(TCustomTextGridPrintJob)
  public
    procedure DrawArea(TheCanvas: TCanvas; PageIndex: Integer; TheRect: TRect; Area: TDrawArea; Target: TDrawTarget); override;
  end;

implementation

procedure TCustomTextGridPrintJob.SetHeaderFont(const Value: TFont);
begin
  FHeaderFont.Assign(Value);
  Update;
end;

procedure TCustomTextGridPrintJob.SetPageFont(const Value: TFont);
begin
  FPageFont.Assign(Value);
  Update;
end;

procedure TCustomTextGridPrintJob.SetFooterFont(const Value: TFont);
begin
  FFooterFont.Assign(Value);
  Update;
end;

procedure TCustomTextGridPrintJob.SetClipMode(const Value: TClipMode);
begin
  if Value<>FClipMode then
  begin
    FClipMode:=Value;
    Update;
  end;
end;

procedure TCustomTextGridPrintJob.SetMultiline(const Value: Boolean);
begin
  if Value<>FMultiline then
  begin
    FMultiline:=Value;
    Update;
  end;
end;

constructor TCustomTextGridPrintJob.Create(AOwner: TComponent);
begin
  inherited;
  FHeaderFont:=TFont.Create;
  FPageFont:=TFont.Create;
  FFooterFont:=TFont.Create;
  FClipMode:=cmEllipsis;
  with FHeaderFont do
  begin
    Name:='Arial';
    Size:=12;
  end;
  FPageFont.Assign(FHeaderFont);
  FFooterFont.Assign(FHeaderFont);
end;

destructor TCustomTextGridPrintJob.Destroy;
begin
  FHeaderFont.Free;
  FPageFont.Free;
  FFooterFont.Free;
  inherited;
end;

procedure TCustomTextGridPrintJob.DrawCell(TheCanvas: TCanvas; TheRect: TRect;
  APageIndex,ACol,ARow: Integer; Target: TDrawTarget);
var
  Text: string;
  Flags: Integer;
begin
  Text:=GetCellText(APageIndex,ACol,ARow);
  with TheCanvas do
  begin
    with Font do
      case ARow of
        rowHeader: Font.Assign(FHeaderFont);
        rowFooter: Font.Assign(FFooterFont);
      else Font.Assign(FPageFont);
      end;
    if FMultiline then Flags:=DT_NOPREFIX or DT_WORDBREAK
    else Flags:=DT_NOPREFIX or DT_VCENTER or DT_SINGLELINE;
    case FClipMode of
      cmNone: Flags:=Flags or DT_NOCLIP;
      cmEllipsis: Flags:=Flags or DT_END_ELLIPSIS;
    end;
    case GetCellAlignment(ACol,ARow) of
      taCenter: Flags:=Flags or DT_CENTER;
      taRightJustify: Flags:=Flags or DT_RIGHT;
    end;
    InflateRect(TheRect,-(TextWidth('  ')-1),-1);
    OffsetRect(TheRect,1,1);
    CustomizeCellCanvas(ACol,ARow,TheCanvas);
    DrawText(Handle,PChar(Text),Length(Text),TheRect,Flags);
  end;
end;

function TCustomTextGridPrintJob.GetColWidth(TheCanvas: TCanvas; ACol: Integer): Integer;
begin
  if ACol=colIndex then
    with TheCanvas do Result:=TextWidth('    '+IntToStr(IndexStart+RowCount))+2
    else Result:=0;
end;

function TCustomTextGridPrintJob.GetCellText(APageIndex,ACol,ARow: Integer): string;
begin
  if ACol=colIndex then
    case ARow of
      rowHeader: Result:='#';
      rowFooter: Result:='';
    else Result:=IntToStr(ARow+IndexStart);
    end
  else
    if ACol=Pred(ColCount) then
      if ARow=rowFooter then Result:=Format(strPageIndex,[APageIndex,PageCount])
      else Result:=''
    else Result:='';
end;

function TCustomTextGridPrintJob.GetCellAlignment(ACol,ARow: Integer): TAlignment;
begin
  if (ACol=colIndex) or (ARow=rowFooter) then Result:=taRightJustify
  else Result:=taLeftJustify;
end;

procedure TSpecialTextGridPrintJob.DrawArea(TheCanvas: TCanvas; PageIndex: Integer;
  TheRect: TRect; Area: TDrawArea; Target: TDrawTarget);
begin
  if Area=daFooter then DrawCell(TheCanvas,TheRect,PageIndex,Pred(ColCount),rowFooter,Target)
  else inherited;
end;

end.