frxengine.pas

这个是功能强大的报表软件

{******************************************}
{                                          }
{             FastReport v4.0              }
{              Report engine               }
{                                          }
{         Copyright (c) 1998-2008          }
{         by Alexander Tzyganenko,         }
{            Fast Reports Inc.             }
{                                          }
{******************************************}

unit frxEngine;

interface

{$I frx.inc}

uses
  SysUtils, Windows, Messages, Classes, Graphics, Controls, Forms, Dialogs,
  frxClass, frxAggregate, frxXML, frxDMPClass
{$IFDEF Delphi6}
, Variants
{$ENDIF};
  

type
  { TfrxHeaderList holds a set of bands that should appear on each new page.
    This includes page header, column header and header bands with
    "Reprint on new page" setting }

  TfrxHeaderListItem = class(TObject)
  public
    Band: TfrxBand;
    Left: Extended;
    IsInKeepList: Boolean;
  end;

  TfrxHeaderList = class(TObject)
  private
    FList: TList;
    function GetCount: Integer;
    function GetItems(Index: Integer): TfrxHeaderListItem;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Clear;
    procedure AddItem(ABand: TfrxBand; ALeft: Extended; AInKeepList: Boolean);
    procedure RemoveItem(ABand: TfrxBand);
    property Count: Integer read GetCount;
    property Items[Index: Integer]: TfrxHeaderListItem read GetItems; default;
  end;

  TfrxEngine = class(TfrxCustomEngine)
  private
    FAggregates: TfrxAggregateList;
    FCallFromAddPage: Boolean;
    FCallFromEndPage: Boolean;
    FCurBand: TfrxBand;
    FLastBandOnPage: TfrxBand;
    FDontShowHeaders: Boolean;
    FHeaderList: TfrxHeaderList; { list of header bands }
    FFirstReportPage: Boolean;   { needed for correct setting of PreviewPages.FirstPage }
    FFirstColumnY: Extended;     { position of the first column }
    FIsFirstBand: Boolean;       { needed for KeepTogether }
    FIsFirstPage: Boolean;       { first and last page flags }
    FIsLastPage: Boolean;        {                           }
    FKeepBand: TfrxBand;
    FKeepFooter: Boolean;
    FKeeping: Boolean;
    FPrevFooterHeight: Extended; {need for correct freespace calculation when use printOnPreviousPage}
    FIsPrevPagePrint: Boolean;
    FKeepOutline: TfrxXMLItem;
    FKeepPosition: Integer;
    FKeepAnchor: Integer;
    FOutputTo: TfrxNullBand;     { used in the subreports }
    FPage: TfrxReportPage;       { currently proceeded page }
    FPageCurX: Extended;
    FStartNewPageBand: TfrxBand; { needed in addpage }
    FVHeaderList: TList;         { list of vheader bands }
    FVMasterBand: TfrxBand;      { master hband for vbands }
    FVPageList: TList;           { list of page breaks for vbands }
    procedure AddBandOutline(Band: TfrxBand);
    procedure AddColumn;
    procedure AddPage;
    procedure AddPageOutline;
    procedure AddToHeaderList(Band: TfrxBand);
    procedure AddToVHeaderList(Band: TfrxBand);
    procedure CheckBandColumns(Band: TfrxDataBand; ColumnKeepPos: Integer;
      SaveCurY: Extended);
    procedure CheckDrill(Master: TfrxDataBand; Band: TfrxGroupHeader);
    procedure CheckGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
      ColumnKeepPos: Integer; SaveCurY: Extended);
    procedure CheckSubReports(Band: TfrxBand);
    procedure CheckSuppress(Band: TfrxBand);
    procedure DoShow(Band: TfrxBand);
    procedure DrawSplit(Band: TfrxBand);
    procedure EndColumn;
    procedure EndKeep(Band: TfrxBand);
    procedure Finalize;
    procedure InitGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
      Index: Integer; ResetLineN: Boolean = False);
    procedure InitPage;
    procedure NotifyObjects(Band: TfrxBand);
    procedure OutlineRoot;
    procedure OutlineUp(Band: TfrxBand);
    procedure PreparePage(ErrorList: TStrings; PrepareVBands: Boolean);
    procedure PrepareShiftTree(Band: TfrxBand);
    procedure RemoveFromHeaderList(Band: TfrxBand);
    procedure RemoveFromVHeaderList(Band: TfrxBand);
    procedure ResetSuppressValues(Band: TfrxBand);
    procedure RunPage(Page: TfrxReportPage);
    procedure RunReportPages;
    procedure ShowGroupFooters(Band: TfrxGroupHeader; Index: Integer; Master: TfrxDataBand);
    procedure ShowVBands(HBand: TfrxBand);
    procedure StartKeep(Band: TfrxBand; Position: Integer = 0);
    procedure Stretch(Band: TfrxBand);
    procedure UnStretch(Band: TfrxBand);
    function CanShow(Obj: TObject; PrintIfDetailEmpty: Boolean): Boolean;
    function FindBand(Band: TfrxBandClass): TfrxBand;
    function Initialize: Boolean;
    function RunDialogs: Boolean;
  protected
  public
    constructor Create(AReport: TfrxReport); override;
    destructor Destroy; override;
    procedure EndPage; override;
    procedure NewColumn; override;
    procedure NewPage; override;
    function Run: Boolean; override;
    procedure ShowBand(Band: TfrxBand); overload; override;
    procedure ShowBand(Band: TfrxBandClass); overload; override;
    function HeaderHeight: Extended; override;
    function FooterHeight: Extended; override;
    function FreeSpace: Extended; override;
    function GetAggregateValue(const Name, Expression: String;
      Band: TfrxBand; Flags: Integer): Variant; override;
  end;


