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

📄 frxengine.pas

📁 这个是功能强大的报表软件
💻 PAS
📖 第 1 页 / 共 5 页
字号:
      ResetSuppressValues(Master);
      break;
    end;
  end;
end;

procedure TfrxEngine.CheckBandColumns(Band: TfrxDataBand; ColumnKeepPos: Integer;
  SaveCurY: Extended);
begin
  if Band.Columns > 1 then
  begin
    { collect max position in b.FMaxY }
    if CurY > Band.FMaxY then
      Band.FMaxY := CurY;
    { all columns have been printed }
    if Band.CurColumn >= Band.Columns then
    begin
      { need page break, don't break if page has Endless Height}
      if (Band.FMaxY > PageHeight - FooterHeight) and (not FPage.EndlessHeight) then
      begin
        if FKeeping then  { standard keep procedure }
          NewColumn
        else
        begin
          PreviewPages.CutObjects(ColumnKeepPos);
          NewColumn;
          PreviewPages.PasteObjects(CurX, CurY);
          CurY := CurY + Band.FMaxY - SaveCurY;
        end;
      end
      else
        CurY := Band.FMaxY;  { start the new band from saved b.FMaxY }
    end
    else
      CurY := SaveCurY;   { start the new band from saved SaveCurY }
    if Band.Visible then
      Band.CurColumn := Band.CurColumn + 1;
  end;
end;

procedure TfrxEngine.NotifyObjects(Band: TfrxBand);
var
  i: Integer;
  c: TfrxComponent;
begin
  for i := 0 to NotifyList.Count - 1 do
  begin
    c := NotifyList[i];
    if c <> nil then
      c.OnNotify(Band);
  end;
end;

procedure TfrxEngine.RunPage(Page: TfrxReportPage);
var
  PageCount: Integer;

  { "Null" band contains all free-placed objects that don't have a parent band }
  procedure ShowNullBand;
  var
    i: Integer;
    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.KeepHeader and (b.FHeader <> nil) then
              StartKeep(b);
            if b.KeepTogether 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, TfrxGroupHeader(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;
  var
    pgWidth, pgHeight: Extended;
  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;
      if FPage.EndlessHeight or FPage.EndlessWidth then
      begin
        if FPage.EndlessWidth then
          pgWidth := PageWidth + FPage.LeftMargin * fr01cm + FPage.RightMargin * fr01cm
        else
          pgWidth := FPage.PaperWidth * fr01cm;
        if FPage.EndlessHeight then
        begin
          PageHeight := CurY + FooterHeight;
          pgHeight := PageHeight + FPage.TopMargin * fr01cm + FPage.BottomMargin * fr01cm
        end
        else
          pgHeight := FPage.PaperHeight * fr01cm;
        TfrxPreviewPages(PreviewPages).UpdatePageDimensions(FPage, pgWidth, pgHeight);
      end;

      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
    for PageCount := 1 to FPage.PageCount do
    begin
      if Report.Terminated then break;
      ShowPage;
    end;

  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, TfrxGroupHeader(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;
  OutlineRoot;
  if FPage.ResetPageNumbers then
    PreviewPages.ResetLogicalPageNumber;

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

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

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

  Band := FindBand(TfrxColumnHeader);
  while Band <> nil do
  begin
    Result := Result + Band.Height;
    Band := Band.Child;
  end;
  Band := FindBand(TfrxPageHeader);
  while Band <> nil do
  begin
    Result := Result + Band.Height;
    Band := Band.Child;
  end;
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

⌨️ 快捷键说明

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