⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 frxengine.pas

📁 报表控件。FastReport 是非常强大的报表控件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
    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;

  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];
        { 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;
          { shift the underlying objects down }
          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;
            StrView.Height := StrView.FSaveHeight;
          end
          else
          begin
            { view can draw something }
            Band.Objects.Add(StrView);
            { decrease the remained height }
            StrView.FSaveHeight := StrView.FSaveHeight - StrView.Height + Corr;
          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.DoShow(Band: TfrxBand);
var
  IsMultiColumnBand, IsSplit: 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
      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.FLineThrough = 1)) then
          begin
            FStartNewPageBand := Band;
            NewPage;
            FStartNewPageBand := nil;
          end;

  Stretch(Band);
  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 then
          begin
            DrawSplit(Band);
            IsSplit := True;
          end
          else
            NewColumn;

      if not IsSplit then
      begin
        if not (Band is TfrxNullBand) then
        begin
          { multicolumn band manages its Left property itself }
          if IsMultiColumnBand then
            Band.Left := Band.Left + CurX else
            Band.Left := CurX;
          Band.Top := CurY;
        end;

        { output the band }
        if FOutputTo = nil then
        begin
          if Band.FHasVBands then
          begin
            { restore global variables - FVPageList and FVMasterBand }
            { they may be changed in the NewPage call, if cross has a h-header }
            { with ReprintOnNewPage option }
            FVPageList.Clear;
            for i := 0 to SavePageList.Count - 1 do
              FVPageList.Add(SavePageList[i]);
            SavePageList.Free;
            FVMasterBand := SaveVMasterBand;
            RenderVBand;
          end
          else if (not FCallFromAddPage) or (not PreviewPages.BandExists(Band)) then
            PreviewPages.AddObject(Band)
        end
        else
        begin
          TempBand := TfrxBand.Create(FOutputTo);
          TempBand.AssignAll(Band);
        end;

        { move the current position }
        CurY := CurY + Band.Height;
      end;
    end;
  finally
    UnStretch(Band);
  end;

  { reset aggregate values }
//  if (Band is TfrxFooter) or (Band is TfrxGroupFooter) or
//     (Band is TfrxPageFooter) or (Band is TfrxReportSummary) then
    FAggregates.Reset(Band);

  { print subreports contained in this band }
  if Band.Visible then
    CheckSubReports(Band);
end;

procedure TfrxEngine.CheckSubReports(Band: TfrxBand);
var
  i, SavePageN, SaveColumnN: Integer;
  SaveCurX, SaveCurY, SavePageCurX: Extended;
  HaveSub: Boolean;
  Sub: TfrxSubReport;
  MaxPageN, MaxColumnN: Integer;
  MaxCurY: Extended;
begin
  { save the current position }
  HaveSub := False;
  SavePageN := PreviewPages.CurPage;
  SaveColumnN := CurColumn;
  SaveCurX := CurX;
  SaveCurY := CurY;
  SavePageCurX := FPageCurX;

  { init max position }
  MaxPageN := SavePageN;      //0
  MaxColumnN := SaveColumnN;  //0
  MaxCurY := SaveCurY;        //0

  { 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 Sub.PrintOnParent then continue;
      HaveSub := True;

      { set up all properties... }
      PreviewPages.CurPage := SavePageN;
      FPageCurX := SavePageCurX + Sub.Left;
      CurColumn := SaveColumnN;
      CurX := SaveCurX + Sub.Left;
      CurY := SaveCurY - Band.Height + Sub.Top; //SaveCurY - Sub.Height;
      { ...and run the subreport }
      RunPage(Sub.Page);

      { calc max position }
      if PreviewPages.CurPage > MaxPageN then
      begin
        MaxPageN := PreviewPages.CurPage;
        MaxColumnN := CurColumn;
        MaxCurY := CurY;
      end
      else if PreviewPages.CurPage = MaxPageN then
        if CurColumn > MaxColumnN then
        begin
          MaxColumnN := CurColumn;
          MaxCurY := CurY;
        end
        else if CurColumn = MaxColumnN then
          if CurY > MaxCurY then
            MaxCurY := CurY;
    end;

  { move the current position to the last generated page }
  if HaveSub then
  begin
    PreviewPages.CurPage := MaxPageN;
    CurColumn := MaxColumnN;
    CurX := SavePageCurX;
    if CurColumn > 1 then
      CurX := CurX + frxStrToFloat(FPage.ColumnPositions[CurColumn - 1]) * fr01cm;
    CurY := MaxCurY;
    FPageCurX := SavePageCurX;
  end;
end;

procedure TfrxEngine.StartKeep(Band: TfrxBand; Position: Integer = 0);
begin
  if FKeeping or FIsFirstBand then Exit;

  FKeeping := True;
  FKeepBand := Band;
  if Position = 0 then
    Position := PreviewPages.GetCurPosition;
  FKeepPosition := Position;
  FKeepOutline := PreviewPages.Outline.GetCurPosition;
  FAggregates.StartKeep;
end;

procedure TfrxEngine.EndKeep(Band: TfrxBand);
begin
  if FKeepBand = Band then
  begin
    FKeeping := False;
    FKeepBand := nil;
    FAggregates.EndKeep;
  end;
end;

function TfrxEngine.GetAggregateValue(const Name, Expression: String;
  Band: TfrxBand; Flags: Integer): Variant;
begin
  Result := FAggregates.GetValue(FCurBand, CurVColumn, Name, Expression, Band, Flags);
end;

procedure TfrxEngine.AddBandOutline(Band: TfrxBand);
begin
  if Band.OutlineText <> '' then
  begin
    Report.CurObject := Band.Name;
    PreviewPages.Outline.AddItem(VarToStr(Report.Calc(Band.OutlineText)),
      Round(CurY - Band.Height));
  end;
end;

procedure TfrxEngine.AddPageOutline;
begin
  if FPage.OutlineText <> '' then
  begin
    OutlineRoot;
    Report.CurObject := FPage.Name;
    PreviewPages.Outline.AddItem(VarToStr(Report.Calc(FPage.OutlineText)), 0);
  end;
end;

procedure TfrxEngine.OutlineRoot;
begin
  PreviewPages.Outline.LevelRoot;
end;

procedure TfrxEngine.OutlineUp(Band: TfrxBand);
begin
  if Band.OutlineText <> '' then
    PreviewPages.Outline.LevelUp;
end;


end.


//<censored>

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -