frxcross.pas

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

  Result := Index = FRows.Count - 1;
end;

function TfrxCustomCrossView.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 TfrxCustomCrossView.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 TfrxCustomCrossView.GetColumnIndexes(AColumn: Integer): Variant;
begin
  Result := FColumns[AColumn].Indexes;
end;

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

procedure TfrxCustomCrossView.SetCellFields(const Value: TStrings);
begin
  FCellFields.Assign(Value);
end;

procedure TfrxCustomCrossView.SetColumnFields(const Value: TStrings);
begin
  FColumnFields.Assign(Value);
end;

procedure TfrxCustomCrossView.SetRowFields(const Value: TStrings);
begin
  FRowFields.Assign(Value);
end;

procedure TfrxCustomCrossView.SetCellLevels(const Value: Integer);
var
  max: Integer;
begin
  FCellLevels := Value;
  CreateCellMemos(FCellLevels * (FRowLevels + 1) * (FColumnLevels + 1));
  max := FRowLevels;
  if FColumnLevels > max then
    max := FColumnLevels;
  CreateCellHeaderMemos(FCellLevels * (max + 1));
end;

procedure TfrxCustomCrossView.SetColumnLevels(const Value: Integer);
var
  max, lvl: Integer;
begin
  FColumnLevels := Value;
  lvl := FColumnLevels;
  if lvl = 0 then
    lvl := 1;
  CreateColumnMemos(lvl);
  CreateCellMemos(FCellLevels * (FRowLevels + 1) * (FColumnLevels + 1));
  max := FRowLevels;
  if FColumnLevels > max then
    max := FColumnLevels;
  CreateCellHeaderMemos(FCellLevels * (max + 1));
end;

procedure TfrxCustomCrossView.SetRowLevels(const Value: Integer);
var
  max, lvl: Integer;
begin
  FRowLevels := Value;
  lvl := FRowLevels;
  if lvl = 0 then
    lvl := 1;
  CreateRowMemos(lvl);
  CreateCornerMemos(FRowLevels + 3);
  CreateCellMemos(FCellLevels * (FRowLevels + 1) * (FColumnLevels + 1));
  max := FRowLevels;
  if FColumnLevels > max then
    max := FColumnLevels;
  CreateCellHeaderMemos(FCellLevels * (max + 1));
end;

procedure TfrxCustomCrossView.SetDotMatrix(const Value: Boolean);
begin
  FDotMatrix := Value;
  if FDotMatrix then
  begin
    FGapX := 0;
    FGapY := 0;
  end;
end;

function TfrxCustomCrossView.IsCrossValid: Boolean;
begin
  Result := True;
end;

function TfrxCustomCrossView.ColumnHeaderHeight: Extended;
begin
  Result := ColumnHeader.Height;
end;

function TfrxCustomCrossView.RowHeaderWidth: Extended;
begin
  Result := RowHeader.Width;
  if FNoRows then
    Result := 0;
end;

procedure TfrxCustomCrossView.Notification(AComponent: TComponent; Operation: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FNextCross) then
    FNextCross := nil;
end;

procedure TfrxCustomCrossView.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineBinaryProperty('Memos', ReadMemos, WriteMemos, True);
end;

procedure TfrxCustomCrossView.ReadMemos(Stream: TStream);
var
  x: TfrxXMLDocument;
  i: Integer;

  procedure GetItem(m: TfrxCustomMemoView; const Name: String; Index: Integer);
  var
    xs: TfrxXMLSerializer;
    Item: TfrxXMLItem;
  begin
    Item := x.Root.FindItem(Name);
    if Index >= Item.Count then Exit;
    Item := Item[Index];

    xs := TfrxXMLSerializer.Create(nil);
    m.Color := clNone;
    m.Frame.Color := clBlack;
    m.Frame.Width := 1;
    m.Frame.Typ := [];
    m.Font.Style := [];
    m.HAlign := haLeft;
    m.VAlign := vaTop;
    xs.ReadRootComponent(m, Item);
    xs.Free;
  end;

  function GetItem1(const Name: String; Index: Integer): TfrxCrossFunction;
  var
    Item: TfrxXMLItem;
  begin
    Result := cfNone;
    Item := x.Root.FindItem(Name);
    if Index >= Item.Count then Exit;
    Item := Item[Index];
    Result := TfrxCrossFunction(StrToInt(Item.Text));
  end;

  function GetItem2(const Name: String; Index: Integer): TfrxCrossSortOrder;
  var
    Item: TfrxXMLItem;
  begin
    Result := soAscending;
    Item := x.Root.FindItem(Name);
    if Index >= Item.Count then Exit;
    Item := Item[Index];
    Result := TfrxCrossSortOrder(StrToInt(Item.Text));
  end;

