frxcrossmatrix.pas

报表控件。FastReport 是非常强大的报表控件

      s := 'Grand Total';
      FRowTotalMemos[i].Style := 'rowgrand';
    end
    else
    begin
      s := 'Total';
      FRowTotalMemos[i].Style := 'rowtotal';
    end;
    FRowTotalMemos[i].Text := s;
    FRowTotalMemos[i].Font.Style := [fsBold];
    FRowTotalMemos[i].Tag := 400 + i;
  end;
end;

procedure TfrxCrossMatrix.ClearMemos;
var
  i: Integer;
begin
  for i := 0 to CROSS_DIM_SIZE - 1 do
  begin
    FCellMemos[i].Free;
    FCellMemos[i] := nil;
    FColumnMemos[i].Free;
    FColumnMemos[i] := nil;
    FColumnTotalMemos[i].Free;
    FColumnTotalMemos[i] := nil;
    FRowMemos[i].Free;
    FRowMemos[i] := nil;
    FRowTotalMemos[i].Free;
    FRowTotalMemos[i] := nil;
  end;
end;

procedure TfrxCrossMatrix.Init(RowLevels, ColumnLevels, CellLevels: Integer);
var
  i: Integer;
begin
  Clear;
  FNoRows := RowLevels = 0;
  if RowLevels = 0 then
    RowLevels := 1;
  FNoColumns := ColumnLevels = 0;
  if ColumnLevels = 0 then
    ColumnLevels := 1;

  FCellLevels := CellLevels;

  FRows := TfrxCrossRows.Create;
  FRows.FIndexesCount := RowLevels;
  FRows.FSortOrder := FRowSort;
  FRows.FCellLevels := FCellLevels;

  FColumns := TfrxCrossColumns.Create;
  FColumns.FIndexesCount := ColumnLevels;
  FColumns.FSortOrder := FColumnSort;

  FRowHeader := TfrxCrossRowHeader.Create(FCellLevels);
  FRowHeader.FMemos := FRowMemos;
  FRowHeader.FTotalMemos := FRowTotalMemos;
  FRowHeader.FLevelsCount := RowLevels;

  FColumnHeader := TfrxCrossColumnHeader.Create(FCellLevels);
  FColumnHeader.FMemos := FColumnMemos;
  FColumnHeader.FTotalMemos := FColumnTotalMemos;
  FColumnHeader.FLevelsCount := ColumnLevels;

  for i := 0 to CROSS_DIM_SIZE - 1 do
  begin
    FCellMemos[i].GapX := FGapX;
    FCellMemos[i].GapY := FGapY;
    FCellMemos[i].AllowExpressions := False;
    FColumnMemos[i].GapX := FGapX;
    FColumnMemos[i].GapY := FGapY;
    FColumnMemos[i].AllowExpressions := False;
    FColumnTotalMemos[i].GapX := FGapX;
    FColumnTotalMemos[i].GapY := FGapY;
    FColumnTotalMemos[i].AllowExpressions := False;
    FRowMemos[i].GapX := FGapX;
    FRowMemos[i].GapY := FGapY;
    FRowMemos[i].AllowExpressions := False;
    FRowTotalMemos[i].GapX := FGapX;
    FRowTotalMemos[i].GapY := FGapY;
    FRowTotalMemos[i].AllowExpressions := False;
  end;
end;

procedure TfrxCrossMatrix.Clear;
begin
  if FRows = nil then Exit;

  FRows.Free;
  FRows := nil;
  FColumns.Free;
  FColumns := nil;
  FRowHeader.Free;
  FRowHeader := nil;
  FColumnHeader.Free;
  FColumnHeader := nil;
end;

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

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

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

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

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

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

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

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

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

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

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

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

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

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

function TfrxCrossMatrix.IsGrandTotalRow(Index: Integer): Boolean;
begin
  Result := Index = FRows.Count - 1;
end;

function TfrxCrossMatrix.IsTotalColumn(Index: Integer): Boolean;
var
  i: Integer;
begin
  Result := False;

  for i := 0 to FColumns.FIndexesCount - 1 do
    if VarToStr(FColumns[Index].Indexes[i]) = '@@@' then
      Result := True;