implementation

uses frxUtils, frxPreviewPages, frxRes;

type
  THackComponent = class(TfrxComponent);
  THackMemoView = class(TfrxCustomMemoView);


{ TfrxHeaderList }

constructor TfrxHeaderList.Create;
begin
  FList := TList.Create;
end;

destructor TfrxHeaderList.Destroy;
begin
  Clear;
  FList.Free;
  inherited;
end;

procedure TfrxHeaderList.Clear;
begin
  while FList.Count > 0 do
  begin
    TObject(FList[0]).Free;
    FList.Delete(0);
  end;
end;

function TfrxHeaderList.GetCount: Integer;
begin
  Result := FList.Count;
end;

function TfrxHeaderList.GetItems(Index: Integer): TfrxHeaderListItem;
begin
  Result := FList[Index];
end;

procedure TfrxHeaderList.AddItem(ABand: TfrxBand; ALeft: Extended; AInKeepList: Boolean);
var
  Item: TfrxHeaderListItem;
begin
  Item := TfrxHeaderListItem.Create;
  Item.Band := ABand;
  Item.Left := ALeft;
  Item.IsInKeepList := AInKeepList;
  FList.Add(Item);
end;

procedure TfrxHeaderList.RemoveItem(ABand: TfrxBand);
var
  i: Integer;
begin
  for i := 0 to Count - 1 do
    if Items[i].Band = ABand then
    begin
      Items[i].Free;
      FList.Delete(i);
      break;
    end;
end;


{ TfrxEngine }

constructor TfrxEngine.Create(AReport: TfrxReport);
begin
  inherited;
  FHeaderList := TfrxHeaderList.Create;
  FVHeaderList := TList.Create;
  FVPageList := TList.Create;
  FAggregates := TfrxAggregateList.Create(AReport);
  FLastBandOnPage := nil;
end;

destructor TfrxEngine.Destroy;
begin
  FHeaderList.Free;
  FVHeaderList.Free;
  FVPageList.Free;
  FAggregates.Free;
  inherited;
end;

function TfrxEngine.Initialize: Boolean;
var
  i, j: Integer;
  b: TfrxDataBand;
begin
  FPrevFooterHeight := 0;
  PreviewPages.Initialize;
  PreviewPages.AddPageAction := apAdd;
  StartDate := Date;
  StartTime := Time;
  Running := True;
  FKeeping := False;
  CurVColumn := 0;
  FOutputTo := nil;

  { clear all aggregate items }
  FAggregates.Clear;

  { add all report pages to the PreviewPages }
  for i := 0 to Report.PagesCount - 1 do
    if Report.Pages[i] is TfrxReportPage then
    begin
      { set the current page }
      FPage := TfrxReportPage(Report.Pages[i]);
      { create band tree for the current page }
      PreparePage(Report.Errors, False);
      PreparePage(Report.Errors, True);
    end;

  { check datasets used }
  for i := 0 to Report.PagesCount - 1 do
    if Report.Pages[i] is TfrxReportPage then
    begin
      FPage := TfrxReportPage(Report.Pages[i]);
      if (Report.DataSet <> nil) and (Report.DataSet = FPage.DataSet) then
      begin
        Report.Errors.Add('Cannot use the same dataset for Report.DataSet and Page.DataSet');
        break;
      end;
      for j := 0 to FPage.FSubBands.Count - 1 do
      begin
        b := FPage.FSubBands[j];
        if (b <> nil) and (b.DataSet <> nil) then
          if Report.DataSet = b.DataSet then
          begin
            Report.Errors.Add('Cannot use the same dataset for Report.DataSet and Band.DataSet');
            break;
          end
          else if FPage.DataSet = b.DataSet then
          begin
            Report.Errors.Add('Cannot use the same dataset for Page.DataSet and Band.DataSet');
            break;
          end
      end;
    end;

  Result := Report.Errors.Count = 0;
end;

procedure TfrxEngine.Finalize;
begin
  try
    Report.DataSets.Finalize;
  finally
    PreviewPages.Finish;
    Running := False;
  end;
end;

function TfrxEngine.Run: Boolean;
var
  i: Integer;
