reportunit.pas

该控件是一个带表格线的打印构件

{-------------------------------------------------------------------------------
  ReportPage Component Trial Version(c)
  Designed for Delphi 4.0

  REPORT UNIT unit

  please visit my site: http://lixinhua.yeah.net
                        http://reportpage.yeah.net
          my E-Mail is: [e-mail]
                Author: Xinhua.LEE
--------------------------------------------------------------------------------}

unit ReportUnit;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, DB,
  DsgnIntf;

type
  TOnGenerateEvent = procedure(Sender: TObject; RecordNo: Integer) of object;

  TVAlign = (vaNone, vaTop, vaBottom, vaTitleBottom, vaFootTop);
  THAlign = (haNone, haLeft, haRight, haCenter);
  TSysData = (sdNone, sdDate, sdTime, sdDateTime, sdPageNo);
  TChangeType = (ctActiveChanged, ctDataSetChanged, ctReportSourceChanged,
    ctReportCustomChanged, ctReportLabelChanged);

  EReportError = class;
  TReportLabel = class;
  TReportLabels = class;
  TReportCustom = class;
  TReportLine = class;
  TReportSource = class;
  TReportSingle = class;
  TReportDataLink = class;
  TReportPreview = class;

  EReportError = class(Exception);

  TReportLabel = class(TCollectionItem)
  private
    FLeft: Integer;
    FTop: Integer;
    FText: string;
    FFont: TFont;
    FBitmap: TBitmap;
    FVAlign: TVAlign;
    FHAlign: THAlign;
    FSysData: TSysData;
    FOnDraw: TNotifyEvent;
    FReportLabels: TReportLabels;
    procedure SetLeft(Value: Integer);
    procedure SetTop(Value: Integer);
    procedure SetBitmap(Value: TBitmap);
    procedure SetFont(Value: TFont);
    procedure SetText(Value: string);
    procedure SetVAlign(Value: TVAlign);
    procedure SetHAlign(Value: THAlign);
    procedure SetSysData(Value: TSysData);
    procedure Changed(Sender: TObject);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property Left: Integer read FLeft write SetLeft;
    property Top: Integer read FTop write SetTop;
    property Text: string read FText write SetText;
    property Bitmap: TBitmap read FBitmap write SetBitmap;
    property Font: TFont read FFont write SetFont;
    property VAlign: TVAlign read FVAlign write SetVAlign;
    property HAlign: THAlign read FHAlign write SetHAlign;
    property SysData: TSysData read FSysData write SetSysData;
    property OnDraw: TNotifyEvent read FOnDraw write FOnDraw;
  end;

  TReportLabels = class(TCollection)
  private
    FReportCustom: TReportCustom;
    procedure Changed(Sender: TObject);
    procedure SetItem(Index: Integer; Value: TReportLabel);
    function GetItem(Index: Integer): TReportLabel;
  protected
    procedure Update(Item: TCollectionItem); override;
    function GetOwner: TPersistent; override;
  public
    constructor Create(ReportCustom: TReportCustom);
    function Add: TReportLabel;
    property Items[Index: Integer]: TReportLabel read GetItem write SetItem;
  end;

  TReportCustom = class(TComponent)
  private
    FReportSource: TReportSource;
    FReportLabels: TReportLabels;
    FTitleHeight: Integer;
    FFootHeight: Integer;
    FCurrentPage: Integer;
    FPageRecord: Integer;
    FGenEmptyGrid: Boolean;
    FPreviewLinks: TList;
    FOnBeginGenerate: TNotifyEvent;
    FOnEndGenerate: TNotifyEvent;
    procedure SetReportSource(Value: TReportSource);
    procedure SetReportLabels(Value: TReportLabels);
    procedure SetTitleHeight(Value: Integer);
    procedure SetFootHeight(Value: Integer);
    procedure SetCurrentPage(Value: Integer);
    procedure SetPageRecord(Value: Integer);
    procedure SetGenEmptyGrid(Value: Boolean);
    procedure RegisterPreviewLink(Value: TReportPreview);
    procedure UnregisterPreviewLink(Value: TReportPreview);
    procedure Changed(Sender: TObject; ChangeType: TChangeType);
    function GetReportBitmap: TBitmap;
    function GetPageCount: Integer;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    function GetDetailBitmap: TBitmap; virtual; abstract;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Prev;
    procedure Next;
    function Linked: Boolean;
    property ReportBitmap: TBitmap read GetReportBitmap;
    property CurrentPage: Integer read FCurrentPage write SetCurrentPage;
    property PageCount: Integer read GetPageCount;
  published
    property ReportSource: TReportSource read FReportSource write SetReportSource;
    property ReportLabels: TReportLabels read FReportLabels write SetReportLabels;
    property TitleHeight: Integer read FTitleHeight write SetTitleHeight;
    property FootHeight: Integer read FFootHeight write SetFootHeight;
    property PageRecord: Integer read FPageRecord write SetPageRecord;
    property OnBeginGenerate: TNotifyEvent read FOnBeginGenerate write FOnBeginGenerate;
    property OnEndGenerate: TNotifyEvent read FOnEndGenerate write FOnEndGenerate;
    property GenEmptyGrid: Boolean read FGenEmptyGrid write SetGenEmptyGrid;
  end;

  TReportLine = class(TPersistent)
  private
    FFont: TFont;
    FHeight: Integer;
    FLeft: Integer;
    FTop: Integer;
    FRightAlign: Boolean;
    FReportSource: TReportSource;
    procedure SetFont(Value: TFont);
    procedure SetHeight(Value: Integer);
    procedure SetLeft(Value: Integer);
    procedure SetTop(Value: Integer);
    procedure SetRightAlign(Value: Boolean);
    procedure Changed(Sender: TObject);
  public
    constructor Create(AOwner: TReportSource);
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
  published
    property Font: TFont read FFont write SetFont;
    property Height: Integer read FHeight write SetHeight;
    property Left: Integer read FLeft write SetLeft;
    property Top: Integer read FTop write SetTop;
    property RightAlign: Boolean read FRightAlign write SetRightAlign;
  end;

  TReportSource = class(TComponent)
  private
    FHeaderLine: TReportLine;
    FDataLine: TReportLine;
    FPage: TBitmap;
    FDataSource: TDataSource;
    FFirstRecord: Integer;
    FLastRecord: Integer;
    FLinks: TList;
    FDataLink: TReportDataLink;
    FOnGenerate: TOnGenerateEvent;
    procedure SetHeaderLine(Value: TReportLine);
    procedure SetDataLine(Value: TReportLine);
    procedure SetDataSource(Value: TDataSource);
    procedure RegisterReportLink(AReportCustom: TReportCustom);
    procedure UnregisterReportLink(AReportCustom: TReportCustom);
    procedure ReportSourceChanged(Sender: TObject; ChangeType: TChangeType);
    procedure Generate;
    function GetReportWidth: Integer;
    function GetReportHeight: Integer;
    function GetRecordCount: Integer;
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property HeaderLine: TReportLine read FHeaderLine write SetHeaderLine;
    property DataLine: TReportLine read FDataLine write SetDataLine;
    property DataSource: TDataSource read FDataSource write SetDataSource;
    property OnGenerate: TOnGenerateEvent read FOnGenerate write FOnGenerate;
  end;

  TReportSingle = class(TReportCustom)
  protected
    function GetDetailBitmap: TBitmap; override;
  end;

  TReportDataLink = class(TDataLink)
  private
    FReportSource: TReportSource;
  protected
    procedure ActiveChanged; override;
    procedure DataSetChanged; override;
  public
    constructor Create(AReportSource: TReportSource);
  end;

  TReportPreview = class(TGraphicControl)
  private
    FReportCustom: TReportCustom;
    FAutoSize: Boolean;
    FReportBitmap: TBitmap;
    procedure SetReportCustom(Value: TReportCustom);
    procedure SetAutoSize(Value: Boolean);
    procedure PaintRectangle;
    procedure PaintReport;
    procedure Changed(Sender: TObject);
  protected
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Paint; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure ReGenerate;
  published
    property ReportCustom: TReportCustom read FReportCustom write SetReportCustom;
    property AutoSize: Boolean read FAutoSize write SetAutoSize;
    property Align;
    property ShowHint;
    property Visible;
    property PopupMenu;
    property OnClick;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDrag;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnStartDrag;
  end;

