fr_ptabl.pas

FASTREPORT报表工具,可以迅速制作报表.

{******************************************}
{                                          }
{               FastReport v2.4            }
{            Print table component         }
{                                          }
{ Copyright (c) 1998-2001 by Tzyganenko A. }
{                                          }
{******************************************}
{ 2002/04/28 Marco Menardi TfrPrintGrid    }
{  for IBO, TfrPrintGrid FitWidth and      }
{  AutoWidth, removed use of DB.PAS for    }
{  IBO compilation                         }
{******************************************}


unit FR_PTabl;

interface

{$I FR.inc}

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   Printers, FR_DSet, FR_DBSet
{$IFDEF IBO}
, IB_Components
, IB_Grid
, IB_Parse
{$ELSE}
, DB
, DBGrids
{$ENDIF}
, FR_Class, FR_View;

type
  TfrShrinkOption = (frsoProportional, frsoShrinkOnly);
  TfrShrinkOptions = set of TfrShrinkOption;
  TfrAggregateType = (frAggNone, frAggSum, frAggAvg, frAggCount, frAggMin, frAggMax);

  TfrField = record
{$IFDEF IBO}
    Field: TIB_Column;
{$ELSE}
    Field: TField;
{$ENDIF}
    Value: Double;
    AggregateType: TfrAggregateType;
  end;

  TfrPrintColumnEvent = procedure(ColumnNo: Integer; var Width: Integer) of object;

  TfrDataSection = (frOther, frHeader, frData, frFooter, frTitle, frSummary, frPageHeader, frPageFooter);