end;

function TfrxCrossMatrix.IsTotalRow(Index: Integer): Boolean;
var
  i: Integer;
begin
  Result := False;

  for i := 0 to FRows.FIndexesCount - 1 do
    if VarToStr(FRows[Index].Indexes[i]) = '@@@' then
      Result := True;
end;

function TfrxCrossMatrix.GetDrawSize: TfrxPoint;
var
  ColumnItems, RowItems: TList;
  ColumnItem, RowItem: TfrxCrossHeader;
begin
  ColumnItems := ColumnHeader.TerminalItems;
  RowItems := RowHeader.TerminalItems;

  ColumnItem := ColumnItems[ColumnItems.Count - 1];
  RowItem := RowItems[RowItems.Count - 1];

  Result.X := ColumnItem.Bounds.Left + ColumnItem.Bounds.Right + RowHeader.Width;
  Result.Y := RowItem.Bounds.Top + RowItem.Bounds.Bottom + ColumnHeader.Height;

  ColumnItems.Free;
  RowItems.Free;
end;

procedure TfrxCrossMatrix.AddValue(const Rows, Columns, Cells: array of Variant);
var
  i: Integer;
  Row: TfrxCrossRow;
  Column: TfrxCrossColumn;
  Cell: PfrCrossCell;
  Value, v: Variant;
begin
  if FRows = nil then Exit;

  if FNoColumns then
    Column := FColumns.Column([Null]) else
    Column := FColumns.Column(Columns);
  if FNoRows then
    Row := FRows.Row([Null]) else
    Row := FRows.Row(Rows);

  Cell := Row.GetCell(Column.CellIndex);

  for i := 0 to FCellLevels - 1 do
  begin
    Value := Cell.Value;
    v := Cells[i];

    if FCellFunctions[i] = cfCount then
    begin
      v := Cells[i];
      if v = Null then
        v := 0
      else
        v := 1;
    end;

    if Value = Null then
      Cell.Value := v
    else if (TVarData(Value).VType = varString) or (TVarData(Value).VType = varOleStr) then
      Cell.Value := Value + #13#10 + v
    else
      Cell.Value := Value + v;

    Cell := Cell.Next;
  end;
end;

function TfrxCrossMatrix.GetValue(ARow, AColumn, ACell: Integer): Variant;
var
  Row: TfrxCrossRow;
  Column: TfrxCrossColumn;
  Cell: PfrCrossCell;
begin
  Result := Null;
  Column := FColumns[AColumn];
  Row := FRows[ARow];
  Cell := Row.GetCell(Column.CellIndex);

  while (Cell <> nil) and (ACell > 0) do
  begin
    Cell := Cell.Next;
    Dec(ACell);
  end;

  if Cell <> nil then
    Result := Cell.Value;
end;

function TfrxCrossMatrix.GetColumnIndexes(AColumn: Integer): Variant;
begin
  Result := FColumns[AColumn].Indexes;
end;

function TfrxCrossMatrix.GetRowIndexes(ARow: Integer): Variant;
begin
  Result := FRows[ARow].Indexes;
end;

procedure TfrxCrossMatrix.CreateHeader(Header: TfrxCrossHeader;
  Source: TfrxIndexCollection; const Totals: TfrxMemoArray; TotalVisible: Boolean);