procedure TextInfo(AFont: TFont; Text: string; var Width, Height: Integer);
procedure GotoRecord(ADataSource: TDataSource; RecordNo: Integer);
procedure ReportError(ErrorMsg: string);
function GetRecCount(ADataSource: TDataSource): Integer;

implementation

procedure TextInfo(AFont: TFont; Text: string; var Width, Height: Integer);
var
  ABitmap: TBitmap;
  Size: TSize;
begin
  ABitmap := TBitmap.Create;
  try
    ABitmap.Canvas.Font.Assign(AFont);
    Size := ABitmap.Canvas.TextExtent(Text);
    Width := Size.cx;
    Height := Size.cy;
  finally
    ABitmap.Free;
  end;
end;

procedure GotoRecord(ADataSource: TDataSource; RecordNo: Integer);
var
  I: Integer;
begin
  if ADataSource = nil then
    ReportError('Report Error(from GotoRecord procedure): DataSource is not assigned !');
  if ADataSource.DataSet = nil then
    ReportError('Report Error(from GotoRecord procedure): DataSource.DataSet is not assigned !');
  ADataSource.DataSet.DisableControls;
  try
    ADataSource.DataSet.First;
    for I := 1 to RecordNo - 1 do ADataSource.DataSet.Next;
  finally
    ADataSource.DataSet.EnableControls;
  end;