begin
  x := TfrxXMLDocument.Create;
  try
    x.LoadFromStream(Stream);

    for i := 0 to FCellLevels - 1 do
      CellFunctions[i] := GetItem1('cellfunctions', i);

    for i := 0 to FCellHeaderMemos.Count - 1 do
      GetItem(CellHeaderMemos[i], 'cellheadermemos', i);

    for i := 0 to FCellMemos.Count - 1 do
      GetItem(CellMemos[i], 'cellmemos', i);

    for i := 0 to FColumnMemos.Count - 1 do
    begin
      GetItem(ColumnMemos[i], 'columnmemos', i);
      GetItem(ColumnTotalMemos[i], 'columntotalmemos', i);
      ColumnSort[i] := GetItem2('columnsort', i);
    end;

    for i := 0 to FRowMemos.Count - 1 do
    begin
      GetItem(RowMemos[i], 'rowmemos', i);
      GetItem(RowTotalMemos[i], 'rowtotalmemos', i);
      RowSort[i] := GetItem2('rowsort', i);
    end;

    for i := 0 to FCornerMemos.Count - 1 do
      GetItem(CornerMemos[i], 'cornermemos', i);

  finally
    x.Free;
  end;
end;

procedure TfrxCustomCrossView.WriteMemos(Stream: TStream);
var
  x: TfrxXMLDocument;
  i: Integer;

  procedure AddItem(m: TfrxCustomMemoView; const Name: String);
  var
    xs: TfrxXMLSerializer;
  begin
    xs := TfrxXMLSerializer.Create(nil);
    xs.WriteRootComponent(m, True, x.Root.FindItem(Name).Add);
    xs.Free;
  end;

  procedure AddItem1(f: TfrxCrossFunction; const Name: String);
  var
    Item: TfrxXMLItem;
  begin
    Item := x.Root.FindItem(Name);
    Item := Item.Add;
    Item.Name := 'item';
    Item.Text := IntToStr(Integer(f));
  end;

  procedure AddItem2(f: TfrxCrossSortOrder; const Name: String);
  var
    Item: TfrxXMLItem;
  begin
    Item := x.Root.FindItem(Name);
    Item := Item.Add;
    Item.Name := 'item';
    Item.Text := IntToStr(Integer(f));
  end;

begin
  x := TfrxXMLDocument.Create;
  x.Root.Name := 'cross';

  try
    x.Root.Add.Name := 'cellmemos';
    x.Root.Add.Name := 'cellheadermemos';
    x.Root.Add.Name := 'columnmemos';
    x.Root.Add.Name := 'columntotalmemos';
    x.Root.Add.Name := 'cornermemos';
    x.Root.Add.Name := 'rowmemos';
    x.Root.Add.Name := 'rowtotalmemos';
    x.Root.Add.Name := 'cellfunctions';
    x.Root.Add.Name := 'columnsort';
    x.Root.Add.Name := 'rowsort';

    for i := 0 to FCellLevels - 1 do
      AddItem1(CellFunctions[i], 'cellfunctions');

    for i := 0 to FCellHeaderMemos.Count - 1 do
      AddItem(CellHeaderMemos[i], 'cellheadermemos');

    for i := 0 to FCellMemos.Count - 1 do
      AddItem(CellMemos[i], 'cellmemos');

    for i := 0 to FColumnMemos.Count - 1 {FColumnLevels - 1} do
    begin
      AddItem(ColumnMemos[i], 'columnmemos');
      AddItem(ColumnTotalMemos[i], 'columntotalmemos');
      AddItem2(ColumnSort[i], 'columnsort');
    end;

    for i := 0 to FRowMemos.Count - 1 {FRowLevels - 1} do
    begin
      AddItem(RowMemos[i], 'rowmemos');
      AddItem(RowTotalMemos[i], 'rowtotalmemos');
      AddItem2(RowSort[i], 'rowsort');
    end;

    for i := 0 to FCornerMemos.Count - 1 do
      AddItem(CornerMemos[i], 'cornermemos');

    x.SaveToStream(Stream);
  finally
    x.Free;
  end;
end;

procedure TfrxCustomCrossView.CreateCellHeaderMemos(NewCount: Integer);
var
  i: Integer;
  m: TfrxCustomMemoView;
