frxengine.pas

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

    ClearNils;
  end;

begin
  SortBands:= TStringList.Create;
  SortBands.Sorted:= True;

  { align all objects with Align property<>baNone }
  FPage.AlignChildren;

  { clear all page SubBands }
  if PrepareVBands then
    FPage.FVSubBands.Clear
  else
    FPage.FSubBands.Clear;

  for i:= 0 to FPage.Objects.Count-1 do
  begin
    t:= FPage.Objects[i];
    if t is TfrxBand then
    begin
      b:= TfrxBand(t);
      if b.Vertical<>PrepareVBands then
        continue;
      PrepareShiftTree(b);
      b.FSubBands.Clear;
      b.FHeader:= nil;
      b.FFooter:= nil;
      b.FGroup:= nil;
      b.FHasVBands:= False;
      if b is TfrxDataBand then
        if (TfrxDataBand(b).DataSet = nil) and (TfrxDataBand(b).RowCount > 0) then
        begin
          TfrxDataBand(b).DataSet:= TfrxDataBand(b).VirtualDataSet;
          TfrxDataBand(b).DataSet.Initialize;
        end;

      { connect objects to vertical bands }
      if not PrepareVBands then
        for j:= 0 to FPage.Objects.Count-1 do
        begin
          t:= FPage.Objects[j];
          if (t is TfrxBand) and TfrxBand(t).Vertical then
          begin
            k:= 0;
            while k < b.Objects.Count do
            begin
              c:= b.Objects[k];
              if (c.Left >= t.Left-1e-4) and
                (c.Left+c.Width <= t.Left+t.Width+1e-4) then
              begin
                b.FHasVBands:= True;
                c.Parent:= t;
                THackComponent(c).FOriginalBand:= b;
                c.Left:= c.Left-t.Left;
              end
              else
                Inc(k);
            end;
          end;
        end;
    end;
  end;

  { sort bands by position }
  for i:= 0 to FPage.Objects.Count-1 do
  begin
    t:= FPage.Objects[i];
    if t is TfrxBand then
    begin
      b:= TfrxBand(t);
      if b.Vertical<>PrepareVBands then
        continue;
      if b.BandNumber in [4..13] then
        if b.Vertical then
          SortBands.AddObject(Format('%9.2f', [b.Left]), b)
        else
          SortBands.AddObject(Format('%9.2f', [b.Top]), b);
    end;
  end;

  { copy sorted items to TList-it's easier to work with it }
  Bands:= TList.Create;
  for i:= 0 to SortBands.Count-1 do
  begin
    t:= TfrxComponent(SortBands.Objects[i]);
    Bands.Add(t);
  end;

  SortBands.Free;

  ConnectGroups;
  ConnectHeaders;
  MakeTree(FPage, 0);

  ClearNils;
  for i:= 0 to Bands.Count-1 do
  begin
    t:= Bands[i];
    ErrorList.Add(frxResources.Get('enBandPos')+' '+t.Name);
  end;

  Bands.Free;
end;

procedure TfrxEngine.PrepareShiftTree(Band:TfrxBand);
var
  i, j:Integer;
  c0, c1:TfrxReportComponent;
  Found:TfrxReportComponent;
  min, diff:Extended;
begin
  if Band.FShiftChildren.Count<>0 then
    Exit;

  Band.FShiftChildren.Clear;
  for i:= 0 to Band.Objects.Count-1 do
  begin
    c0:= Band.Objects[i];
    c0.FShiftChildren.Clear;
  end;

  for i:= 0 to Band.Objects.Count-1 do
  begin
    c0:= Band.Objects[i];
    min:= 1e10;
    Found:= nil;

    for j:= 0 to Band.Objects.Count-1 do
    begin
      c1:= Band.Objects[j];
      diff:= c0.Top-(c1.Top+c1.Height);
      if (diff >-1e-4) and (c1.Left < c0.Left+c0.Width-1e-4) and
        (c0.Left < c1.Left+c1.Width-1e-4) then
        if diff < min then
        begin
          min:= diff;
          Found:= c1;
        end;
    end;

    if Found<>nil then
      Found.FShiftChildren.Add(c0)
    else
      Band.FShiftChildren.Add(c0);
  end;
end;

function TfrxEngine.CanShow(Obj:TObject; PrintIfDetailEmpty:Boolean):Boolean;
var
  i:Integer;
  Bands:TList;
  b:TfrxDataBand;
  res:Boolean;
begin
  if Obj is TfrxReportPage then
    Bands:= TfrxReportPage(Obj).FSubBands else
    Bands:= TfrxBand(Obj).FSubBands;

  Result:= True;
  { Check all subdetail bands to ensure they all have records }
  if not PrintIfDetailEmpty then
  begin
    Result:= False;
    if (Bands.Count = 0) and not (Obj is TfrxPage) then
      Result:= True;

    for i:= 0 to Bands.Count-1 do
    begin
      b:= Bands[i];
      if b.DataSet<>nil then
      begin
        Report.DoNotifyEvent(b, b.OnMasterDetail);
        b.DataSet.First;

        while not b.DataSet.Eof do
        begin
          res:= CanShow(b, b.PrintIfDetailEmpty);
          if res then
          begin
            Result:= True;
            break;
          end
          else
            b.DataSet.Next;
        end;

{ if not b.DataSet.Eof then
          Result:= Result or CanShow(b, b.PrintIfDetailEmpty);}
      end;
    end;
  end;
end;

procedure TfrxEngine.ResetSuppressValues(Band:TfrxBand);
var
  i:Integer;
begin
  for i:= 0 to Band.Objects.Count-1 do
    if TObject(Band.Objects[i]) is TfrxCustomMemoView then
      THackMemoView(Band.Objects[i]).FLastValue:= Null;
end;

procedure TfrxEngine.InitGroups(Band:TfrxBand; Index:Integer; ResetLineN:Boolean = False);
var
  i:Integer;
  b:TfrxGroupHeader;
begin
  for i:= Index to Band.FSubBands.Count-1 do
  begin
    b:= Band.FSubBands[i];
    if ResetLineN then
    begin
      b.FLineN:= 1;
      b.FLineThrough:= 1;
      ResetSuppressValues(b);
    end
    else
    begin
      Inc(b.FLineN);
      if i < Band.FSubBands.Count-1 then
        TfrxBand(Band.FSubBands[i+1]).FLineN:= 0;
      Inc(b.FLineThrough);
    end;
    CurLine:= b.FLineN;
    CurLineThrough:= b.FLineThrough;
    Report.CurObject:= b.Name;
    b.FLastValue:= Report.Calc(b.Condition);
    if b.KeepTogether then
      StartKeep(b);
    ShowBand(b);
    AddBandOutline(b);
    if b.Vertical then
      AddToVHeaderList(b)
    else
      AddToHeaderList(b);
  end;
end;

procedure TfrxEngine.ShowGroupFooters(Band:TfrxGroupHeader; Index:Integer);
var
  i:Integer;
  b:TfrxGroupHeader;
begin
  for i:= Band.FSubBands.Count-1 downto Index do
  begin
    b:= Band.FSubBands[i];
    ShowBand(b.FFooter);
    OutlineUp(b);
    if b.Vertical then
      RemoveFromVHeaderList(b)
    else
      RemoveFromHeaderList(b);
    if b.KeepTogether then
      EndKeep(b);
  end;
end;

procedure TfrxEngine.CheckGroups(Master:TfrxDataBand; Band:TfrxGroupHeader;
  ColumnKeepPos:Integer; SaveCurY:Extended);
var
  i:Integer;
  b:TfrxGroupHeader;
  NextNeeded:Boolean;
begin
  for i:= 0 to Band.FSubBands.Count-1 do
  begin
    b:= Band.FSubBands[i];

    Report.CurObject:= b.Name;
    if Report.Calc(b.Condition)<>b.FLastValue then
    begin
      Master.CurColumn:= Master.Columns;
      CheckBandColumns(Master, ColumnKeepPos, SaveCurY);

      { avoid exception in uni-directional datasets }
      NextNeeded:= True;
      try
        Master.DataSet.Prior;
      except
        NextNeeded:= False;
      end;
      ShowGroupFooters(Band, i);
      if NextNeeded then
        Master.DataSet.Next;

      InitGroups(Band, i);
      Master.FLineN:= 1;
      ResetSuppressValues(Master);
      break;
    end;
  end;
end;

procedure TfrxEngine.CheckBandColumns(Band:TfrxDataBand; ColumnKeepPos:Integer;
  SaveCurY:Extended);
begin
  if Band.Columns > 1 then
  begin
    { collect max position in b.FMaxY }
    if CurY > Band.FMaxY then
      Band.FMaxY:= CurY;
    { all columns have been printed }
    if Band.CurColumn >= Band.Columns then
    begin
      { need page break }
      if Band.FMaxY > PageHeight-FooterHeight then
      begin
        if FKeeping then { standard keep procedure }
          NewColumn
        else
        begin
          PreviewPages.CutObjects(ColumnKeepPos);
          NewColumn;
          PreviewPages.PasteObjects(CurX, CurY);
          CurY:= CurY+Band.FMaxY-SaveCurY;
        end;
      end
      else
        CurY:= Band.FMaxY; { start the new band from saved b.FMaxY }
    end
    else
      CurY:= SaveCurY; { start the new band from saved SaveCurY }
    if Band.Visible then
      Band.CurColumn:= Band.CurColumn+1;
  end;
end;

procedure TfrxEngine.NotifyObjects(Band:TfrxBand);
var
  i:Integer;
  c:TfrxComponent;
begin
  for i:= 0 to NotifyList.Count-1 do
  begin
    c:= NotifyList[i];
    if c<>nil then
      c.OnNotify(Band);
  end;
end;

procedure TfrxEngine.RunPage(Page:TfrxReportPage);

  { "Null" band contains all free-placed objects that don't have a parent band }
  procedure ShowNullBand;
  var
    i:Integer;
    b:TfrxNullBand;
  begin
    b:= TfrxNullBand.Create(nil);
    for i:= 0 to FPage.Objects.Count-1 do
      if not (TObject(FPage.Objects[i]) is TfrxBand) then
        b.Objects.Add(FPage.Objects[i]);
    try
      ShowBand(b);
    finally
      b.Objects.Clear;
      b.Free;
    end;
  end;

  { Band tree is the structure that we created in the PreparePage method }
  procedure ShowBandTree(Obj:TObject);
  var
    i:Integer;
    Bands:TList;
    b:TfrxDataBand;
    FirstTime:Boolean;
    FooterKeepPos, ColumnKeepPos:Integer;
    SaveCurY:Extended;
  begin
    Application.ProcessMessages;
    if Report.Terminated then Exit;

    FooterKeepPos:= 0;
    ColumnKeepPos:= 0;
    SaveCurY:= CurY;
    if Obj is TfrxReportPage then
      Bands:= TfrxReportPage(Obj).FSubBands else
      Bands:= TfrxBand(Obj).FSubBands;

    for i:= 0 to Bands.Count-1 do
    begin
      b:= Bands[i];
      if b.DataSet = nil then
        continue;
      b.DataSet.First;
      b.FLineN:= 1;
      b.FLineThrough:= 1;
      b.CurColumn:= 1;
      FirstTime:= True;
      ResetSuppressValues(b);

      while not b.DataSet.Eof do
      begin
        if CanShow(b, b.PrintIfDetailEmpty) then
        begin
          if FirstTime then
          begin
            if b.KeepTogether then
              StartKeep(b);
            if b.KeepHeader and (b.FHeader<>nil) then
              StartKeep(b);
            ShowBand(b.FHeader);
            AddToHeaderList(b.FHeader);
          end
          { keeping a master-detail differs from keeping a group }
          else if (b.FGroup = nil) and b.KeepTogether then
            StartKeep(b);

          if b.FGroup<>nil then
            if FirstTime then
              InitGroups(b.FGroup, 0, True) else
              CheckGroups(b, TfrxGroupHeader(b.FGroup), ColumnKeepPos, SaveCurY);

          if b.KeepFooter then
            FooterKeepPos:= PreviewPages.GetCurPosition;
          if (b.Columns > 1) and (b.CurColumn = 1) then
            ColumnKeepPos:= PreviewPages.GetCurPosition;

          SaveCurY:= CurY;
          CurLine:= b.FLineN;
          CurLineThrough:= b.FLineThrough;
          ShowBand(b);
          NotifyObjects(b);

          if FirstTime then
            if b.KeepHeader and (b.FHeader<>nil) then
              EndKeep(b);
          FirstTime:= False;

          Inc(b.FLineN);
          Inc(b.FLineThrough);
          CheckBandColumns(b, ColumnKeepPos, SaveCurY);
          AddBandOutline(b);
          ShowBandTree(b);
          OutlineUp(b);
        end;

        FIsFirstBand:= False;

        if b.FooterAfterEach then
          ShowBand(b.FFooter);

        { keeping a master-detail differs from keeping a group }
        if (b.FGroup = nil) and b.KeepTogether then
          EndKeep(b);
        b.DataSet.Next;
        if b.RowCount<>0 then
          if b.FLineN > b.RowCount then break;

        if Report.Terminated then break;
      end;

      { update the CurY if band is multicolumn }
      b.CurColumn:= b.Columns;
      CheckBandColumns(b, ColumnKeepPos, SaveCurY);

      if not FirstTime then { some bands have been printed }
      begin
        if b.FGroup<>nil then
          ShowGroupFooters(TfrxGroupHeader(b.FGroup), 0);

        if not b.FooterAfterEach then
        begin
          if b.KeepFooter then
            StartKeep(b, FooterKeepPos);
          ShowBand(b.FFooter);
          if b.KeepFooter then
            EndKeep(b);
        end;
        RemoveFromHeaderList(b.FHeader);
        if (b.FGroup<>nil) and b.KeepTogether then
          EndKeep(b);
      end;

      if Report.Terminated then break;
      FIsFirstBand:= False;
    end;
  end;

  procedure ShowPage;
  begin
    if CanShow(FPage, Report.EngineOptions.PrintIfEmpty) then
    begin
      InitPage;
      ShowNullBand;

      if Assigned(Report.OnManualBuild) then
        Report.OnManualBuild(FPage)
      else if Trim(FPage.OnManualBuild)<>'' then
        Report.DoNotifyEvent(FPage, FPage.OnManualBuild)
      else
        ShowBandTree(FPage);

      ShowBand(TfrxReportSummary);
      FIsLastPage:= True;
      EndPage;
      FIsLastPage:= False;
    end;
  end;

begin
  { The Page parameter needed only for subreport pages. General is FPage }
  if Page.IsSubReport then
  begin
    ShowBandTree(Page);
    Exit;
  end;

  FIsFirstBand:= True;
  Report.DoNotifyEvent(FPage, FPage.OnBeforePrint);

  if FPage.DataSet<>nil then
  begin
    FPage.DataSet.First;

    while not FPage.DataSet.Eof do
    begin
      if Report.Terminated then break;
      ShowPage;
      FPage.DataSet.Next;
    end;
  end
  else
    ShowPage;

  Report.DoNotifyEvent(FPage, FPage.OnAfterPrint);
end;

procedure TfrxEngine.ShowVBands(HBand:TfrxBand);

  procedure ShowBandTree(Bands:TList);
  var
    i:Integer;
    b:TfrxDataBand;
    FirstTime:Boolean;
  begin
    if Report.Terminated then Exit;

    for i:= 0 to Bands.Count-1 do
    begin
      b:= Bands[i];
      if b.DataSet = nil then
        continue;
      b.DataSet.First;
      b.FLineN:= 1;
      b.FLineThrough:= 1;
      b.CurColumn:= 1;
      FirstTime:= True;
      ResetSuppressValues(b);

      while not b.DataSet.Eof do
      begin
        if FirstTime then
        begin
          ShowBand(b.FHeader);
          AddToVHeaderList(b.FHeader);
        end;

        if b.FGroup<>nil then
          if FirstTime then
            InitGroups(b.FGroup, 0, True) else
            CheckGroups(b, TfrxGroupHeader(b.FGroup), 0, 0);

        FirstTime:= False;

        CurLine:= b.FLineN;
        CurLineThrough:= b.FLineThrough;
        ShowBand(b);
        NotifyObjects(b);

        Inc(b.FLineN);
        Inc(b.FLineThrough);
        ShowBandTree(b.FSubBands);

        if b.FooterAfterEach then
          ShowBand(b.FFooter);

        b.DataSet.Next;
        if b.RowCount<>0 then
          if b.FLineN > b.RowCount then break;
        if Report.Terminated then break;