frxengine.pas

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

    for i := 0 to Bands.Count - 1 do
    begin
      b1 := Bands[i];
      { looking for data band }
      if b1 is TfrxDataBand then
      begin
        if i > 0 then
        begin
          b2 := Bands[i - 1];
          if b2 is TfrxHeader then  { if top band is header, connect it }
          begin
            b1.FHeader := b2;
            Bands[i - 1] := nil;
          end;
        end;

        if i < Bands.Count - 1 then { if bottom band is footer, connect it }
        begin
          b2 := Bands[i + 1];
          if b2 is TfrxFooter then
          begin
            b1.FFooter := b2;
            Bands[i + 1] := nil;
          end;
        end;
      end;
    end;

    ClearNils;
    { now all headers/footers must be connected. If not, add an error }
    for i := 0 to Bands.Count - 1 do
    begin
      b1 := Bands[i];
      if (b1 is TfrxHeader) or (b1 is TfrxFooter) then
      begin
        ErrorList.Add(frxResources.Get('enUnconnHeader') + ' ' + b1.Name);
        Bands[i] := nil;
      end;
    end;

    ClearNils;
  end;

  procedure ConnectGroups;
  var
    i, j: Integer;
    b1, b2: TfrxBand;
  begin
    { connect group headers }
    i := 0;
    while i < Bands.Count do
    begin
      b1 := Bands[i];
      if b1 is TfrxGroupHeader then
      begin
        b1.FSubBands.Add(b1);
        Inc(i);
        { add all subsequent headers to the first header's FSubBands }
        while (i < Bands.Count) and (TfrxBand(Bands[i]) is TfrxGroupHeader) do
        begin
          b1.FSubBands.Add(Bands[i]);
          Inc(i);
        end;

        { search for databand }
        while (i < Bands.Count) and not (TfrxBand(Bands[i]) is TfrxDataBand) do
          Inc(i);

        { now we expect to see the databand }
        if (i = Bands.Count) or not (TObject(Bands[i]) is TfrxDataBand) then
          ErrorList.Add(frxResources.Get('enUnconnGroup') + ' ' + b1.Name)
        else
          TfrxBand(Bands[i]).FGroup := b1;
      end
      else
        Inc(i);
    end;

    { connect group footers }
    for i := 0 to Bands.Count - 1 do
    begin
      b1 := Bands[i];
      if b1 is TfrxGroupFooter then
        for j := i - 1 downto 0 do
        begin
          b2 := Bands[j];
          if b2 is TfrxGroupHeader then  { connect to top-nearest header }
          begin
            b2.FFooter := b1;
            Bands[i] := nil;
            Bands[j] := nil;
            break;
          end;
        end;
    end;

    { remove header bands from the list }
    for i := 0 to Bands.Count - 1 do
    begin
      b1 := Bands[i];
      if b1 is TfrxGroupHeader then
        Bands[i] := nil;
    end;

    { looking for footers w/o corresponding header }
    for i := 0 to Bands.Count - 1 do
    begin
      b1 := Bands[i];
      if b1 is TfrxGroupFooter then
      begin
        ErrorList.Add(frxResources.Get('enUnconnGFooter') + ' ' + b1.Name);
        Bands[i] := nil;
      end;
    end;

    ClearNils;
  end;

begin
  SortBands := TStringList.Create;
  SortBands.Sorted := True;

  { align all objects with Align property <> baNone }
  FPage.AlignChildren;

  { clear all page SubBands }
  if PrepareVBands then
    FPage.FVSubBands.Clear
  else
    FPage.FSubBands.Clear;

  for i := 0 to FPage.Objects.Count - 1 do
  begin
    t := FPage.Objects[i];
    if t is TfrxBand then
    begin
      b := TfrxBand(t);
      if b.Vertical <> PrepareVBands then
        continue;
      PrepareShiftTree(b);
      b.FSubBands.Clear;
      b.FHeader := nil;
      b.FFooter := nil;
      b.FGroup := nil;
      b.FHasVBands := False;
      if b is TfrxDataBand then
        if (TfrxDataBand(b).DataSet = nil) and (TfrxDataBand(b).RowCount > 0) then
        begin
          TfrxDataBand(b).DataSet := TfrxDataBand(b).VirtualDataSet;
          TfrxDataBand(b).DataSet.Initialize;
        end;

      { connect objects to vertical bands }
      if (not PrepareVBands) and not (b is TfrxOverlay) then
        for j := 0 to FPage.Objects.Count - 1 do
        begin
          t := FPage.Objects[j];
          if (t is TfrxBand) and TfrxBand(t).Vertical then
          begin
            k := 0;
            while k < b.Objects.Count do
            begin
              c := b.Objects[k];
              if (c.Left >= t.Left - 1e-4) and
                (c.Left + c.Width <= t.Left + t.Width + 1e-4) then
              begin
                b.FHasVBands := True;
                c.Parent := t;
                THackComponent(c).FOriginalBand := b;
                c.Left := c.Left - t.Left;
              end
              else
                Inc(k);
            end;
          end;
        end;
    end;
  end;

  { sort bands by position }
  for i := 0 to FPage.Objects.Count - 1 do
  begin
    t := FPage.Objects[i];
    if t is TfrxBand then
    begin
      b := TfrxBand(t);
      if b.Vertical <> PrepareVBands then
        continue;
      if b.BandNumber in [4..13] then
        if b.Vertical then
          SortBands.AddObject(Format('%9.2f', [b.Left]), b)
        else
          SortBands.AddObject(Format('%9.2f', [b.Top]), b);
    end;
  end;

  { copy sorted items to TList - it's easier to work with it }
  Bands := TList.Create;
  for i := 0 to SortBands.Count - 1 do
  begin
    t := TfrxComponent(SortBands.Objects[i]);
    Bands.Add(t);
  end;

  SortBands.Free;

  ConnectGroups;
  ConnectHeaders;
  MakeTree(FPage, 0);

  ClearNils;
  for i := 0 to Bands.Count - 1 do
  begin
    t := Bands[i];
    ErrorList.Add(frxResources.Get('enBandPos') + ' ' + t.Name);
  end;

  Bands.Free;
end;

procedure TfrxEngine.PrepareShiftTree(Band: TfrxBand);
var
  i, j, k: Integer;
  c0, c1, c2, top: TfrxReportComponent;
  allObjects: TStringList;
  Found: Boolean;
  area0, area1, area2, area01: TfrxRectArea;
begin
  if Band.FShiftChildren.Count <> 0 then
    Exit;

  allObjects := TStringList.Create;
  allObjects.Duplicates := dupAccept;

  { temporary top object }
  top := TfrxMemoView.Create(nil);
  top.SetBounds(0, Band.Top-2, Band.Width, 1);

  { sort objects }
  for i := 0 to Band.Objects.Count - 1 do
  begin
    c0 := Band.Objects[i];
    allObjects.AddObject(Format('%9.2f', [c0.Top]), c0);
    c0.FShiftChildren.Clear;
  end;
  allObjects.Sort;
  allObjects.InsertObject(0, Format('%10.2f', [top.Top]), top);

  for i := 0 to allObjects.Count - 1 do
  begin
    c0 := TfrxReportComponent(allObjects.Objects[i]);
    area0 := TfrxRectArea.Create(c0);

    { find an object under c0 }
    for j := i + 1 to allObjects.Count - 1 do
    begin
      c1 := TfrxReportComponent(allObjects.Objects[j]);
      area1 := TfrxRectArea.Create(c1);

      if not (area0.InterceptsY(area1)) and (area0.Y < area1.Y) and
        area0.InterceptsX(area1) then
      begin
        area01 := area0.InterceptX(area1);
        Found := False;

        { check if there is no other objects between c1 and c0 }
        for k := j - 1 downto i + 1 do
        begin
          c2 := TfrxReportComponent(allObjects.Objects[k]);
          area2 := TfrxRectArea.Create(c2);

          if not (area0.InterceptsY(area2)) and not (area1.InterceptsY(area2)) and
            area01.InterceptsX(area2) then
            Found := True;

          area2.Free;
          if Found then
            break;
        end;

        if not Found then
          c0.FShiftChildren.Add(c1);

        area01.Free;
      end;

      area1.Free;
    end;

    area0.Free;
  end;

  { copy children from the top object to the band }
  Band.FShiftChildren.Clear;
  for i := 0 to top.FShiftChildren.Count - 1 do
    Band.FShiftChildren.Add(top.FShiftChildren[i]);

  allObjects.Free;
  top.Free;
end;

function TfrxEngine.CanShow(Obj: TObject; PrintIfDetailEmpty: Boolean): Boolean;
var
  i: Integer;
  Bands: TList;
  b: TfrxDataBand;
  res: Boolean;
begin
  if Obj is TfrxReportPage then
    Bands := TfrxReportPage(Obj).FSubBands else
    Bands := TfrxBand(Obj).FSubBands;

  Result := True;
  { Check all subdetail bands to ensure they all have records }
  if not PrintIfDetailEmpty then
  begin
    Result := False;
    if (Bands.Count = 0) and not (Obj is TfrxPage) then
      Result := True;

    for i := 0 to Bands.Count - 1 do
    begin
      b := Bands[i];
      if b.DataSet <> nil then
      begin
        Report.DoNotifyEvent(b, b.OnMasterDetail);
        b.DataSet.First;

        while not b.DataSet.Eof do
        begin
          res := CanShow(b, b.PrintIfDetailEmpty);
          if res then
          begin
            Result := True;
            break;
          end
          else
            b.DataSet.Next;
        end;
      end;
    end;
  end;
end;

procedure TfrxEngine.ResetSuppressValues(Band: TfrxBand);
var
  i: Integer;
begin
  for i := 0 to Band.Objects.Count - 1 do
    if TObject(Band.Objects[i]) is TfrxCustomMemoView then
      THackMemoView(Band.Objects[i]).FLastValue := Null;
end;

procedure TfrxEngine.InitGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
  Index: Integer; ResetLineN: Boolean = False);
var
  i: Integer;
  b: TfrxGroupHeader;
begin
  for i := Index to Band.FSubBands.Count - 1 do
  begin
    b := Band.FSubBands[i];
    if ResetLineN then
    begin
      b.FLineN := 1;
      b.FLineThrough := 1;
      ResetSuppressValues(b);
    end
    else
    begin
      Inc(b.FLineN);
      if i < Band.FSubBands.Count - 1 then
        TfrxBand(Band.FSubBands[i + 1]).FLineN := 0;
      Inc(b.FLineThrough);
    end;
  end;

  CheckDrill(Master, Band);

  for i := Index to Band.FSubBands.Count - 1 do
  begin
    b := Band.FSubBands[i];
    CurLine := b.FLineN;
    CurLineThrough := b.FLineThrough;
    Report.CurObject := b.Name;
    b.FLastValue := Report.Calc(b.Condition);
    if b.KeepTogether then
      StartKeep(b);
    ShowBand(b);
    AddBandOutline(b);
    if b.Vertical then
      AddToVHeaderList(b)
    else
      AddToHeaderList(b);
  end;
end;

procedure TfrxEngine.ShowGroupFooters(Band: TfrxGroupHeader; Index: Integer;
  Master: TfrxDataBand);
var
  i: Integer;
  b: TfrxGroupHeader;
begin
  for i := Band.FSubBands.Count - 1 downto Index do
  begin
    b := Band.FSubBands[i];
    if b.FFooter <> nil then
      if not TfrxGroupFooter(b.FFooter).HideIfSingleDataRecord or (Master.FLineN > 2) then
        ShowBand(b.FFooter)
      else
        FAggregates.Reset(b.FFooter);

    OutlineUp(b);
    if b.Vertical then
      RemoveFromVHeaderList(b)
    else
      RemoveFromHeaderList(b);
    if b.KeepTogether then
      EndKeep(b);
  end;
end;

procedure TfrxEngine.CheckDrill(Master: TfrxDataBand; Band: TfrxGroupHeader);
var
  i, j: Integer;
  b, b1: TfrxGroupHeader;
  drillName: String;
  drillVisible: Boolean;
begin
  for i := 0 to Band.FSubBands.Count - 1 do
  begin
    b := Band.FSubBands[i];
    if b.DrillDown then
    begin
      drillName := b.Name + '.' + IntToStr(b.FLineThrough);
      drillVisible := Report.DrillState.IndexOf(drillName) <> -1;
      if b.ExpandDrillDown then
        drillVisible := not DrillVisible;
      for j := i + 1 to Band.FSubBands.Count - 1 do
      begin
        b1 := Band.FSubBands[j];
        b1.Visible := drillVisible;
        if b1.FFooter <> nil then
          b1.FFooter.Visible := drillVisible;
      end;
      Master.Visible := drillVisible;
      if not b.ShowFooterIfDrillDown and (b.FFooter <> nil) then
        b.FFooter.Visible := drillVisible;
      if not drillVisible then
        break;  
    end;
  end;
end;

procedure TfrxEngine.CheckGroups(Master: TfrxDataBand; Band: TfrxGroupHeader;
  ColumnKeepPos: Integer; SaveCurY: Extended);
var
  i: Integer;
  b: TfrxGroupHeader;
  NextNeeded: Boolean;
begin
  CheckDrill(Master, Band);
  
  for i := 0 to Band.FSubBands.Count - 1 do
  begin
    b := Band.FSubBands[i];

    Report.CurObject := b.Name;
    if Report.Calc(b.Condition) <> b.FLastValue then
    begin
      Master.CurColumn := Master.Columns;
      CheckBandColumns(Master, ColumnKeepPos, SaveCurY);

      { avoid exception in uni-directional datasets }
      NextNeeded := True;
      try
        Master.DataSet.Prior;
      except
        NextNeeded := False;
      end;
      ShowGroupFooters(Band, i, Master);
      if NextNeeded then
        Master.DataSet.Next;

      InitGroups(Master, Band, i);
      Master.FLineN := 1;