begin
  for i := FCellHeaderMemos.Count to NewCount - 1 do
  begin
    m := CreateMemo(nil);
    FCellHeaderMemos.Add(m);
    m.Restrictions := [rfDontDelete];
    m.VAlign := vaCenter;
    m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
    m.AllowExpressions := False;
  end;
end;

procedure TfrxCustomCrossView.CreateCellMemos(NewCount: Integer);
var
  i: Integer;
  m: TfrxCustomMemoView;
begin
  for i := FCellMemos.Count to NewCount - 1 do
  begin
    m := CreateMemo(nil);
    FCellMemos.Add(m);
    m.Restrictions := [rfDontDelete];
    m.HAlign := haRight;
    m.VAlign := vaCenter;
    m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
    m.AllowExpressions := False;
  end;
end;

procedure TfrxCustomCrossView.CreateColumnMemos(NewCount: Integer);
var
  i: Integer;
  m: TfrxCustomMemoView;
begin
  for i := FColumnMemos.Count to NewCount - 1 do
  begin
    m := CreateMemo(nil);
    FColumnMemos.Add(m);
    m.Restrictions := [rfDontDelete, rfDontEdit];
    m.HAlign := haCenter;
    m.VAlign := vaCenter;
    m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
    m.AllowExpressions := False;

    m := CreateMemo(nil);
    FColumnTotalMemos.Add(m);
    m.Restrictions := [rfDontDelete];
    if i = 0 then
      m.Text := 'Grand Total'
    else
      m.Text := 'Total';
    m.Font.Style := [fsBold];
    m.HAlign := haCenter;
    m.VAlign := vaCenter;
    m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
  end;
end;

procedure TfrxCustomCrossView.CreateRowMemos(NewCount: Integer);
var
  i: Integer;
  m: TfrxCustomMemoView;
begin
  for i := FRowMemos.Count to NewCount - 1 do
  begin
    m := CreateMemo(nil);
    FRowMemos.Add(m);
    m.Restrictions := [rfDontDelete, rfDontEdit];
    m.HAlign := haCenter;
    m.VAlign := vaCenter;
    m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
    m.AllowExpressions := False;

    m := CreateMemo(nil);
    FRowTotalMemos.Add(m);
    m.Restrictions := [rfDontDelete];
    if i = 0 then
      m.Text := 'Grand Total'
    else
      m.Text := 'Total';
    m.Font.Style := [fsBold];
    m.HAlign := haCenter;
    m.VAlign := vaCenter;
    m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
  end;
end;

procedure TfrxCustomCrossView.CreateCornerMemos(NewCount: Integer);
var
  i: Integer;
  m: TfrxCustomMemoView;
begin
  for i := FCornerMemos.Count to NewCount - 1 do
  begin
    m := CreateMemo(nil);
    FCornerMemos.Add(m);
    m.Restrictions := [rfDontDelete];
    m.HAlign := haCenter;
    m.VAlign := vaCenter;
    m.Frame.Typ := [ftLeft, ftRight, ftTop, ftBottom];
    m.AllowExpressions := False;
  end;
end;

procedure TfrxCustomCrossView.ClearMemos;
begin
  while FCellHeaderMemos.Count > 0 do
  begin
    CellHeaderMemos[0].Free;
    FCellHeaderMemos.Delete(0);
  end;
  while FCellMemos.Count > 0 do
  begin
    CellMemos[0].Free;
    FCellMemos.Delete(0);
  end;
  while FColumnMemos.Count > 0 do
  begin
    ColumnMemos[0].Free;
    FColumnMemos.Delete(0);
    ColumnTotalMemos[0].Free;
    FColumnTotalMemos.Delete(0);
  end;
  while FRowMemos.Count > 0 do
  begin
    RowMemos[0].Free;
    FRowMemos.Delete(0);
    RowTotalMemos[0].Free;
    FRowTotalMemos.Delete(0);
  end;
  while FCornerMemos.Count > 0 do
  begin
    CornerMemos[0].Free;
    FCornerMemos.Delete(0);
  end;
end;

procedure TfrxCustomCrossView.InitMatrix;
var
  ColL, RowL: Integer;
begin
  ClearMatrix;

  RowL := FRowLevels;
  FNoRows := FRowLevels = 0;
  if FNoRows then
    RowL := 1;
  ColL := FColumnLevels;
  FNoColumns := FColumnLevels = 0;
  if FNoColumns then
    ColL := 1;

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

  FColumns := TfrxCrossColumns.Create;
  FC