var
  i, j, IndexesCount: Integer;
  LastValues, CurValues: TfrxVariantArray;

  function ExpandVariable(s: String; const Value: Variant): String;
  var
    i: Integer;
  begin
    { expand the [Value] macro if any (eg. if total memo contains
      the text: 'Total of [Value]' }
    i := Pos('[VALUE]', AnsiUppercase(s));
    if i <> 0 then
    begin
      Delete(s, i, 7);
      Insert(VarToStr(Value), s, i);
    end;
    Result := s;
  end;

  procedure AddTotals;
  var
    j, k: Integer;
  begin
    for j := 0 to IndexesCount - 1 do
      { if value changed... }
      if LastValues[j] <> CurValues[j] then
      begin
        { ...create subtotals for all down-level values }
        for k := IndexesCount - 1 downto j + 1 do
          if Totals[k].Visible then
          begin
            { '@@@' means that this is subtotal cell }
            LastValues[k] := '@@@' + ExpandVariable(Totals[k].Text, LastValues[k - 1]);
            { create header cells... }
            Header.AddValues(LastValues);
            LastValues[k] := '@@@';
            { ...and row/column item }
            Source.InsertItem(i, LastValues);
            Inc(i);
          end;
        break;
      end;
  end;

begin
  if Source.Count = 0 then Exit;
  IndexesCount := Source.FIndexesCount;
  { copy first indexes to lastvalues }
  LastValues := Copy(Source.Items[0].Indexes, 0, IndexesCount);
  i := 0;

  while i < Source.Count do
  begin
    { copy current indexes to curvalues }
    CurValues := Copy(Source.Items[i].Indexes, 0, IndexesCount);
    { if lastvalues <> curvalues, make a subtotal item }
    AddTotals;
    { add header cells }
    Header.AddValues(CurValues);

    LastValues := CurValues;
    Inc(i);
  end;

  { create last subtotal item }
  CurValues := Copy(Source.Items[0].Indexes, 0, IndexesCount);
  for j := 0 to IndexesCount - 1 do
    CurValues[j] := Null;
  AddTotals;

  { create grand total }
  if Totals[0].Visible and TotalVisible then
  begin
    LastValues[0] := '@@@' + Totals[0].Text;
    Header.AddValues(LastValues);
    LastValues[0] := '@@@';
    Source.InsertItem(i, LastValues);
  end;
end;

procedure TfrxCrossMatrix.CreateHeaders;
begin
  CreateHeader(FColumnHeader, FColumns, FColumnTotalMemos, not FNoColumns);
  CreateHeader(FRowHeader, FRows, FRowTotalMemos, not FNoRows);
end;

procedure TfrxCrossMatrix.CalcTotal(Header: TfrxCrossHeader;
  Source: TfrxIndexCollection);
var
  i, j: Integer;
  Items: TList;
  Values, Counts: TfrxVariantArray;
  Item: TfrxCrossHeader;
  p: PfrCrossCell;
  FinalPass: Boolean;

  procedure CellToArrays(p: PfrCrossCell);
  var
    i: Integer;
  begin
    for i := 0 to FCellLevels - 1 do
    begin
      Values[i] := p.Value;
      Counts[i] := p.Count;

      if (FCellFunctions[i] = cfAvg) and FinalPass and (p.Count <> 0) then
        p.Value := p.Value / p.Count;

      p := p.Next;
    end;
  end;

  procedure ArraysToCell(p: PfrCrossCell);
  var
    i: Integer;
  begin
    for i := 0 to FCellLevels - 1 do
    begin
      p.Value := Item.FFuncValues[i];
      p.Count := Item.FCounts[i];

      if (FCellFunctions[i] = cfAvg) and FinalPass then
        if p.Count <> 0 then
          p.Value := p.Value / p.Count else
          p.Value := 0;

      if (FCellFunctions[i] = cfCount) and not FinalPass then
        p.Count := p.Value;

      p := p.Next;
    end;
  end;

begin
  Items := Header.TerminalItems;
  SetLength(Values, FCellLevels);
  SetLength(Counts, FCellLevels);
  FinalPass := Source = FColumns;

  { scan the matrix }
  for i := 0 to Source.Count - 1 do
  begin
    for j := 0 to Items.Count - 1 do
      TfrxCrossHeader(Items[j]).Reset(FCellFunctions);

    for j := 0 to Items.Count - 1 do
    begin
      Item := Items[j];
      if Source = FRows then
        p := FRows[i].GetCell(FColumns[j].CellIndex) else
        p := FRows[j].GetCell(FColumns[i].CellIndex);

      if not Item.IsTotal then
      begin
        { convert cell values to Values and Counts arrays }
        CellToArrays(p);
        { accumulate values in the header items }
        Item.AddFuncValues(Values, Counts, FCellFunctions);
      end
      else
      begin
        { get the accumulated values from the item's parent }
        Item := Item.Parent;
        { and convert it to the cell }
        ArraysToCell(p);
      end;
    end;
  end;

  Items.Free;
  Values := nil;
  Counts := nil;
end;

procedure TfrxCrossMatrix.CalcTotals;
begin
  { scan the matrix from left to right, then from top to bottom }
  CalcTotal(FColumnHeader, FRows);
  { final pass, scan the matrix from top to bottom, then from left to right }
  CalcTotal(FRowHeader, FColumns);
end;

procedure TfrxCrossMatrix.CalcBounds;
var
  i, j, k: Integer;
  ColumnItems, RowItems: TList;
  ColumnItem, RowItem: TfrxCrossHeader;
  Cell: PfrCrossCell;
  m: TfrxCustomMemoView;
  sz, totalSz, NewHeight: Extended;

  function DoCalc(const Value: Variant): Extended;
  var
    Size: TfrxPoint;
    r: Integer;
    s: String;
    Width, NewWidth: Extended;
    WidthChanged: Boolean;
  begin
    s := m.Text;
    m.Text := m.FormatData(Value, FCellMemos[k].DisplayFormat);
    r := m.Rotation;
    m.Rotation := 0;

    Width := FMaxWidth;
    NewWidth := Width;
    if Assigned(FOnCalcWidth) then
      FOnCalcWidth(j, NewWidth);
    m.Width := NewWidth;
    WidthChanged := NewWidth <> Width;

    Size := CalcSize(m);
    if Size.X > FMaxWidth then
      Size.X := FMaxWidth;
    if Size.X < FMinWidth then
      Size.X := FMinWidth;
    if WidthChanged then
      Size.X := NewWidth;
    if FDefHeight <> 0 then
      Size.Y := FDefHeight;
    if NewWidth = 0 then
      Size.Y := 0;

    m.Rotation := r;
    m.Text := s;

    if (ColumnItem.FSize.X < Size.X) or WidthChanged then
      ColumnItem.FSize.X := Size.X;

    if FPlainCells then
      Result := Size.X
    else
      Result := Size.Y;
  end;

begin
  ColumnItems := FColumnHeader.TerminalItems;
  RowItems := FRowHeader.TerminalItems;

  { calculate the widths of columns and the heights of rows }
  FColumnHeader.CalcSizes(FMaxWidth, FMinWidth);
  FRowHeader.CalcSizes(FMaxWidth, FMinWidth);

  { scanning the matrix cells and update calculated widths and heights }
  for i := 0 to RowItems.Count - 1 do
  begin
    RowItem := RowItems[i];

    for j := 0 to ColumnItems.Count - 1 do
    begin
      ColumnItem := ColumnItems[j];
      Cell := FRows[i].GetCell(FColumns[j].CellIndex);
      totalSz := 0;

      for k := 0 to FCellLevels - 1 do
      begin
        if ColumnItem.IsTotal then
          m := ColumnItem.Memo
        else if RowItem.IsTotal then
          m := RowItem.Memo else
          m := FCellMemos[k];

        sz := DoCalc(Cell.Value);
        totalSz := totalSz + sz;
        if FPlainCells then
          ColumnItem.FCellSizes[k] := sz;

        Cell := Cell.Next;
      end;

      if FPlainCells then
      begin
        if ColumnItem.FSize.X < totalSz then
          ColumnItem.FSize.X := totalSz
        else
          ColumnItem.FCellSizes[FCellLevels - 1] :=
            ColumnItem.FCellSizes[FCellLevels - 1] + (ColumnItem.FSize.X - totalSz);
      end
      else
      begin
        if RowItem.FSize.Y < totalSz then
          RowItem.FSize.Y := totalSz;
      end;
    end;

    NewHeight := RowItem.FSize.Y;
    if Assigned(FOnCalcHeight) then
      FOnCalcHeight(i, NewHeight);
    RowItem.FSize.Y := NewHeight;
  end;

  { calculate the positions and sizes of the header cells }
  FColumnHeader.CalcBounds;
  FRowHeader.CalcBounds;

  ColumnItems.Free;
  RowItems.Free;
end;


end.


//<censored>