frxcross.pas

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

{******************************************}
{ }
{ FastReport v3.0 }
{ Cross object }
{ }
{ Copyright (c) 1998-2005 }
{ by Alexander Tzyganenko, }
{ Fast Reports Inc. }
{ }
{******************************************}

unit frxCross;

interface

{$I frx.inc}

uses
  Windows, SysUtils, Classes, Controls, Graphics, Forms, frxCrossMatrix,
  frxClass
{$IFDEF Delphi6}
, Variants
{$ENDIF};

type
  TfrxCrossObject = class(TComponent); // fake component

  TfrxPrintCellEvent = type String;
  TfrxPrintHeaderEvent = type String;
  TfrxCalcWidthEvent = type String;
  TfrxCalcHeightEvent = type String;
  TfrxOnPrintCellEvent = procedure (Memo:TfrxCustomMemoView;
    RowIndex, ColumnIndex, CellIndex:Integer;
    const RowValues, ColumnValues, Value:Variant) of object;
  TfrxOnPrintHeaderEvent = procedure (Memo:TfrxCustomMemoView;
    const HeaderIndexes, HeaderValues, Value:Variant) of object;
  TfrxOnCalcWidthEvent = procedure (ColumnIndex:Integer;
    const ColumnValues:Variant; var Width:Extended) of object;
  TfrxOnCalcHeightEvent = procedure (RowIndex:Integer;
    const RowValues:Variant; var Height:Extended) of object;

  TfrxCustomCrossView = class(TfrxView)
  private
    FMatrix:TfrxCrossMatrix;
    FBorder:Boolean;
    FCellFields:TStrings;
    FCellLevels:Integer;
    FColumnBands:TList;
    FColumnFields:TStrings;
    FColumnLevels:Integer;
    FDefHeight:Integer;
    FDotMatrix:Boolean;
    FDownThenAcross:Boolean;
    FGapX:Integer;
    FGapY:Integer;
    FMaxWidth:Integer;
    FMinWidth:Integer;
    FOnCalcHeight:TfrxCalcHeightEvent; { script event }
    FOnCalcWidth:TfrxCalcWidthEvent; { script event }
    FOnPrintCell:TfrxPrintCellEvent; { script event }
    FOnPrintColumnHeader:TfrxPrintHeaderEvent; { script event }
    FOnPrintRowHeader:TfrxPrintHeaderEvent; { script event }
    FOnBeforeCalcHeight:TfrxOnCalcHeightEvent; { Delphi event }
    FOnBeforeCalcWidth:TfrxOnCalcWidthEvent; { Delphi event }
    FOnBeforePrintCell:TfrxOnPrintCellEvent; { Delphi event }
    FOnBeforePrintColumnHeader:TfrxOnPrintHeaderEvent; { Delphi event }
    FOnBeforePrintRowHeader:TfrxOnPrintHeaderEvent; { Delphi event }
    FPlainCells:Boolean;
    FRowBands:TList;
    FRowFields:TStrings;
    FRowLevels:Integer;
    FRepeatHeaders:Boolean;
    FShowColumnHeader:Boolean;
    FShowRowHeader:Boolean;
    procedure AddSourceObjects;
    procedure BuildColumnBands;
    procedure BuildRowBands;
    procedure ClearColumnBands;
    procedure ClearRowBands;
    procedure CorrectDMPBounds(Memo:TfrxCustomMemoView);
    procedure DoCalcHeight(Row:Integer; var Height:Extended);
    procedure DoCalcWidth(Column:Integer; var Width:Extended);
    procedure DoOnCell(Memo:TfrxCustomMemoView; Row, Column, Cell:Integer;
      const Value:Variant);
    procedure DoOnColumnHeader(Memo:TfrxCustomMemoView; Header:TfrxCrossHeader);
    procedure DoOnRowHeader(Memo:TfrxCustomMemoView; Header:TfrxCrossHeader);
    procedure ReadMemos(Stream:TStream);
    procedure RenderMatrix;
    procedure SetCellFields(const Value:TStrings);
    procedure SetCellFunctions(Index:Integer; const Value:TfrxCrossFunction);
    procedure SetColumnFields(const Value:TStrings);
    procedure SetColumnSort(Index:Integer; Value:TfrxCrossSortOrder);
    procedure SetRowFields(const Value:TStrings);
    procedure SetRowSort(Index:Integer; Value:TfrxCrossSortOrder);
    procedure SetShowColumnTotal(const Value:Boolean);
    procedure SetShowRowTotal(const Value:Boolean);
    procedure SetupOriginalComponent(Obj1, Obj2:TfrxComponent);
    procedure WriteMemos(Stream:TStream);
    function CreateMemo(Parent:TfrxComponent):TfrxCustomMemoView;
    function GetCellFunctions(Index:Integer):TfrxCrossFunction;
    function GetCellMemos(Index:Integer):TfrxCustomMemoView;
    function GetColumnMemos(Index:Integer):TfrxCustomMemoView;
    function GetColumnSort(Index:Integer):TfrxCrossSortOrder;
    function GetColumnTotalMemos(Index:Integer):TfrxCustomMemoView;
    function GetRowMemos(Index:Integer):TfrxCustomMemoView;
    function GetRowSort(Index:Integer):TfrxCrossSortOrder;
    function GetRowTotalMemos(Index:Integer):TfrxCustomMemoView;
    function GetShowColumnTotal:Boolean;
    function GetShowRowTotal:Boolean;
    procedure SetDotMatrix(const Value:Boolean);
    procedure SetPlainCells(const Value:Boolean);
  protected
    procedure DefineProperties(Filer:TFiler); override;
    procedure SetCellLevels(const Value:Integer); virtual;
    procedure SetColumnLevels(const Value:Integer); virtual;
    procedure SetRowLevels(const Value:Integer); virtual;
  public
    constructor Create(AOwner:TComponent); override;
    destructor Destroy; override;
    procedure Draw(Canvas:TCanvas; ScaleX, ScaleY, OffsetX, OffsetY:Extended); override;
    procedure BeforePrint; override;
    procedure GetData; override;
    procedure BeginMatrix;
    procedure EndMatrix;
    procedure FillMatrix; virtual;
    procedure AddValue(const Rows, Columns, Cells:array of Variant);

    function ColCount:Integer;
    function RowCount:Integer;
    function IsCrossValid:Boolean; virtual;
    function IsGrandTotalColumn(Index:Integer):Boolean;
    function IsGrandTotalRow(Index:Integer):Boolean;
    function IsTotalColumn(Index:Integer):Boolean;
    function IsTotalRow(Index:Integer):Boolean;
    function RowHeaderWidth:Extended;
    function ColumnHeaderHeight:Extended;

    property Matrix:TfrxCrossMatrix read FMatrix;
    property CellFields:TStrings read FCellFields write SetCellFields;
    property CellFunctions[Index:Integer]:TfrxCrossFunction read GetCellFunctions
      write SetCellFunctions;
    property CellMemos[Index:Integer]:TfrxCustomMemoView read GetCellMemos;
    property ColumnFields:TStrings read FColumnFields write SetColumnFields;
    property ColumnMemos[Index:Integer]:TfrxCustomMemoView read GetColumnMemos;
    property ColumnSort[Index:Integer]:TfrxCrossSortOrder read GetColumnSort
      write SetColumnSort;
    property ColumnTotalMemos[Index:Integer]:TfrxCustomMemoView read GetColumnTotalMemos;
    property DotMatrix:Boolean read FDotMatrix;
    property RowFields:TStrings read FRowFields write SetRowFields;
    property RowMemos[Index:Integer]:TfrxCustomMemoView read GetRowMemos;
    property RowSort[Index:Integer]:TfrxCrossSortOrder read GetRowSort
      write SetRowSort;
    property RowTotalMemos[Index:Integer]:TfrxCustomMemoView read GetRowTotalMemos;
    property OnBeforeCalcHeight:TfrxOnCalcHeightEvent
      read FOnBeforeCalcHeight write FOnBeforeCalcHeight;
    property OnBeforeCalcWidth:TfrxOnCalcWidthEvent
      read FOnBeforeCalcWidth write FOnBeforeCalcWidth;
    property OnBeforePrintCell:TfrxOnPrintCellEvent
      read FOnBeforePrintCell write FOnBeforePrintCell;
    property OnBeforePrintColumnHeader:TfrxOnPrintHeaderEvent
      read FOnBeforePrintColumnHeader write FOnBeforePrintColumnHeader;
    property OnBeforePrintRowHeader:TfrxOnPrintHeaderEvent
      read FOnBeforePrintRowHeader write FOnBeforePrintRowHeader;
  published
    property Border:Boolean read FBorder write FBorder default True;
    property CellLevels:Integer read FCellLevels write SetCellLevels default 1;
    property ColumnLevels:Integer read FColumnLevels write SetColumnLevels default 1;
    property DefHeight:Integer read FDefHeight write FDefHeight default 0;
    property DownThenAcross:Boolean read FDownThenAcross write FDownThenAcross;
    property GapX:Integer read FGapX write FGapX default 3;
    property GapY:Integer read FGapY write FGapY default 3;
    property MaxWidth:Integer read FMaxWidth write FMaxWidth default 200;
    property MinWidth:Integer read FMinWidth write FMinWidth default 0;
    property PlainCells:Boolean read FPlainCells write SetPlainCells default False;
    property RepeatHeaders:Boolean read FRepeatHeaders write FRepeatHeaders default True;
    property RowLevels:Integer read FRowLevels write SetRowLevels default 1;
    property ShowColumnHeader:Boolean read FShowColumnHeader write FShowColumnHeader
      default True;
    property ShowColumnTotal:Boolean read GetShowColumnTotal write SetShowColumnTotal
      default True;
    property ShowRowHeader:Boolean read FShowRowHeader write FShowRowHeader
      default True;
    property ShowRowTotal:Boolean read GetShowRowTotal write SetShowRowTotal
      default True;
    property OnCalcHeight:TfrxCalcHeightEvent read FOnCalcHeight write FOnCalcHeight;
    property OnCalcWidth:TfrxCalcWidthEvent read FOnCalcWidth write FOnCalcWidth;
    property OnPrintCell:TfrxPrintCellEvent read FOnPrintCell write FOnPrintCell;
    property OnPrintColumnHeader:TfrxPrintHeaderEvent
      read FOnPrintColumnHeader write FOnPrintColumnHeader;
    property OnPrintRowHeader:TfrxPrintHeaderEvent
      read FOnPrintRowHeader write FOnPrintRowHeader;
  end;

  TfrxCrossView = class(TfrxCustomCrossView)
  protected
    procedure SetCellLevels(const Value:Integer); override;
    procedure SetColumnLevels(const Value:Integer); override;
    procedure SetRowLevels(const Value:Integer); override;
  public
    class function GetDescription:String; override;
    function IsCrossValid:Boolean; override;
  published
  end;

  TfrxDBCrossView = class(TfrxCustomCrossView)
  private
  public
    class function GetDescription:String; override;
    function IsCrossValid:Boolean; override;
    procedure FillMatrix; override;
  published
    property CellFields;
    property ColumnFields;
    property DataSet;
    property DataSetName;
    property RowFields;
  end;

