frxcross.pas

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

      h := h + FSize.Y;
    for i := 0 to FCorner.Count - 1 do
      FCorner[i].FSize.Y := h;
  end;

  Items.Free;
  LevelHeights := nil;
end;

procedure TfrxCrossColumnHeader.CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean);
var
  i: Integer;
  Items: TList;
  Item: TfrxCrossHeader;
  s: WideString;
  m: TfrxCustomMemoView;
begin
  Items := AllItems;

  for i := 0 to Items.Count - 1 do
  begin
    Item := Items[i];
    m := Item.FMemo;
    if m <> nil then
    begin
      if AutoSize or (m.Width = 0) or (m.Height = 0) then
      begin
        m.Width := MaxWidth;
        s := m.Text;
        m.Text := m.FormatData(Item.Value);
        if m.Lines.Count = 0 then
          m.Text := ' ';
        Item.FSize := CalcSize(m);
        m.Text := s;
      end
      else
      begin
        if Item.Count = 0 then
          Item.FSize.X := m.Width;
        if not Item.IsTotal then
          Item.FSize.Y := m.Height;
      end;

      if Item.FSize.X < MinWidth then
        Item.FSize.X := MinWidth;
      if Item.FSize.X > MaxWidth then
        Item.FSize.X := MaxWidth;
    end;
  end;

  Items.Free;
end;


{ TfrxCrossRowHeader }

procedure TfrxCrossRowHeader.CalcBounds;
var
  i, j, l: Integer;
  w: Extended;
  Items: TList;
  Item: TfrxCrossHeader;
  LevelWidths: array of Extended;

  function DoAdjust(Item: TfrxCrossHeader): Extended;
  var
    i: Integer;
    Height: Extended;
  begin
    if Item.Count = 0 then
    begin
      Result := Item.FSize.Y;
      Exit;
    end;

    Height := 0;
    for i := 0 to Item.Count - 1 do
      Height := Height + DoAdjust(Item[i]);

    if Item.FSize.Y < Height then
      Item.FSize.Y := Height
    else
    begin
      Item[Item.Count - 1].FSize.Y := Item[Item.Count - 1].FSize.Y + Item.FSize.Y - Height;
      DoAdjust(Item[Item.Count - 1]);
    end;

    Result := Item.FSize.Y;
  end;

  procedure FillBounds(Item: TfrxCrossHeader; Offset: TfrxPoint);
  var
    i, j, l: Integer;
    w: Extended;
  begin
    l := Item.Level;
    if l <> -1 then
      w := LevelWidths[l] else
      w := Item.FSize.X;

    if Item.FIsCellHeader then
      w := LevelWidths[FLevelsCount]
    else if Item.IsTotal then
      for j := l + 1 to FLevelsCount - 1 do
        w := w + LevelWidths[j];

    Item.FBounds := frxRect(Offset.X, Offset.Y, w, Item.FSize.Y);
    Offset.X := Offset.X + w;

    for i := 0 to Item.Count - 1 do
    begin
      FillBounds(Item[i], Offset);
      Offset.Y := Offset.Y + Item[i].FSize.Y;
    end;
  end;

begin
  DoAdjust(Self);

  SetLength(LevelWidths, FLevelsCount + 1);

  Items := AllItems;

// calculate maxwidth of each row
  for i := 0 to Items.Count - 1 do
  begin
    Item := Items[i];
    l := Item.Level;

    // cell headers always adjust the last level width
    if Item.FIsCellHeader then
      l := FLevelsCount
    // don't count total elemens unless they are on last level.
    // such elements will be adjusted later
    else if Item.IsTotal then
      if l <> FLevelsCount - 1 then continue;

    if l >= 0 then
      if Item.FSize.X > LevelWidths[l] then
        LevelWidths[l] := Item.FSize.X;
  end;

// adjust totals
  for i := 0 to Items.Count - 1 do
  begin
    Item := Items[i];
    l := Item.Level;

    if Item.IsTotal and (l < FLevelsCount - 1) then
    begin
      w := 0;
      for j := l to FLevelsCount - 1 do
        w := w + LevelWidths[j];

      if Item.FSize.X > w then
        LevelWidths[FLevelsCount - 1] := LevelWidths[FLevelsCount - 1] + Item.FSize.X - w;
    end;
  end;

