frxengine.pas

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

     ((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
  if FPage.EndlessHeight then
    Result := 1e+6
  else
    if FIsPrevPagePrint then
      Result := PageHeight - FPrevFooterHeight - CurY
    else 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 := 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.ParentFont := False;
          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
      v := Parent.FShiftChildren[i];
      if v.ShiftMode = smAlways then
      begin
        v.Top := v.Top + Amount;
        ShiftObjects(v, Amount + v.FShiftAmount);
      end
      else if v.ShiftMode = smWhenOverlapped then
      begin
        if not (Parent is TfrxBand) and (v.Top < Parent.Top + Parent.Height) then
        begin
          diff := Parent.Top + Parent.Height - v.Top;
          v.Top := Parent.Top + Parent.Height;
          ShiftObjects(v, diff + v.FShiftAmount);
        end
        else
          ShiftObjects(v, v.FShiftAmount);
      end
      else {if v.FShiftAmount <> 0 then}
        ShiftObjects(v, Amount + v.FShiftAmount);

      v.FShiftAmount := 0;
    end;
  end;

begin
  FCurBand := Band;
  HaveSub := False;
  NeedShift := False;
  PrepareShiftTree(Band);

  { it is not necessary for vertical bands }
  if Band <> FVMasterBand then
  begin
    { firing band OnBeforePrint event }
    Report.CurObject := Band.Name;
    Band.BeforePrint;
      Report.DoBeforePrint(Band);
  end;

  { firing OnBeforePrint events, stretching objects }
  for i := 0 to Band.Objects.Count - 1 do
  begin
    c := Band.Objects[i];
    if (c is TfrxSubreport) and TfrxSubreport(c).PrintOnParent then
      HaveSub := True;

    { skip getdata for vertical bands' objects }
    if Band <> FVMasterBand then
    begin
      Report.CurObject := c.Name;
      c.BeforePrint;
      if Band.Visible then
      begin
          Report.DoBeforePrint(c);
        if c.Visible then
        begin
          c.GetData;
            Report.DoNotifyEvent(c, c.OnAfterData);
        end;
      end;
    end;
    if not Band.Visible or not c.Visible then continue;

    if (c is TfrxStretcheable) and (TfrxStretcheable(c).StretchMode <> smDontStretch) then
    begin
      h := TfrxStretcheable(c).CalcHeight;
      if h > c.Height then
      begin
        c.FShiftAmount := h - c.Height; { needed to shift underlying objects }
        c.Height := h;                  { stretch the object }
        NeedShift := True;
      end
      else
        c.FShiftAmount := 0;
    end;
  end;

  if not Band.Visible then Exit;

  { shift objects }
  if NeedShift then
    ShiftObjects(Band, 0);

  { check subreports that have PrintOnParent option }
  if HaveSub then
    DoSubReports;

  { calculate the max height of the band }
  maxh := 0;
  maxc := nil;
  for i := 0 to Band.Objects.Count - 1 do
  begin
    c := Band.Objects[i];
    if c.Top + c.Height > maxh then
    begin
      maxh := c.Top + c.Height;
      maxc := c;
    end;
  end;
  if (maxc <> nil) and (maxc is TfrxDMPMemoView) and
    (ftBottom in TfrxDMPMemoView(maxc).Frame.Typ) then
    maxh := maxh + fr1CharY;
  if Band.Stretched then
    Band.Height := maxh;

  { fire Band.OnAfterCalcHeight event }
  Report.CurObject := Band.Name;
    Report.DoNotifyEvent(Band, Band.OnAfterCalcHeight);

  { set the height of objects that should stretch to max height }
  for i := 0 to Band.Objects.Count - 1 do
  begin
    c := Band.Objects[i];
    if (c is TfrxStretcheable) and (TfrxStretcheable(c).StretchMode = smMaxHeight) then
    begin
      c.Height := maxh - c.Top;
      if (c is TfrxDMPMemoView) and (ftBottom in TfrxDMPMemoView(c).Frame.Typ) then
        c.Height := c.Height - fr1CharY;
    end;
  end;
end;

procedure TfrxEngine.UnStretch(Band: TfrxBand);
var
  i: Integer;
  c: TfrxView;
begin
  { fire OnAfterPrint event }
  if Band.Visible then
    for i := 0 to Band.Objects.Count - 1 do
    begin
      c := Band.Objects[i];
      Report.CurObject := c.Name;
        Report.DoAfterPrint(c);
    end;

  { restore state }
  for i := 0 to Band.Objects.Count - 1 do
  begin
    c := Band.Objects[i];
    c.AfterPrint;
  end;

  Report.CurObject := Band.Name;
    Report.DoAfterPrint(Band);
  Band.AfterPrint;

  { remove extra band objects if any }
  if Band.FOriginalObjectsCount <> -1 then
  begin
    while Band.Objects.Count > Band.FOriginalObjectsCount do
      TObject(Band.Objects[Band.Objects.Count - 1]).Free;
    Band.FOriginalObjectsCount := -1;
  end;
end;

procedure TfrxEngine.AddPage;
var
  i: Integer;
  SaveCurX: Extended;
  SaveCurLine, SaveCurLineThrough: Integer;
  Band: TfrxBand;
begin
  FIsPrevPagePrint := False;
  PreviewPages.AddPage(FPage);
  CurY := 0;
  Band := FindBand(TfrxOverlay);
  if (Band <> nil) and not TfrxOverlay(Band).PrintOnTop then
    ShowBand(Band);

  CurY := 0;
  SaveCurX := CurX;
  FFirstColumnY := 0;

  for i := 0 to FHeaderList.Count - 1 do
  begin
   { use own CurX - we may be inside subreports now }
    CurX := FHeaderList[i].Left;
    Band := FHeaderList[i].Band;
    if Band = FStartNewPageBand then
      continue;

    if FIsFirstPage and (Band is TfrxPageHeader) and
      not TfrxPageHeader(Band).PrintOnFirstPage then
    begin
      if Band.PrintChildIfInvisible then
        Band := Band.Child
      else
        continue;
    end;

    if Band <> nil then
      if {not FKeeping and} not FHeaderList[i].IsInKeepList or FKeepFooter or (FKeeping and (FKeepBand.FHeader = Band)) then
        begin
          if ((Band is TfrxHeader) and FDontShowHeaders) or ((Band is TfrxHeader) and (FLastBandOnPage = Band)) then
           continue;
          Band.Overflow := True;
          SaveCurLine := CurLine;
          SaveCurLineThrough := CurLineThrough;
          CurLine := Band.FLineN;
          CurLineThrough := Band.FLineThrough;
          FCallFromAddPage := True;

          { fix the stack overflow error if call NewPage from ReportTitle }
          if Band is TfrxReportTitle then
            FHeaderList[i].Band := nil;
          if Band is TfrxPageHeader then
            FFirstColumnY := Band.Height;

          ShowBand(Band);
          if (FIsFirstBand) and (band is TfrxReportTitle) then
            FIsFirstBand := False;
          FCallFromAddPage := False;
          Band.Overflow := False;
          CurLine := SaveCurLine;
          CurLineThrough := SaveCurLineThrough;
        end;
  end;

  CurX := SaveCurX;
end;

procedure TfrxEngine.EndPage;
var
  Band: TfrxBand;
  Offset: Extended;

  procedure ShowBand(Band: TfrxBand);
  begin
    if Band = nil then Exit;

    Stretch(Band);
    try
      if Band.Visible then
      begin
        Band.Left := 0;
        Band.Top := CurY;

        if Band is TfrxPageFooter then
          if (FIsFirstPage and not TfrxPageFooter(Band).PrintOnFirstPage) or
             (FIsLastPage and not TfrxPageFooter(Band).PrintOnLastPage) then
          Exit;

        if not PreviewPages.BandExists(Band) then
          PreviewPages.AddObject(Band);
        CurY := CurY + Band.Height;
      end;
    finally
      UnStretch(Band);
    end;

    FAggregates.Reset(Band);
  end;

begin
  if not FCallFromEndPage then
    EndColumn;
  if not FIsLastPage then
  begin
    CurX := FPageCurX;
    CurColumn := 1;
  end;

  if FIsLastPage and not FCallFromEndPage then
  begin
    { avoid stack overflow if reportsummary does not fit on the page }
    FCallFromEndPage := True;
    try
      Offset := CurY;
      Band := FindBand(TfrxReportSummary);
      Self.ShowBand(Band);
      if (Band <> nil) and (FPage.EndlessHeight) then
      begin
        Offset := CurY - Offset;
        PageHeight := PageHeight + Offset;
        TfrxPreviewPages(PreviewPages).UpdatePageDimensions(FPage, PageWidth + FPage.LeftMargin * fr01cm + FPage.RightMargin * fr01cm, PageHeight + FPage.TopMargin * fr01cm + FPage.BottomMargin * fr01cm);
      end;
    finally
      FCallFromEndPage := False;
    end;
  end;

  Band := FindBand(TfrxPageFooter);
  if Band <> nil then
  begin
    CurY := PageHeight - Band.Height;
    if FIsLastPage and TfrxPageFooter(Band).PrintOnLastPage then
      FPrevFooterHeight := Band.Height
    else FPrevFooterHeight := 0;
  end;
  ShowBand(Band);
  Band := FindBand(TfrxOverlay);
  if (Band <> nil) and TfrxOverlay(Band).PrintOnTop then
  begin
    CurY := 0;
    ShowBand(Band);
  end;

  FIsFirstPage := False;
end;

procedure TfrxEngine.AddColumn;
var
  i: Integer;
  AddX: Extended;

  procedure DoShow(Band: TfrxBand);
  begin
    Band.Overflow := True;
    Stretch(Band);

    try
      if Band.Visible then
      begin
        Band.Left := CurX;
        Band.Top := CurY;
        PreviewPages.AddObject(Band);
        CurY := CurY + Band.Height;
      end;
    finally
      UnStretch(Band);
      Band.Overflow := False;
    end;
  end;

  procedure ShowBand(Band: TfrxBand);
  begin
    while Band <> nil do
    begin
      DoShow(Band);
      if Band.Visible or Band.PrintChildIfInvisible then
        Band := Band.Child else
        break;
    end;
  end;

begin
  CurColumn := CurColumn + 1;
  AddX := frxStrToFloat(FPage.ColumnPositions[CurColumn - 1]) * fr01cm;
  CurY := FFirstColumnY;

  for i := 0 to FHeaderList.Count - 1 do
  begin
    CurX := FHeaderList[i].Left + AddX;
    if not (FHeaderList[i].Band is TfrxPageHeader) then
      ShowBand(FHeaderList[i].Band);
  end;

  CurX := FPageCurX + AddX;
end;

procedure TfrxEngine.EndColumn;
var
  Band: TfrxBand;
begin
  Band := FindBand(TfrxColumnFooter);
  if Band = nil then Exit;

  Stretch(Band);
  try
    if Band.Visible then
    begin
      Band.Left := CurX - FPageCurX;
      Band.Top := CurY;
      PreviewPages.AddObject(Band);
      { move the current position }
      CurY := CurY + Band.Height;
    end;
  finally
    UnStretch(Band);
  end;

  FAggregates.Reset(Band);
end;

procedure TfrxEngine.NewPage;