frxcrossmatrix.pas

报表源码 FastReport 3 is new generation of the report generators components. It consists of report engin

      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.