frxengine.pas

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

      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
        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
  PreviewPages.AddPage(FPage);
  CurY := 0;

  Band := FindBand(TfrxOverlay);
  if (Band <> nil) and not TfrxOverlay(Band).PrintOnTop then
    ShowBand(Band);

  CurY := 0;
  SaveCurX := CurX;
  HeaderHeight := 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
      continue;

    if Band <> nil then
      if not FKeeping or not FHeaderList[i].IsInKeepList then
      begin
        if (Band is TfrxHeader) and FDontShowHeaders 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
          HeaderHeight := Band.Height;

        ShowBand(Band);

        FCallFromAddPage := False;
        Band.Overflow := False;
        CurLine := SaveCurLine;
        CurLineThrough := SaveCurLineThrough;
      end;
  end;

  CurX := SaveCurX;
end;

procedure TfrxEngine.EndPage;
var
  Band: TfrxBand;

  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 FPage.Columns > 1 then
  begin
    EndColumn;
    if not FIsLastPage then
    begin
      CurX := FPageCurX;
      CurColumn := 1;
    end;
  end;

  ShowBand(FindBand(TfrxColumnFooter));

  if FIsLastPage and not FCallFromEndPage then
  begin
    { avoid stack overflow if reportsummary does not fit on the page }
    FCallFromEndPage := True;
    try
      Self.ShowBand(TfrxReportSummary);
    finally
      FCallFromEndPage := False;
    end;
  end;

  Band := FindBand(TfrxPageFooter);
  if Band <> nil then
    CurY := PageHeight - Band.Height;
  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 := HeaderHeight;

  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);
    end;
  finally
    UnStretch(Band);
  end;

  FAggregates.Reset(Band);
end;

procedure TfrxEngine.NewPage;
begin
  if FKeeping then
  begin
    if FKeepFooter then
      FAggregates.DeleteValue(FKeepBand);
    PreviewPages.CutObjects(FKeepPosition);
  end;
  EndPage;
  AddPage;
  if FKeeping then
  begin
    FAggregates.EndKeep;
    PreviewPages.PasteObjects(0, CurY);
    PreviewPages.Outline.ShiftItems(FKeepOutline, Round(CurY));
    CurY := PreviewPages.GetLastY;
    if FKeepFooter then
      FAggregates.AddValue(FKeepBand);
  end;
  FKeeping := False;
  AddPageOutline;
end;

procedure TfrxEngine.NewColumn;
begin
  if CurColumn >= FPage.Columns then
    NewPage
  else
  begin
    EndColumn;
    AddColumn;
  end;
end;

procedure TfrxEngine.DrawSplit(Band: TfrxBand);
var
  i: Integer;
  List, SaveObjects, ShiftedList: TList;
  View: TfrxView;
  StrView: TfrxStretcheable;
  CurHeight, Corr: Extended;

  procedure ShiftObjects(TopView: TfrxView; Delta: Extended);
  var
    i: Integer;
    View: TfrxView;
  begin
    for i := 0 to List.Count - 1 do
    begin
      View := List[i];
      if (View <> TopView) and (ShiftedList.IndexOf(View) = -1) and
         (View.Top >= TopView.Top + TopView.Height) and
         (View.Left < TopView.Left + TopView.Width) and
         (TopView.Left < View.Left + View.Width) then
      begin
        View.Top := View.Top + Delta;
        ShiftedList.Add(View);
      end;
    end;
  end;

  procedure DrawPart;
  var
    i: Integer;
    View: TfrxView;
  begin
    { draw current objects }
    Band.Left := CurX;
    Band.Top := CurY;
    PreviewPages.AddObject(Band);
    { add new column/page }
    if List.Count > 0 then
      NewColumn else
      CurY := CurY + Band.Height;

    { correct the top coordinate of remained objects }
    Band.Objects.Clear;
    for i := 0 to List.Count - 1 do
    begin
      View := List[i];
      View.Top := View.Top - CurHeight;
      { restore the height of stretched objects }
      if View is TfrxStretcheable then
      begin
        if View.Top < 0 then
          View.Top := 0;
        View.Height := TfrxStretcheable(View).FSaveHeight;
      end;
    end;
  end;

  procedure CalcBandHeight;
  var
    i: Integer;
    View: TfrxView;
  begin
    Band.Height := 0;
    { calculate the band's height }
    for i := 0 to Band.Objects.Count - 1 do
    begin
      View := Band.Objects[i];
      if View.Top + View.Height > Band.Height then
        Band.Height := View.Top + View.Height;
    end;

    { correct objects with StretchToMaxHeight or BandAlign = baBottom }
    if List.Count = 0 then
      for i := 0 to Band.Objects.Count - 1 do
      begin
        View := Band.Objects[i];
        if View.Align = baBottom then
          View.Top := Band.Height - View.Height
        else if (View is TfrxStretcheable) and
          (TfrxStretcheable(View).StretchMode = smMaxHeight) then
          View.Height := Band.Height - View.Top;
      end;
  end;

begin
  List := TList.Create;
  SaveObjects := TList.Create;
  ShiftedList := TList.Create;

  { initializing lists }
  for i := 0 to Band.Objects.Count - 1 do
  begin