// adjust corner
  for i := 0 to FCorner.Count - 1 do
    if FCorner[i].FSize.X > LevelWidths[i] then
      LevelWidths[i] := FCorner[i].FSize.X
    else
      FCorner[i].FSize.X := LevelWidths[i];

  FillBounds(Self, frxPoint(0, 0));

  Items.Free;
  LevelWidths := nil;
end;

procedure TfrxCrossRowHeader.CalcSizes(MaxWidth, MinWidth: Integer; AutoSize: Boolean);
var
  i: Integer;
  Items: TList;
  Item: TfrxCrossHeader;
  s: WideString;
  m: TfrxCustomMemoView;
begin
  Items := AllItems;

  for i := 0 to Items.Count - 1 do
  begin
    Item := Items[i];
    m := Item.FMemo;
    if m <> nil then
    begin
      if AutoSize or (m.Width = 0) or (m.Height = 0) then
      begin
        m.Width := MaxWidth;
        s := m.Text;
        m.Text := m.FormatData(Item.Value);
        if m.Lines.Count = 0 then
          m.Text := ' ';
        Item.FSize := CalcSize(m);
        m.Text := s;
      end
      else
      begin
        if Item.Count = 0 then
          Item.FSize.Y := m.Height;
        if not Item.IsTotal then
          Item.FSize.X := m.Width;
      end;

      if Item.FSize.X < MinWidth then
        Item.FSize.X := MinWidth;
      if Item.FSize.X > MaxWidth then
        Item.FSize.X := MaxWidth;
    end;
  end;

  Items.Free;
end;


{ TfrxCutBandItem }

destructor TfrxCutBandItem.Destroy;
begin
  Band.Free;
  inherited;
end;


{ TfrxCutBands }

constructor TfrxCutBands.Create;
begin
  inherited Create(TfrxCutBandItem);
end;

procedure TfrxCutBands.Add(ABand: TfrxBand; AFromIndex, AToIndex: Integer);
begin
  with TfrxCutBandItem(inherited Add) do
  begin
    Band := ABand;
    FromIndex := AFromIndex;
    ToIndex := AToIndex;
  end;
end;

function TfrxCutBands.GetItems(Index: Integer): TfrxCutBandItem;
begin
  Result := TfrxCutBandItem(inherited Items[Index]);
end;


{ TfrxGridLineItem }

constructor TfrxGridLineItem.Create(Collection: TCollection);
begin
  inherited;
  Objects := TList.Create;
end;

destructor TfrxGridLineItem.Destroy;
begin
  Objects.Free;
  inherited;
end;


{ TfrxGridLines }

constructor TfrxGridLines.Create;
begin
  inherited Create(TfrxGridLineItem);
end;

procedure TfrxGridLines.Add(AObj: TObject; ACoord: Extended);
var
  i: Integer;
  Item: TfrxGridLineItem;
begin
  Item := nil;
  for i := 0 to Count - 1 do
    if Abs(Items[i].Coord - ACoord) < 1 then
    begin
      Item := Items[i];
      break;
    end;

  if Item = nil then
    Item := TfrxGridLineItem(inherited Add);

  Item.Coord := ACoord;
  Item.Objects.Add(AObj);
end;

function TfrxGridLines.GetItems(Index: Integer): TfrxGridLineItem;
begin
  Result := TfrxGridLineItem(inherited Items[Index]);
end;


{ TfrxCustomCrossView }

constructor TfrxCustomCrossView.Create(AOwner: TComponent);
var
  i: Integer;