implementation

uses
{$IFNDEF NO_EDITORS}
  frxCrossEditor,
{$ENDIF}
  frxCrossRTTI, frxDsgnIntf, frxXML, frxUtils, frxXMLSerializer, frxRes,
  frxDMPClass;

type
  THackComponent = class(TfrxComponent);
  THackMemoView = class(TfrxCustomMemoView);

{ TfrxCustomCrossView }

constructor TfrxCustomCrossView.Create(AOwner:TComponent);
begin
  inherited;
  Frame.Typ:= [ftLeft, ftRight, ftTop, ftBottom];
  Font.Name:= 'Tahoma';
  Font.Size:= 8;
  Color:= clSilver;

  FMatrix:= TfrxCrossMatrix.Create;
  FCellFields:= TStringList.Create;
  FColumnFields:= TStringList.Create;
  FRowFields:= TStringList.Create;
  FColumnBands:= TList.Create;
  FRowBands:= TList.Create;
  FBorder:= True;
  FGapX:= 3;
  FGapY:= 3;
  FMaxWidth:= 200;
  CellLevels:= 1;
  ColumnLevels:= 1;
  RowLevels:= 1;
  FRepeatHeaders:= True;
  FShowColumnHeader:= True;
  FShowRowHeader:= True;
  FMatrix.OnCalcHeight:= DoCalcHeight;
  FMatrix.OnCalcWidth:= DoCalcWidth;
  if Page is TfrxDMPPage then
    SetDotMatrix(True);
