frxengine.pas

报表控件。FastReport 是非常强大的报表控件

    b: TfrxNullBand;
    SaveCurY: Extended;
  begin
    b := TfrxNullBand.Create(nil);
    b.Width := PageWidth;
    b.Height := PageHeight;
    SaveCurY := CurY;
    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
      b.AlignChildren;
      ShowBand(b);
    finally
      CurY := SaveCurY;
      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);
            AddToHeaderList(b.FHeader);
            ShowBand(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, b);

        if not b.FooterAfterEach then
        begin
          if b.KeepFooter then
            StartKeep(b, FooterKeepPos);
          FKeepFooter := True;
          ShowBand(b.FFooter);
          if b.KeepFooter then
            EndKeep(b);
          FKeepFooter := False;
        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);

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

      if b.FGroup <> nil then
        ShowGroupFooters(TfrxGroupHeader(b.FGroup), 0, b);

      if not FirstTime then { some bands have been printed }
      begin
        RemoveFromVHeaderList(b.FHeader);
        if not b.FooterAfterEach then
          ShowBand(b.FFooter);
      end;

      if Report.Terminated then break;
    end;
  end;

begin
  FVMasterBand := HBand;
  FVMasterBand.FOriginalObjectsCount := FVMasterBand.Objects.Count;
  FVMasterBand.AllowSplit := False;

  FVHeaderList.Clear;
  FVPageList.Clear;
  FVPageList.Add(Pointer(0));

  CurVColumn := 0;
  ShowBandTree(TfrxReportPage(HBand.Page).FVSubBands);
  FVPageList.Add(Pointer(FVMasterBand.Objects.Count));
end;

procedure TfrxEngine.InitPage;
begin
  { fill in the header/footer lists }
  FHeaderList.Clear;
  if FPage.TitleBeforeHeader then
  begin
    FHeaderList.AddItem(FindBand(TfrxReportTitle), 0, False);
    FHeaderList.AddItem(FindBand(TfrxPageHeader), 0, False);
  end
  else
  begin
    FHeaderList.AddItem(FindBand(TfrxPageHeader), 0, False);
    FHeaderList.AddItem(FindBand(TfrxReportTitle), 0, False);
  end;

  { calculating the page/footer sizes }
  PageHeight := FPage.PaperHeight * fr01cm - FPage.TopMargin * fr01cm -
    FPage.BottomMargin * fr01cm;
  PageWidth := FPage.PaperWidth * fr01cm - FPage.LeftMargin * fr01cm -
    FPage.RightMargin * fr01cm;

  { reset the current position }
  CurX := 0;
  CurY := 0;
  CurColumn := 1;
  FPageCurX := 0;
  FVMasterBand := nil;

  FIsFirstPage := True;
  FIsLastPage := False;

  if (PreviewPages.Count = 0) or not FPage.PrintOnPreviousPage then
    AddPage
  else
  begin
    PreviewPages.CurPage := PreviewPages.Count - 1;
    CurY := PreviewPages.GetLastY;
    RemoveFromHeaderList(FindBand(TfrxReportTitle));
    ShowBand(TfrxReportTitle);
  end;

  if FFirstReportPage then
    PreviewPages.FirstPage := PreviewPages.CurPage;
  HeaderHeight := CurY;
  ShowBand(TfrxColumnHeader);
  FHeaderList.AddItem(FindBand(TfrxColumnHeader), 0, False);
  RemoveFromHeaderList(FindBand(TfrxReportTitle));
  OutlineRoot;
  AddPageOutline;
end;

function TfrxEngine.FooterHeight: Extended;
var
  Band: TfrxBand;
begin
  Result := 0;

  Band := FindBand(TfrxColumnFooter);
  if Band <> nil then
    Result := Result + Band.Height;
  Band := FindBand(TfrxPageFooter);
  if Band <> nil then
    Result := Result + Band.Height;
end;

function TfrxEngine.FindBand(Band: TfrxBandClass): TfrxBand;
begin
  Result := FPage.FindBand(Band);
end;

procedure TfrxEngine.ShowBand(Band: TfrxBand);
var
  chBand: TfrxBand;