{$IFDEF IBO}
  TfrPrintDataEvent = procedure(Field: TIB_Column; Memo: TStringList; View: TfrView; Section: TfrDataSection) of object;
{$ELSE}
  TfrPrintDataEvent = procedure(Field: TField; Memo: TStringList; View: TfrView; Section: TfrDataSection) of object;
{$ENDIF}

  TfrPrintOption = (frpoHeader, frpoHeaderOnEveryPage, frpoFooter);
  TfrPrintOptions = set of TfrPrintOption;

  TfrFrameLine = (frLeft, frTop, frRight, frBottom);
  TfrFrameLines = set of TfrFrameLine;

  TfrAutoOrientation = class(TPersistent)
  private
    FEnabled: boolean;
    FResizePercent: integer;
    procedure SetResizePercent(const Value: integer);
  public
    constructor Create; virtual;
    procedure Assign(Source: TPersistent); override;
  published
    property Enabled: boolean read FEnabled write FEnabled;
    property ResizePercent: integer read FResizePercent write SetResizePercent;
  end;

  TfrWidthsArray = Array[0..255] of Word;
  TfrCustomWidthsEvent = procedure(var Widths: TfrWidthsArray; DataColumns, PageActiveWidth: integer) of object;

  TfrFitWidth = class(TPersistent)
  private
    FShrinkOptions: TfrShrinkOptions;
    FApplyBeforeOnCustomize: boolean;
    FEnabled: Boolean;
    FResizePercent: integer;
    FFields: string;
    procedure SetApplyBeforeOnCustomize(const Value: boolean);
    procedure SetEnabled(const Value: Boolean);
    procedure SetFields(const Value: string);
    procedure SetResizePercent(const Value: integer);
  public
    constructor Create; virtual;
    procedure Assign(Source: TPersistent); override;
  published
    property Enabled: Boolean read FEnabled write SetEnabled;
    property Fields: string read FFields write SetFields;
    property ShrinkOptions: TfrShrinkOptions read FShrinkOptions write FShrinkOptions;

    property ResizePercent: integer read FResizePercent write SetResizePercent;
    property ApplyBeforeOnCustomize: boolean read FApplyBeforeOnCustomize write SetApplyBeforeOnCustomize;
  end;

  TfrPageMargins = class(TPersistent)
  private
    FLeft: Integer;
    FTop: Integer;
    FRight: Integer;
    FBottom: Integer;
  public
    constructor Create; virtual;
    procedure Assign(Source: TPersistent); override;
  published
    property Left: Integer read FLeft write FLeft;
    property Top: Integer read FTop write FTop;
    property Right: Integer read FRight write FRight;
    property Bottom: Integer read FBottom write FBottom;
  end;

  TfrSectionParams = class(TPersistent)
  private
    FFont: TFont;
    FColor: TColor;
    FFrame: TfrFrameLines;
    FFrameWidth: Integer;
    procedure SetFont(Value: TFont);
  public
    constructor Create; virtual;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    function GetFrameTyp: Integer;
  published
    property Font: TFont read FFont write SetFont;
    property Color: TColor read FColor write FColor;
    property Frame: TfrFrameLines read FFrame write FFrame;
    property FrameWidth: Integer read FFrameWidth write FFrameWidth;
  end;

  TfrAdvSectionParams = class(TfrSectionParams)
  private
    FAlign: TAlignment;
    FText: String;
  public
    constructor Create; override;
    procedure Assign(Source: TPersistent); override;
    function GetAlign: Integer;
  published
    property Align: TAlignment read FAlign write FAlign default taCenter;
    property Text: String read FText write FText;
  end;

  TfrCustomPrintDataSet = class(TComponent)
  private
    FAutoWidth: Boolean;
    FHasAggregates: Boolean;
    FOnFirst, FOnNext, FOnPrior: TNotifyEvent;
    FOnCheckEOF: TCheckEOFEvent;
    FWidths: TfrWidthsArray;
    FCustomizeWidths: TfrCustomWidthsEvent;
    FpgSize: Integer;
    FpgWidth: Integer;
    FpgHeight: Integer;
    FPageMargins: TfrPageMargins;
    FOrientation: TPrinterOrientation;
    FTitle, FPageHeader, FPageFooter, FSummary: TfrAdvSectionParams;
    FHeader, FBody: TfrSectionParams;
    FWidth: Integer;
    FReport: TfrReport;
    FPreview: TfrPreview;
    FReportDataSet: TfrDBDataSet;
    FColumnDataSet: TfrUserDataSet;
    FOnPrintColumn: TfrPrintColumnEvent;
    FOnPrintData: TfrPrintDataEvent;
    FOnBeginDoc: TBeginDocEvent;
    FOnEndDoc: TEndDocEvent;
    FOnBeginPage: TBeginPageEvent;
    FOnEndPage: TEndPageEvent;
    FFooter: TfrSectionParams;
    FPrintOptions: TfrPrintOptions;
    FFitWidth: TfrFitWidth;
    FAutoOrientation: TfrAutoOrientation;
    FReportBefore: TfrReport;
    FReportAfter: TfrReport;
    procedure OnEnterRect(Memo: TStringList; View: TfrView); virtual;
    procedure OnPrintColumn_(ColNo: Integer; var Width: Integer); virtual;
    function GetFieldCount: Integer; virtual;
    function RealColumnIndex(Index: Integer): Integer;
    procedure SetPageMargins(Value: TfrPageMargins);
    procedure SetTitle(Value: TfrAdvSectionParams);
    procedure SetPageHeader(Value: TfrAdvSectionParams);
    procedure SetPageFooter(Value: TfrAdvSectionParams);
    procedure SetHeader(Value: TfrSectionParams);
    procedure SetBody(Value: TfrSectionParams);
    procedure SetFooter(const Value: TfrSectionParams);
    function GetColWidths(Index: Integer): word;
    procedure SetColWidths(Index: Integer; const Value: word);
    function GetColCount: integer;
    procedure SetSummary(const Value: TfrAdvSectionParams);
    procedure SetAggFields(const Value: TStringList);
  protected
    { Protected declarations }
  {$IFDEF IBO}
    FDataSet: TIB_Dataset;
  {$ELSE}
    FDataSet: TDataset;
  {$ENDIF}
    FVisibleFields: array[0..255] of TfrField;
    FAggFields: TStringList;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateDS; virtual;
    property AutoWidth: Boolean read FAutoWidth write FAutoWidth default True;

    function ColumnIndexByName(AField: string): integer;
{$IFDEF IBO}
    function FieldByColumIndex(AIndex: integer): TIB_Column;
{$ELSE}
    function FieldByColumIndex(AIndex: integer): TField;
{$ENDIF}
    function TextWidthInSection(AText: string; ADataSection: TfrDataSection): integer;
    function TextHeightInSection(AText: string; ADataSection: TfrDataSection): integer;
    function TextExtentInSection(AText: string; ADataSection: TfrDataSection): TSize;
    function TryToFitWidth(var Widths: TfrWidthsArray; DataColumns, ADesiredWidth, AThresold: integer; AFields: string; AOptions: TfrShrinkOptions): boolean;
    function SuggestedOrientation: TPrinterOrientation;

    property ColWidths[Index: Integer]: word read GetColWidths write SetColWidths;
    property ColCount: integer read GetColCount;

    procedure BuildReport;
    procedure ShowReport;

    property FitWidth: TfrFitWidth read FFitWidth write FFitWidth;
    property PageSize: Integer read FpgSize write FpgSize;
    property PageWidth: Integer read FpgWidth write FpgWidth;
    property PageHeight: Integer read FpgHeight write FpgHeight;
    property PageMargins: TfrPageMargins read FPageMargins write SetPageMargins;
    property Orientation: TPrinterOrientation read FOrientation write FOrientation default poPortrait;
    property Title: TfrAdvSectionParams read FTitle write SetTitle;
    property PageHeader: TfrAdvSectionParams read FPageHeader write SetPageHeader;
    property PageFooter: TfrAdvSectionParams read FPageFooter write SetPageFooter;
    property Header: TfrSectionParams read FHeader write SetHeader;
    property Footer: TfrSectionParams read FFooter write SetFooter;
    property Summary: TfrAdvSectionParams read FSummary write SetSummary;
    property Body: TfrSectionParams read FBody write SetBody;
    property Preview: TfrPreview read FPreview write FPreview;
    property Report: TfrReport read FReport;
    property AggregateFields: TStringList read FAggFields write SetAggFields;
    property OnPrintColumn: TfrPrintColumnEvent read FOnPrintColumn write FOnPrintColumn;
    property OnPrintData: TfrPrintDataEvent read FOnPrintData write FOnPrintData;
    property PrintOptions: TfrPrintOptions read FPrintOptions write FPrintOptions;
    property OnCustomizeWidths: TfrCustomWidthsEvent read FCustomizeWidths write FCustomizeWidths;
    property OnBeginDoc: TBeginDocEvent read FOnBeginDoc write FOnBeginDoc;
    property OnEndDoc: TEndDocEvent read FOnEndDoc write FOnEndDoc;
    property OnBeginPage: TBeginPageEvent read FOnBeginPage write FOnBeginPage;
    property OnEndPage: TEndPageEvent read FOnEndPage write FOnEndPage;
    property OnFirst: TNotifyEvent read FOnFirst write FOnFirst;
    property OnNext: TNotifyEvent read FOnNext write FOnNext;
    property OnPrior: TNotifyEvent read FOnPrior write FOnPrior;
    property OnCheckEOF: TCheckEOFEvent read FOnCheckEOF write FOnCheckEOF;
    property AutoOrientation: TfrAutoOrientation read FAutoOrientation write FAutoOrientation;
    property ReportBefore: TfrReport read FReportBefore write FReportBefore;
    property ReportAfter: TfrReport read FReportAfter write FReportAfter;
  end;

  TfrPrintTable = class(TfrCustomPrintDataSet)
  private
    procedure OnEnterRect(Memo: TStringList; View: TfrView); override;
    procedure OnPrintColumn_(ColNo: Integer; var Width: Integer); override;
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure CreateDS; override;
  published
  {$IFDEF IBO}
    property DataSet: TIB_DataSet read FDataSet write FDataSet;
  {$ELSE}
    property DataSet: TDataSet read FDataSet write FDataSet;
  {$ENDIF}
    property AutoWidth;
    property FitWidth;
    property PageSize;
    property PageWidth;
    property PageHeight;
    property PageMargins;
    property Orientation;
    property Title;
    property PageHeader;
    property PageFooter;
    property Header;
    property Footer;
    property Summary;
    property Body;
    property PrintOptions;
    property AggregateFields;
    property AutoOrientation;
    property ReportBefore;
    property ReportAfter;
    property OnPrintColumn;
    property OnPrintData;
    property OnCustomizeWidths;
    property OnBeginDoc;
    property OnEndDoc;
    property OnBeginPage;
    property OnEndPage;
    property OnFirst;
    property OnNext;
    property OnPrior;
    property OnCheckEOF;
  end;

  TfrPrintGrid = class(TfrCustomPrintDataSet)
  private
{$IFDEF IBO}
    FDBGrid: TIB_Grid;
{$ELSE}
    FDBGrid: TDBGrid;
{$ENDIF}
    function RealGridIndex(Index: Integer): Integer;
    procedure OnEnterRect(Memo: TStringList; View: TfrView); override;
    procedure OnPrintColumn_(ColNo: Integer; var Width: Integer); override;
    function GetFieldCount: Integer; override;
  protected
    { Protected declarations }
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    procedure CreateDS; override;
  published
{$IFDEF IBO}
    property DBGrid: TIB_Grid read FDBGrid write FDBGrid;
{$ELSE}
    property DBGrid: TDBGrid read FDBGrid write FDBGrid;
{$ENDIF}
    property AutoWidth;
    property FitWidth;
    property PageSize;
    property PageWidth;
    property PageHeight;
    property PageMargins;
    property Orientation;
    property Title;
    property PageHeader;
    property PageFooter;
    property Header;
    property Body;
    property OnPrintColumn;
 end;