begin
  Result := False;
  try
    if Initialize then
      try
        Report.DataSets.Initialize;
        Report.DoNotifyEvent(Report, Report.OnStartReport);
        if RunDialogs then
        begin
          Result := True;

          { add all report pages to the PreviewPages }
          for i := 0 to Report.PagesCount - 1 do
            if Report.Pages[i] is TfrxReportPage then
            begin
              FPage := TfrxReportPage(Report.Pages[i]);
              PreviewPages.AddSourcePage(FPage);
              { find aggregates }
              FAggregates.AddItems(FPage);
            end;

          { start the report }
          FinalPass := not DoublePass;
          TotalPages := 0;
          PreviewPages.BeginPass;
          RunReportPages;
          if DoublePass then
          begin
            TotalPages := PreviewPages.Count;
            PreviewPages.ClearFirstPassPages;
            FAggregates.ClearValues;
            FinalPass := True;
            RunReportPages;
          end;
        end
      finally
        Report.DoNotifyEvent(Report, Report.OnStopReport);
      end;
  finally
    Finalize;
  end;
end;

{$HINTS OFF}
function TfrxEngine.RunDialogs: Boolean;
var
  i: Integer;
  p: TfrxDialogPage;
  v: Variant;
begin
  Result := True;
{$IFNDEF FR_VER_BASIC}
  if Trim(Report.OnRunDialogs) <> '' then
  begin
    v := VarArrayOf([True]);
    Report.DoParamEvent(Report.OnRunDialogs, v);
    Result := v[0];
  end
  else
    for i := 0 to Report.PagesCount - 1 do
      if (Report.Pages[i] is TfrxDialogPage) and Report.Pages[i].Visible then
      begin
        p := TfrxDialogPage(Report.Pages[i]);
        { refresh the border style - it was bsSizeable in the designer }
        p.DialogForm.BorderStyle := p.BorderStyle;
        { don't show empty form }
        if p.DialogForm.ControlCount <> 0 then
        begin
          if Assigned(OnRunDialog) then
            OnRunDialog(p) else
            p.ShowModal;
          if p.ModalResult = mrCancel then
          begin
            Result := False;
            break;
          end;
        end;
      end;
{$ENDIF}
end;
{$HINTS ON}

procedure TfrxEngine.RunReportPages;

  procedure DoPages;
  var
    i: Integer;
  begin
    for i := 0 to Report.PagesCount - 1 do
      if Report.Pages[i] is TfrxReportPage then
      begin
        FPage := TfrxReportPage(Report.Pages[i]);
         { ignore subreport pages and invisible pages }
        if not FPage.IsSubReport and FPage.Visible then
          RunPage(FPage);
        if Report.Terminated then break;
        FFirstReportPage := False;
      end;
  end;

begin
  FFirstReportPage := True;
  if Report.DataSet = nil then
    DoPages
  else
  begin
    Report.DataSet.First;
    while not Report.DataSet.Eof do
    begin
      if Report.Terminated then break;
      DoPages;
      Report.DataSet.Next;
    end;
  end;
end;

procedure TfrxEngine.PreparePage(ErrorList: TStrings; PrepareVBands: Boolean);
var
  i, j, k: Integer;
  t, c: TfrxComponent;
  b: TfrxBand;
  Bands: TList;
  SortBands: TStringList;

  procedure ClearNils;
  var
    i: Integer;
  begin
    i := 0;
    while i < Bands.Count do
      if Bands[i] = nil then
        Bands.Delete(i) else
        Inc(i);
  end;

  procedure MakeTree(Obj: TObject; From: Integer);
  var
    i: Integer;
    b: TfrxBand;
  begin
    if Obj is TfrxReportPage then
    begin
     { fill the first level - TfrxReportPage.FMasterBands }
      for i := 0 to Bands.Count - 1 do
      begin
        b := Bands[i];
        if b = nil then continue;
        if b is TfrxMasterData then
        begin
          if TfrxDataBand(b).DataSet <> nil then  { ignore empty datasets }
            if PrepareVBands then
              TfrxReportPage(Obj).FVSubBands.Add(b)
            else
              TfrxReportPage(Obj).FSubBands.Add(b);
          Bands[i] := nil;
          MakeTree(b, i + 1);
        end;
      end;
    end
    else
    begin
      { fill next levels - TfrxBand.FSubBands }
      for i := From to Bands.Count - 1 do
      begin
        b := Bands[i];
        if b = nil then continue;
        { looking for sub-level bands }
        if b.BandNumber = TfrxBand(Obj).BandNumber + 1 then
        begin
          if TfrxDataBand(b).DataSet <> nil then  { ignore empty datasets }
            TfrxBand(Obj).FSubBands.Add(b);
          Bands[i] := nil;
          if not (b is TfrxDataBand6) then
            MakeTree(b, i + 1);
        end
        else if b.BandNumber <= TfrxBand(Obj).BandNumber then
          break;   { found higher-level data band }
      end;
    end;
  end;

  procedure ConnectHeaders;
  var
    i: Integer;
    b1, b2: TfrxBand;
  begin