begin
  if Band <> nil then
  begin
    if Band.KeepChild then
      StartKeep(Band);
    DoShow(Band);
    chBand := Band.Child;
    if (chBand <> nil) and (Band.Visible or Band.PrintChildIfInvisible) then
      ShowBand(chBand);
    if Band.KeepChild then
      EndKeep(Band);
    if Band is TfrxDataBand then
      FAggregates.AddValue(Band);
  end;
end;

procedure TfrxEngine.ShowBand(Band: TfrxBandClass);
begin
  ShowBand(FindBand(Band));
end;

procedure TfrxEngine.AddToHeaderList(Band: TfrxBand);
begin
  { only header bands with "Reprint on new page" flag can be added }
  if ((Band is TfrxHeader) and TfrxHeader(Band).ReprintOnNewPage) or
     ((Band is TfrxGroupHeader) and TfrxGroupHeader(Band).ReprintOnNewPage) then
    FHeaderList.AddItem(Band, FPageCurX, FKeeping);
end;

procedure TfrxEngine.AddToVHeaderList(Band: TfrxBand);
begin
  { only header bands with "Reprint on new page" flag can be added }
  if ((Band is TfrxHeader) and TfrxHeader(Band).ReprintOnNewPage) or
     ((Band is TfrxGroupHeader) and TfrxGroupHeader(Band).ReprintOnNewPage) then
    FVHeaderList.Add(Band);
end;

procedure TfrxEngine.RemoveFromHeaderList(Band: TfrxBand);
begin
  if Band <> nil then
    FHeaderList.RemoveItem(Band);
end;

procedure TfrxEngine.RemoveFromVHeaderList(Band: TfrxBand);
begin
  if Band <> nil then
    FVHeaderList.Remove(Band);
end;

function TfrxEngine.FreeSpace: Extended;
begin
  Result := PageHeight - FooterHeight - CurY;
end;

procedure TfrxEngine.Stretch(Band: TfrxBand);
var
  i: Integer;
  h, maxh: Extended;
  c, maxc: TfrxView;
  HaveSub, NeedShift: Boolean;

  procedure DoSubReports;
  var
    i: Integer;
    SaveCurX, SaveCurY, SavePageCurX: Extended;
    Sub: TfrxSubReport;
    MainBand: Boolean;
    AllObjects: TList;
    c: TfrxComponent;
  begin
    { create a band which will accepts all subsequent output }
    MainBand := False;
    if FOutputTo = nil then
    begin
      Band.FOriginalObjectsCount := Band.Objects.Count;
      FOutputTo := TfrxNullBand.Create(nil);
      MainBand := True;
    end;

    { save the current position }
    SaveCurX := CurX;
    SaveCurY := CurY;
    SavePageCurX := FPageCurX;

    { looking for subreport objects }
    for i := 0 to Band.Objects.Count - 1 do
      if TObject(Band.Objects[i]) is TfrxSubReport then
      begin
        Sub := TfrxSubReport(Band.Objects[i]);
        if not Sub.Visible or not Sub.PrintOnParent or not MainBand then continue;

        { set up all properties... }
        FPageCurX := SavePageCurX + Sub.Left;
        CurX := SaveCurX + Sub.Left;
        CurY := Sub.Top;
        { ...and run the subreport }
        RunPage(Sub.Page);
      end;

    { restore saved position }
    CurX := SaveCurX;
    CurY := SaveCurY;
    FPageCurX := SavePageCurX;

    if MainBand then
    begin
      { copy all output to the band }
      AllObjects := FOutputTo.AllObjects;

      for i := 0 to AllObjects.Count - 1 do
      begin
        c := AllObjects[i];
        if (c is TfrxView) and not (c is TfrxSubReport) then
        begin
          c.Left := c.AbsLeft;
          c.Top := c.AbsTop;
          c.Parent := Band;
        end;
        if c is TfrxStretcheable then
          TfrxStretcheable(c).StretchMode := smDontStretch;
      end;

      { Clear the FOutputTo property. Extra objects will be freed
        in the Unstretch method. }
      FOutputTo.Free;
      FOutputTo := nil;
    end;
  end;

  procedure ShiftObjects(Parent: TfrxReportComponent; Amount: Extended);
  var
    i: Integer;
    v: TfrxView;
    diff: Extended;
  begin
    for i := 0 to Parent.FShiftChildren.Count - 1 do
    begin