fr_ptabl.pas

1、开发环境 d6 up2,sqlserver2000, win2000 server 1024*768（笔记本电脑） c/s 2、数据库配置方法

{******************************************}
{                                          }
{               FastReport v2.4            }
{            Print table component         }
{                                          }
{ Copyright (c) 1998-2001 by Tzyganenko A. }
{                                          }
{******************************************}

unit FR_PTabl;

interface

{$I FR.inc}

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

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

  TfrDataSection = (frOther, frHeader, frData, frFooter);

{$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;

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

  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: Single;
    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: Single 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
    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;
    FFooter: TfrSectionParams;
    FPrintOptions: TfrPrintOptions;
    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);
  protected
    { Protected declarations }
  {$IFDEF IBO}
    FDataSet: TIB_Dataset;
  {$ELSE}
    FDataSet: TDataset;
  {$ENDIF}
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure CreateDS; virtual;
    property ColWidths[Index: Integer]: word read GetColWidths write SetColWidths;
    property ColCount: integer read GetColCount;

    procedure BuildReport;
    procedure ShowReport;

    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 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;
  end;

  TfrPrintTable = class(TfrCustomPrintDataSet)
  private
    FAutoWidth: Boolean;
    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
    property AutoWidth: Boolean read FAutoWidth write FAutoWidth default True;
  {$IFDEF IBO}
    property DataSet: TIB_DataSet read FDataSet write FDataSet;
  {$ELSE}
    property DataSet: TDataSet read FDataSet write FDataSet;
  {$ENDIF}
    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 OnPrintColumn;
    property OnPrintData;
    property OnCustomizeWidths;
  end;

{$IFNDEF IBO}
  TfrPrintGrid = class(TfrCustomPrintDataSet)
  private
    FDBGrid: TDBGrid;
    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
    property DBGrid: TDBGrid read FDBGrid write FDBGrid;
    property PageSize;
    property PageWidth;
    property PageHeight;
    property PageMargins;
    property Orientation;
    property Title;
    property PageHeader;
    property PageFooter;
    property Header;
    property Body;
    property OnPrintColumn;
 end;
{$ENDIF}


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;
begin
  Result := 0;
  if FAlign = taLeftJustify then
    Result := frtaLeft
  else if FAlign = taRightJustify then
    Result := frtaRight
  else if FAlign = taCenter then
    Result := frtaCenter
end;


{ TfrPageMargins }

constructor TfrPageMargins.Create;
begin
  inherited Create;
  FLeft   := 0;
  FTop    := 0;
  FRight  := 0;
  FBottom := 0;
end;

procedure TfrPageMargins.Assign(Source: TPersistent);
begin
  inherited Assign(Source);
  FLeft   := TfrPageMargins(Source).Left;
  FTop    := TfrPageMargins(Source).Top;
  FRight  := TfrPageMargins(Source).Right;
  FBottom := TfrPageMargins(Source).Bottom;
end;


{ TfrCustomPrintDataSet }

constructor TfrCustomPrintDataSet.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FPageMargins := TfrPageMargins.Create;
  FpgSize := 9;
  FTitle := TfrAdvSectionParams.Create;
  FTitle.Font.Style := [fsBold];
  FTitle.Font.Size := 12;

  FPageHeader := TfrAdvSectionParams.Create;

  FPageFooter := TfrAdvSectionParams.Create;

  FSummary := TfrAdvSectionParams.Create;
  FSummary.Font.Style := [fsItalic];
  FSummary.Font.Size := 12;

  FHeader := TfrSectionParams.Create;
  FHeader.Font.Style := [fsBold];
  FHeader.Font.Color := clWhite;
  FHeader.Color := clNavy;

  FFooter := TfrSectionParams.Create;
  FFooter.Font.Style := [fsItalic];
  FFooter.Color := clSilver;


  FBody := TfrSectionParams.Create;
  FReport := TfrReport.Create(Self);
  FReport.PreviewButtons := [pbZoom, pbSave, pbPrint, pbFind, pbHelp, pbExit, pbPageSetup];

  FReportDataSet := TfrDBDataSet.Create(Self);
  FReportDataSet.Name := 'frGridDBDataSet1';

  FColumnDataSet := TfrUserDataSet.Create(Self);
  FColumnDataSet.Name := 'frGridUserDataSet1';
  FColumnDataSet.RangeEnd := reCount;

  FPrintOptions:=[frpoHeader, frpoHeaderOnEveryPage];
end;

destructor TfrCustomPrintDataSet.Destroy;
begin
  FReportDataSet.Free;
  FColumnDataSet.Free;
  FReport.Free;
  FTitle.Free;
  FPageHeader.Free;
  FPageFooter.Free;
  FSummary.Free;
  FHeader.Free;
  FFooter.Free;
  FBody.Free;
  FPageMargins.Free;
  inherited Destroy;
end;

procedure TfrCustomPrintDataSet.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited Notification(AComponent, Operation);
  if (Operation = opRemove) and (AComponent = FPreview) then
    FPreview := nil;
end;

function TfrCustomPrintDataSet.RealColumnIndex(Index: Integer): Integer;
var
  Y, I: Integer;
begin
  Result := 0;
  Y := -1;
  for I := 0 to FDataSet.FieldCount - 1 do
    if FDataSet.Fields[I].Visible then
    begin
      Inc(Y);
      if Y = Index then
      begin
        Result := I;
        break;
      end;
    end;
end;

procedure TfrCustomPrintDataSet.SetPageMargins(Value: TfrPageMargins);
begin
  FPageMargins.Assign(Value);
end;

procedure TfrCustomPrintDataSet.SetTitle(Value: TfrAdvSectionParams);
begin
  FTitle.Assign(Value);
end;

procedure TfrCustomPrintDataSet.SetPageHeader(Value: TfrAdvSectionParams);
begin
  FPageHeader.Assign(Value);
end;

procedure TfrCustomPrintDataSet.SetPageFooter(Value: TfrAdvSectionParams);
begin
  FPageFooter.Assign(Value);
end;

procedure TfrCustomPrintDataSet.SetHeader(Value: TfrSectionParams);
begin
  FHeader.Assign(Value);
end;

procedure TfrCustomPrintDataSet.SetBody(Value: TfrSectionParams);
begin
  FBody.Assign(Value);
end;

procedure TfrCustomPrintDataSet.CreateDS;
begin
end;

function TfrCustomPrintDataSet.GetFieldCount: Integer;
var
  i: Integer;
  b: Boolean;
begin
  Result := FDataSet.FieldCount;
  b := True;
  for i := 0 to FDataSet.FieldCount - 1 do
    if (FDataSet.Fields[i] <> nil) and FDataSet.Fields[i].Visible then
    begin
      if b then
      begin
        b := False;
        Result := 0;
      end;
      Inc(Result);
    end;
end;

procedure TfrCustomPrintDataSet.BuildReport;
var
  v: TfrView;
  b: TfrBandView;
  Page: TfrPage;
  LeftMargin: Integer;
begin
  CreateDS;