end;

destructor TfrxCustomCrossView.Destroy;
begin
  FMatrix.Free;
  FCellFields.Free;
  FColumnFields.Free;
  FRowFields.Free;
  ClearColumnBands;
  ClearRowBands;
  FColumnBands.Free;
  FRowBands.Free;
  inherited;
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.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 CROSS_DIM_SIZE-1 do
    begin
      GetItem(CellMemos[i], 'cellmemos', i);
      GetItem(ColumnMemos[i], 'columnmemos', i);
      GetItem(ColumnTotalMemos[i], 'columntotalmemos', i);
      GetItem(RowMemos[i], 'rowmemos', i);
      GetItem(RowTotalMemos[i], 'rowtotalmemos', i);
      CellFunctions[i]:= GetItem1('cellfunctions', i);
      ColumnSort[i]:= GetItem2('columnsort', i);
      RowSort[i]:= GetItem2('rowsort', i);
    end;

  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, False, 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:= 'columnmemos';
    x.Root.Add.Name:= 'columntotalmemos';
    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 CellLevels-1 do
    begin
      AddItem(CellMemos[i], 'cellmemos');
      AddItem1(CellFunctions[i], 'cellfunctions');
    end;
    for i:= 0 to ColumnLevels-1 do
    begin
      AddItem(ColumnMemos[i], 'columnmemos');
      AddItem(ColumnTotalMemos[i], 'columntotalmemos');
      AddItem2(ColumnSort[i], 'columnsort');
    end;
    for i:= 0 to RowLevels-1 do
    begin
      AddItem(RowMemos[i], 'rowmemos');
      AddItem(RowTotalMemos[i], 'rowtotalmemos');
      AddItem2(RowSort[i], 'rowsort');
    end;

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

function TfrxCustomCrossView.CreateMemo(Parent:TfrxComponent):TfrxCustomMemoView;
begin
  if FDotMatrix then
    Result:= TfrxDMPMemoView.Create(Parent) else
    Result:= TfrxMemoView.Create(Parent);
end;

procedure TfrxCustomCrossView.CorrectDMPBounds(Memo:TfrxCustomMemoView);
begin
  if Memo is TfrxDMPMemoView then
  begin
    Memo.Left:= Memo.Left+fr1CharX;
    Memo.Top:= Memo.Top+fr1CharY;
    Memo.Width:= Memo.Width-fr1CharX;
    Memo.Height:= Memo.Height-fr1CharY;
  end;
end;

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

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

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

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