begin
  inherited;
  Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
  Color := clWhite;
  frComponentStyle := frComponentStyle - [csPreviewVisible] + [csContainer];

  FAllMemos := TList.Create;
  FCellMemos := TList.Create;
  FCellHeaderMemos := TList.Create;
  FColumnMemos := TList.Create;
  FColumnTotalMemos := TList.Create;
  FCornerMemos := TList.Create;
  FRowMemos := TList.Create;
  FRowTotalMemos := TList.Create;

  FCellFields := TStringList.Create;
  FColumnFields := TStringList.Create;
  FRowFields := TStringList.Create;
  FColumnBands := TfrxCutBands.Create;
  FRowBands := TfrxCutBands.Create;

  FGridX := TfrxGridLines.Create;
  FGridY := TfrxGridLines.Create;

  FAutoSize := True;
  FBorder := True;
  FGapX := 3;
  FGapY := 3;
  FMaxWidth := 200;
  FRepeatHeaders := True;
  FShowColumnHeader := True;
  FShowColumnTotal := True;
  FShowRowHeader := True;
  FShowRowTotal := True;
  FShowCorner := True;
  FShowTitle := True;
  FAllowDuplicates := True;
  FClearBeforePrint := True;
  FSuppressNullRecords := True;

  SetDotMatrix(Page is TfrxDMPPage);
  CreateCornerMemos(3);
  CellLevels := 1;
  ColumnLevels := 1;
  RowLevels := 1;

  for i := 0 to 31 do
  begin
    FCellFunctions[i] := cfSum;
    FColumnSort[i] := soAscending;
    FRowSort[i] := soAscending;
  end;
end;

destructor TfrxCustomCrossView.Destroy;
begin
  ClearMemos;
  FAllMemos.Free;
  FCellMemos.Free;
  FCellHeaderMemos.Free;
  FColumnMemos.Free;
  FColumnTotalMemos.Free;
  FCornerMemos.Free;
  FRowMemos.Free;
  FRowTotalMemos.Free;

  FCellFields.Free;
  FColumnFields.Free;
  FRowFields.Free;

  FColumnBands.Free;
  FRowBands.Free;
  FGridX.Free;
  FGridY.Free;

  ClearMatrix;
  inherited;
end;

function TfrxCustomCrossView.GetCellFunctions(Index: Integer): TfrxCrossFunction;
begin
  Result := FCellFunctions[Index];
end;

function TfrxCustomCrossView.GetCellMemos(Index: Integer): TfrxCustomMemoView;
begin
  Result := FCellMemos[Index];
end;

function TfrxCustomCrossView.GetCellHeaderMemos(Index: Integer): TfrxCustomMemoView;
begin
  Result := FCellHeaderMemos[Index];
end;

function TfrxCustomCrossView.GetColumnMemos(Index: Integer): TfrxCustomMemoView;
begin
  Result := FColumnMemos[Index];
end;

function TfrxCustomCrossView.GetColumnTotalMemos(Index: Integer): TfrxCustomMemoView;
begin
  Result := FColumnTotalMemos[Index];
end;

function TfrxCustomCrossView.GetCornerMemos(Index: Integer): TfrxCustomMemoView;
begin
  Result := FCornerMemos[Index];
end;

function TfrxCustomCrossView.GetRowMemos(Index: Integer): TfrxCustomMemoView;
begin
  Result := FRowMemos[Index];
end;

function TfrxCustomCrossView.GetRowTotalMemos(Index: Integer): TfrxCustomMemoView;
begin
  Result := FRowTotalMemos[Index];
end;

function TfrxCustomCrossView.GetColumnSort(Index: Integer): TfrxCrossSortOrder;
begin
  Result := FColumnSort[Index];
end;

function TfrxCustomCrossView.GetRowSort(Index: Integer): TfrxCrossSortOrder;
begin
  Result := FRowSort[Index];
end;

procedure TfrxCustomCrossView.SetCellFunctions(Index: Integer;
  const Value: TfrxCrossFunction);
begin
  FCellFunctions[Index] := Value;
end;

procedure TfrxCustomCrossView.SetColumnSort(Index: Integer; Value: TfrxCrossSortOrder);
begin
  FColumnSort[Index] := Value;
end;

procedure TfrxCustomCrossView.SetRowSort(Index: Integer; Value: TfrxCrossSortOrder);
begin
  FRowSort[Index] := Value;
end;

function TfrxCustomCrossView.ColCount: Integer;
begin
  Result := FColumns.Count;
end;

function TfrxCustomCrossView.RowCount: Integer;
begin
  Result := FRows.Count;
end;

function TfrxCustomCrossView.IsGrandTotalColumn(Index: Integer): Boolean;
begin
  Result := Index = FColumns.Count - 1;
end;

function TfrxCustomCrossView.IsGrandTotalRow(Index: Integer): Boolean;
begin