frxengine.pas

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

begin
  if FKeeping then
  begin
    if FKeepFooter then
      FAggregates.DeleteValue(FKeepBand);
    PreviewPages.CutObjects(FKeepPosition);
    CurY := PreviewPages.GetLastY;
  end;
  FLastBandOnPage := FCurBand;
  EndPage;
  AddPage;
  FLastBandOnPage := nil;
  if FKeeping then
  begin
    FAggregates.EndKeep;
    PreviewPages.PasteObjects(0, CurY);
    PreviewPages.Outline.ShiftItems(FKeepOutline, Round(CurY));
    PreviewPages.ShiftAnchors(FKeepAnchor, 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, ObjCount: Integer;
  List, SaveObjects, ShiftedList: TList;
  View: TfrxView;
  StrView: TfrxStretcheable;
  CurHeight, Corr: Extended;
  ObjStretch: Boolean;

  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 }
    CurY := CurY + Band.Height;
    FCurBand := Band;
    if List.Count > 0 then NewColumn;
    { 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
       { there is no splited objects, correct top positions }
        if not ObjStretch and (List.Count = ObjCount) then
          View.Top := TfrxStretcheable(View).FSavedTop;

        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;
  ObjStretch := False;

  { initializing lists }
  for i := 0 to Band.Objects.Count - 1 do
  begin
    View := Band.Objects[i];
    if not (View is TfrxSubreport) then
      List.Add(View);
    SaveObjects.Add(View);
    if View is TfrxStretcheable then
    begin
      TfrxStretcheable(View).InitPart;
      TfrxStretcheable(View).FSaveHeight := View.Height;
    end;
  end;

  Band.Objects.Clear;
  ObjCount := List.Count;

  CurHeight := FreeSpace;

  while List.Count > 0 do
  begin
    ShiftedList.Clear;
    i := 0;

    while i < List.Count do
    begin
      View := List[i];

      { whole object fits in the page }
      if View.Top + View.Height <= CurHeight then
      begin
        { add to band and remove from list }
        Band.Objects.Add(View);
        List.Remove(View);
        { prepare last part of text }
        if View is TfrxStretcheable then
          TfrxStretcheable(View).DrawPart;
        continue;
      end;

      if View is TfrxStretcheable then
      begin
        StrView := List[i];
        { Save object top for streched object }
        StrView.FSavedTop := StrView.Top;
        { view is inside draw area }
        if StrView.Top < CurHeight then
        begin
          { trying to place it }
          StrView.Height := CurHeight - StrView.Top;
          { DrawPart method returns the amount of unused space. If view
            can't fit in the height, this method returns the Height }
          Corr := StrView.DrawPart;
  //         ShiftObjects(StrView, Corr);


          if Abs(Corr - StrView.Height) < 1e-4 then
          begin
            { view can't fit, return back the height and correct the top }
            StrView.Top := CurHeight;
            { shift the underlying objects down }
            { must be called after Top initialization }
            ShiftObjects(StrView, Corr);
            StrView.Height := StrView.FSaveHeight;
          end
          else
          begin
            { shift the underlying objects down }
            ShiftObjects(StrView, Corr);
            { view can draw something }
            Band.Objects.Add(StrView);
            { decrease the remained height }
            StrView.FSaveHeight := StrView.FSaveHeight - StrView.Height + Corr;
            ObjStretch := True;
          end;

        end;
      end
      else
      begin
        { non-stretcheable view can't be splitted, draw it in the next page }
        if View.Top < CurHeight then
        begin
          { shift the underlying objects down }
          ShiftObjects(View, CurHeight - View.Top);
          View.Top := CurHeight;
        end;
      end;

      Inc(i);
    end;

    { draw the visible part }
    CalcBandHeight;
    DrawPart;
    CurHeight := FreeSpace;
  end;

  { get objects back to the band }
  Band.Objects.Clear;
  for i := 0 to SaveObjects.Count - 1 do
    Band.Objects.Add(SaveObjects[i]);

  List.Free;
  SaveObjects.Free;
  ShiftedList.Free;
end;

procedure TfrxEngine.CheckSuppress(Band: TfrxBand);
var
  i: Integer;
  c: TfrxComponent;
  hasSuppress: Boolean;
begin
  hasSuppress := False;
  for i := 0 to Band.Objects.Count - 1 do
  begin
    c := Band.Objects[i];
    if (c is TfrxCustomMemoView) and TfrxCustomMemoView(c).SuppressRepeated then
    begin
      hasSuppress := True;
      TfrxCustomMemoView(c).ResetSuppress;
    end;
  end;

  if hasSuppress and not Band.FHasVBands then
  begin
    UnStretch(Band);
    CurLine := Band.FLineN;
    CurLineThrough := Band.FLineThrough;
    SecondScriptCall := True;
    try
      Stretch(Band);
    finally
      SecondScriptCall := False;
    end;
  end;
end;

procedure TfrxEngine.DoShow(Band: TfrxBand);
var
  IsMultiColumnBand, IsSplit, IsKeept: Boolean;
  TempBand: TfrxBand;
  SaveCurX: Extended;
  SavePageList: TList;
  SaveVMasterBand: TfrxBand;
  i: Integer;

  procedure RenderVBand;
  var
    i, j, SavePageN: Integer;
    SaveCurY: Extended;
    c: TfrxComponent;
    SaveObjects: TList;
  begin
    SaveObjects := TList.Create;
    SavePageN := PreviewPages.CurPage;
    SaveCurY := CurY;
    { the next NewPage call shouldn't form a new page }
    PreviewPages.AddPageAction := apWriteOver;

    { save hband objects }
    for i := 0 to FVMasterBand.Objects.Count - 1 do
      SaveObjects.Add(FVMasterBand.Objects[i]);

    for i := 0 to FVPageList.Count - 2 do
    begin
      FVMasterBand.Objects.Clear;
      for j := Integer(FVPageList[i]) to Integer(FVPageList[i + 1]) - 1 do
      begin
        c := SaveObjects[j];
        FVMasterBand.Objects.Add(c);
      end;
      PreviewPages.AddObject(FVMasterBand);

      if i <> FVPageList.Count - 2 then
      begin
        FDontShowHeaders := True;
        NewPage;
        FDontShowHeaders := False;
      end
      else
        EndPage;
    end;

    { restore hband objects }
    FVMasterBand.Objects.Clear;
    for i := 0 to SaveObjects.Count - 1 do
      FVMasterBand.Objects.Add(SaveObjects[i]);
    SaveObjects.Free;

    PreviewPages.CurPage := SavePageN;
    CurY := SaveCurY;
    CurX := SaveCurX;
    { the next NewPage call should form a new page }
    PreviewPages.AddPageAction := apAdd;
  end;

  procedure AddVBand;
  var
    i: Integer;
    c, c1: TfrxReportComponent;
  begin
    if Band is TfrxDataBand then
      CurVColumn := CurVColumn + 1;
    if (Band is TfrxFooter) or (Band is TfrxGroupFooter) then
      FCurBand := Band
    else
      FCurBand := FVMasterBand;

    { fire beforeprint }
    Report.CurObject := Band.Name;
    Band.BeforePrint;
    Report.DoBeforePrint(Band);

    if Band.Visible then
    begin
      if CurX + Band.Width > PageWidth then
        if FPage.EndlessWidth then
          PageWidth := PageWidth + Band.Width
        else
        begin
          CurX := 0;
          FVPageList.Add(Pointer(FVMasterBand.Objects.Count));
          { reprint headers }
          for i := 0 to FVHeaderList.Count - 1 do
            ShowBand(TfrxBand(FVHeaderList[i]));
        end;

      { find objects that intersect with vertical Band }
      for i := 0 to Band.Objects.Count - 1 do
      begin
        c := Band.Objects[i];
        if THackComponent(c).FOriginalBand = FVMasterBand then
        begin
          { fire beforeprint and getdata }
          Report.CurObject := c.Name;
          c.BeforePrint;
          Report.DoBeforePrint(c);
          c.GetData;
          Report.DoNotifyEvent(c, c.OnAfterData);

          { copy the object }
          c1 := TfrxReportComponent(c.NewInstance);
          c1.Create(FVMasterBand);
          c1.Assign(c);
          with THackComponent(c1) do
          begin
            FAliasName := THackComponent(c).FAliasName;
            FOriginalComponent := THackComponent(c).FOriginalComponent;
          end;
          c1.Left := c1.Left + CurX;

          { restore the object's state }
          c.AfterPrint;
        end;
      end;

      CurX := CurX + Band.Width;
    end;

    { fire afterprint }
    Report.CurObject := Band.Name;
    Report.DoAfterPrint(Band);
    Band.AfterPrint;

    if Band is TfrxDataBand then
      FAggregates.AddValue(FVMasterBand, CurVColumn);

    { reset aggregates }
    if (Band is TfrxFooter) or (Band is TfrxGroupFooter) then
      FAggregates.Reset(Band);
  end;

begin
  SavePageList := nil;
  SaveVMasterBand := nil;

  { make cross-bands }
  if Band.FHasVBands then
  begin
    SaveCurX := CurX;
    { fire onbeforeprint }
    Report.CurObject := Band.Name;
    Band.BeforePrint;
    Report.DoBeforePrint(Band);
    { show vertical bands }
    ShowVBands(Band);
    CurX := 0;
    { the next NewPage call should form a new page }
    PreviewPages.AddPageAction := apAdd;

    { save global variables - FVPageList and FVMasterBand }
    { they may be changed in the NewPage call, if cross has a h-header }
    { with ReprintOnNewPage option }
    SavePageList := TList.Create;
    for i := 0 to FVPageList.Count - 1 do
      SavePageList.Add(FVPageList[i]);
    SaveVMasterBand := FVMasterBand;
  end;

  { show one vertical band }
  if Band.Vertical then
  begin
    AddVBand;
    Exit;
  end;

  IsMultiColumnBand := (Band is TfrxDataBand) and (TfrxDataBand(Band).Columns > 1);
  IsSplit := False;

  { check for StartNewPage flag }
  if not FCallFromAddPage then
    if Band.Visible then { don't process invisible bands }
      if Band.StartNewPage then
        if FOutputTo = nil then
          if not (((Band is TfrxDataBand) or (Band is TfrxGroupHeader)) and (Band.FLineN = 1)) then
          begin
            FStartNewPageBand := Band;
            if (Band is TfrxGroupHeader) and (TfrxGroupHeader(Band).ResetPageNumbers) then
              PreviewPages.ResetLogicalPageNumber;
            NewPage;
            FStartNewPageBand := nil;
          end;

  Stretch(Band);
  Band.FStretchedHeight := Band.Height;
  try
    if Band.Visible then
    begin
      { if band has columns, print all columns in one page. Page feed will be
        performed after the last column }
      if not IsMultiColumnBand and not (Band is TfrxOverlay) and not (Band is TfrxNullBand) and
        (Band.Height > FreeSpace) then
        if FOutputTo = nil then
          if (Band.AllowSplit and not FKeeping) or
           ((Band.Height > PageHeight - FooterHeight) and not band.FHasVBands) then
          begin
            if (not Band.AllowSplit) and (Band.FLineThrough  > 1) and (not Band.StartNewPage) then
            begin
              FCurBand := Band;
              NewColumn;
            end;
            if FKeeping then
              EndKeep(Band);
            DrawSplit(Band);
            IsSplit := True;
          end
          else
          begin
            if not FKeeping then