frxengine.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

{******************************************}
{ }
{ FastReport v3.0 }
{ Report engine }
{ }
{ Copyright (c) 1998-2005 }
{ 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;
    FColumnTop:Extended;
    FCurBand:TfrxBand;
    FHeaderList:TfrxHeaderList; { list of header bands }
    FFirstReportPage:Boolean; { needed for correct setting of PreviewPages.FirstPage }
    FFooterList:TList; { list of footer bands }
    FIsFirstBand:Boolean; { needed for KeepTogether }
    FIsFirstPage:Boolean; { first and last page flags }
    FIsLastPage:Boolean; { }
    FKeepBand:TfrxBand;
    FKeeping:Boolean;
    FKeepOutline:TfrxXMLItem;
    FKeepPosition:Integer;
    FOutputTo:TfrxNullBand; { used in the subreports }
    FPage:TfrxReportPage; { currently proceeded page }
    FPageCurX:Extended;
    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 CheckGroups(Master:TfrxDataBand; Band:TfrxGroupHeader;
      ColumnKeepPos:Integer; SaveCurY:Extended);
    procedure CheckSubReports(Band:TfrxBand);
    procedure DoShow(Band:TfrxBand);
    procedure DrawSplit(Band:TfrxBand);
    procedure EndColumn;
    procedure EndKeep(Band:TfrxBand);
    procedure Finalize;
    procedure InitGroups(Band:TfrxBand; 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);
    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 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;
  FFooterList:= TList.Create;
  FVHeaderList:= TList.Create;
  FVPageList:= TList.Create;
  FAggregates:= TfrxAggregateList.Create(AReport);
end;

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

function TfrxEngine.Initialize:Boolean;
var
  i, j:Integer;
  p:TfrxDialogPage;
  b:TfrxDataBand;
begin
  PreviewPages.Initialize;
  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);
      { find aggregates }
      FAggregates.AddItems(FPage);
    end
    else
    begin
      { initialize dialog forms and controls }
      p:= TfrxDialogPage(Report.Pages[i]);
      p.Initialize;
    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
  Report.DataSets.Finalize;
  PreviewPages.Finish;
  Running:= False;
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
              PreviewPages.AddSourcePage(TfrxReportPage(Report.Pages[i]));

          { 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
    for i:= 0 to Bands.Count-1 do
    begin
      b1:= Bands[i];
      { looking for data band }
      if b1 is TfrxDataBand then
      begin
        if i > 0 then
        begin
          b2:= Bands[i-1];
          if b2 is TfrxHeader then { if top band is header, connect it }
          begin
            b1.FHeader:= b2;
            Bands[i-1]:= nil;
          end;
        end;

        if i < Bands.Count-1 then { if bottom band is footer, connect it }
        begin
          b2:= Bands[i+1];
          if b2 is TfrxFooter then
          begin
            b1.FFooter:= b2;
            Bands[i+1]:= nil;
          end;
        end;
      end;
    end;

    ClearNils;
    { now all headers/footers must be connected. If not, add an error }
    for i:= 0 to Bands.Count-1 do
    begin
      b1:= Bands[i];
      if (b1 is TfrxHeader) or (b1 is TfrxFooter) then
      begin
        ErrorList.Add(frxResources.Get('enUnconnHeader')+' '+b1.Name);
        Bands[i]:= nil;
      end;
    end;

    ClearNils;
  end;

  procedure ConnectGroups;
  var
    i, j:Integer;
    b1, b2:TfrxBand;
  begin
    { connect group headers }
    i:= 0;
    while i < Bands.Count do
    begin
      b1:= Bands[i];
      if b1 is TfrxGroupHeader then
      begin
        b1.FSubBands.Add(b1);
        Inc(i);
        { add all subsequent headers to the first header's FSubBands }
        while (i < Bands.Count) and (TfrxBand(Bands[i]) is TfrxGroupHeader) do
        begin
          b1.FSubBands.Add(Bands[i]);
          Inc(i);
        end;

        { search for databand }
        while (i < Bands.Count) and not (TfrxBand(Bands[i]) is TfrxDataBand) do
          Inc(i);

        { now we expect to see the databand }
        if (i = Bands.Count) or not (TObject(Bands[i]) is TfrxDataBand) then
          ErrorList.Add(frxResources.Get('enUnconnGroup')+' '+b1.Name) else
          TfrxBand(Bands[i]).FGroup:= b1;
      end
      else
        Inc(i);
    end;

    { connect group footers }
    for i:= 0 to Bands.Count-1 do
    begin
      b1:= Bands[i];
      if b1 is TfrxGroupFooter then
        for j:= i-1 downto 0 do
        begin
          b2:= Bands[j];
          if b2 is TfrxGroupHeader then { connect to top-nearest header }
          begin
            b2.FFooter:= b1;
            Bands[i]:= nil;
            Bands[j]:= nil;
            break;
          end;
        end;
    end;

    { remove header bands from the list }
    for i:= 0 to Bands.Count-1 do
    begin
      b1:= Bands[i];
      if b1 is TfrxGroupHeader then
        Bands[i]:= nil;
    end;

    { looking for footers w/o corresponding header }
    for i:= 0 to Bands.Count-1 do
    begin
      b1:= Bands[i];
      if b1 is TfrxGroupFooter then
      begin
        ErrorList.Add(frxResources.Get('enUnconnGFooter')+' '+b1.Name);
        Bands[i]:= nil;
      end;
    end;