implementation

{$IFDEF Delphi2}
uses DBTables;
{$ENDIF}


{ TfrSectionParams }

constructor TfrSectionParams.Create;
begin
  inherited Create;
  FFont := TFont.Create;
  FFont.Name := 'Arial';
{$IFNDEF Delphi2}
  FFont.Charset := frCharset;
{$ENDIF}
  FFont.Size := 10;
  FColor := clWhite;
  FFrame := [frLeft, frTop, frRight, frBottom];
  FFrameWidth := 1;
end;

destructor TfrSectionParams.Destroy;
begin
  FFont.Free;
  inherited Destroy;
end;

procedure TfrSectionParams.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  FFont.Assign(TfrSectionParams(Source).Font);
  FColor := TfrSectionParams(Source).Color;
  FFrame := TfrSectionParams(Source).Frame;
end;

procedure TfrSectionParams.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
end;

function TfrSectionParams.GetFrameTyp: Integer;
begin
  Result := 0;
  if frLeft in FFrame then
    Result := frftLeft;
  if frRight in FFrame then
    Result := Result + frftRight;
  if frTop in FFrame then
    Result := Result + frftTop;
  if frBottom in FFrame then
    Result := Result + frftBottom;
end;


{ TfrAdvSectionParams }

constructor TfrAdvSectionParams.Create;
begin
  inherited Create;
  FAlign := taCenter;
  FFrame := [];
end;

procedure TfrAdvSectionParams.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  FAlign := TfrAdvSectionParams(Source).Align;
  FText := TfrAdvSectionParams(Source).Text;
end;

function TfrAdvSectionParams.GetAlign: Integer;