end;

procedure ReportError(ErrorMsg: string);
begin
  raise EReportError.Create(ErrorMsg);
end;

function GetRecCount(ADataSource: TDataSource): Integer;
var
  S: Integer;
begin
  if ADataSource = nil then
    ReportError('Report Error(from GetRecCount function): DataSource is not assigned !');
  if ADataSource.DataSet = nil then
    ReportError('Report Error(from GetRecCount function): DataSource.DataSet is not assigned !');
  ADataSource.DataSet.DisableControls;
  try
    S := 0;
    ADataSource.DataSet.First;
    while not ADataSource.DataSet.EOF do
    begin
      ADataSource.DataSet.Next;
      S := S + 1;
    end;
  finally
    ADataSource.DataSet.EnableControls;
  end;
  Result := S;
end;

constructor TReportLabel.Create(Collection: TCollection);
begin
  inherited Create(Collection);
  if Collection is TReportLabels then FReportLabels := TReportLabels(Collection);
  FBitmap := TBitmap.Create;
  FBitmap.PixelFormat := pf4bit;
  FFont := TFont.Create;
  FFont.OnChange := Changed;
  FVAlign := vaNone;
  FHAlign := haNone;
  FSysData := sdNone;
end;

destructor TReportLabel.Destroy;
begin
  FFont.Free;
  FBitmap.Free;
  inherited Destroy;
end;

procedure TReportLabel.SetLeft(Value: Integer);
begin
  if (Value >= 0) and (FLeft <> Value) then
  begin
    FLeft := Value;
    Changed(Self);
  end;
end;

procedure TReportLabel.SetTop(Value: Integer);
begin
  if (Value >= 0) and (FTop <> Value) then
  begin
    FTop := Value;
    Changed(Self);
  end;
end;

procedure TReportLabel.SetBitmap(Value: TBitmap);
begin
  FBitmap.Assign(Value);
  Changed(Self);
end;

procedure TReportLabel.SetFont(Value: TFont);
begin
  FFont.Assign(Value);
  Changed(Self);
end;

procedure TReportLabel.SetText(Value: string);
begin
  if FText <> Value then
  begin
    FText := Value;
    Changed(Self);
  end;
end;