
{*******************************************************}
{                                                       }
{       Borland Delphi Visual Component Library         }
{                                                       }
{       Copyright (c) 1997,98 Inprise Corporation       }
{                                                       }
{*******************************************************}

unit mxstore;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Bde, DB, DBCommon, DBTables, mxArrays, Menus,
  mxpbar, mxcommon, mxTables;

const

  SubTotal  = -1;
  NonSparseAgg = -4;
  SparseUnknown = -3;
  SparseAgg = -2;
  SparseSum = -1;
  MaxBinDimensions = 16;
  LargeValueCount = 50;
type

  TMultiDimDataLink = class;
  TDataCache = class;
  TCustomDataStore = class;
  TCubeDims = class;
  TCubeDim = class;

  TErrorAction = ( eaFail, eaContinue );

  TCapacityErrorEvent = procedure( var EAction: TErrorAction ) of object;
  TCubeNotifyEvent  = procedure( DataCube: TCustomDataStore ) of object;
  TCubeRefreshEvent = procedure( DataCube: TCustomDataStore; DimMap: TCubeDims ) of object;

  // Designtime state
  TCubeDataState = ( dsNoData, dsMetaData, dsDimensionData, dsAllData );

  TBuildType = ( btHardRebuild, btSoftRebuild, btNoRebuild );

  // Public cube state
  TCubeState = ( dcInactive, dcBrowseMetaData, dcBrowseMemberData, dcBrowseAllData );

  // These flags govern some of the behaviour of dimensions and summaries
  TDimFlagSet = Set of TDimFlags;

  TCubeDimTransformEvent = procedure( var Value: Variant; Data: TCubeDim ) of object;

  TCubeDim = class( TDimensionItem )
  protected
    procedure YearTransform( var Value: Variant; CubeDim: TCubeDim );
    procedure QuarterTransform( var Value: Variant; CubeDim: TCubeDim );
    procedure MonthTransform( var Value: Variant; CubeDim: TCubeDim );
    procedure DataSetTransform( var Value: Variant; CubeDim: TCubeDim );
    function  AssignBinTypeTransform( Bins: TBinType ): TCubeDimTransformEvent;
    function  AssignBinTypeFormat( Bins: TBinType ): string;
    procedure NotifyCollection( aType: TCDNotifyType ); override;
    procedure InitializeRange; override;
    procedure DoTransform( var Value: Variant ); virtual;
    property  Dirty: Boolean;
    function  GetLoaded:	Boolean;
    procedure SetLoaded( Value: Boolean );
    property  wasActive: boolean;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Value: TPersistent); override;
    function GetBinValues( Value: Variant ): Variant;
    function IsBinData: Boolean;
    property BinFormat: string;
    property StartDate: TDate;
    property Loaded: boolean;
    property StartValue: String;
    property BinData: TBinData;
    property OnTransform: TCubeDimTransformEvent;
  published
    property BinType: TBinType;
    property ValueCount: integer;
  end;

  TCubeDimClass = class of TCubeDim;

  TCubeDims = class(TDimensionItems)
  protected
    function    Add: TCubeDim;
    function    GetDirtyFlag: Boolean;
    function GetOwner: TPersistent; override;
  public
    constructor Create(FOwner: TPersistent; ItemClass: TCubeDimClass);
    procedure Assign(Source: TPersistent);override;
    property IsDirty: Boolean;
    property Items[Index: Integer]:TCubeDim; default;
  end;

  //
  // This is the multi-dimensional data store component
  //
  TCustomDataStore = class(TComponent)
  protected
    procedure    ActiveChanged; virtual;
    procedure    StateChanged; virtual;
    procedure    DoBeforeOpen; virtual;
    procedure    DoAfterOpen; virtual;
    procedure    DoBeforeClose; virtual;
    procedure    DoAfterClose; virtual;
    procedure    DoOnRefresh( DimMap: TCubeDims ); virtual;
    function  GetDataSet: TDataSet;
    function  GetDomain( DimensionIDs: TIntArray; ATotals: Boolean; Domain: TTwoDimArray ): Integer;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure SetDataSet(ADataSet: TDataSet);
    function  GetCurrentSummary: Integer;
    procedure SetCurrentSummary( Value: Integer );
    procedure LayoutChanged; virtual;
    function  BinMapHasBinData: Boolean;
    function  CanDimBeClosed( iMapIndex: integer ): boolean; virtual;
    function  CanSumBeClosed( iMapIndex: integer ): boolean; virtual;
    property  DataCache: TDataCache;
    property  DataLink: TMultiDimDataLink;
    property  InternalDataSource: TDataSource;
    property  DesignState: TCubeDataState;
    property  DataSource: TDataSource;
    property  Active: Boolean default False;
    property  State: TCubeState;																				{ Returns the cube state }
  public
    constructor Create( AOwner: TComponent ); override;
    destructor Destroy; override;
    procedure CalcSubTotals;                                 // $$$ Evaluate
    procedure Refresh( DimMap: TCubeDims; bForce: boolean ); //pg
    function  GetMemoryUsage: Integer;		                                { Gets the total memory consumed by the DecisionCube}
    function  GetDimensionName( Dimension: Integer ): String; virtual;	        { Returns the name of the dimension as a string }
    function  GetDimensionMemberCount( Dimension: Integer ): Integer; virtual;	{ Returns the number of members of a dimension }
    function  GetMemberAsString( Dimension, Index: Integer ): String; virtual;  { Returns the value of the member at index as a string }
    function  GetMemberAsVariant( Dimension, Index: Integer ): Variant;		{ Returns the value of the member at index as a variant }
    function  GetSummaryName( ISum: Integer ): String; virtual;			{ Returns the name of the summary }
    function  GetSummaryAsString( Coord: TSmallIntArray ): String; virtual;	{ Gets the summary value as a string }
    function  GetSummaryAsVariant( Coord: TSmallIntArray ): Variant; virtual;	{ Gets the summary value as a variant }
    property  DimensionMapCount: Integer;		{ Gets the number of dimensions in TCubeDims }
    property  DimensionCount: Integer;			  { Gets the number of dimensions }
    property  SummaryCount: Integer;			      { Get the number of summaries }
    property  CurrentSummary: Integer;  { Returns the active summary }
    property  Capacity: Integer;								  { Sets the Internal capacity limit for the cache }
    property  BinData: Boolean;                     { Reports if the data set is being binned or not }
    property  DataSet: TDataSet;		              { Reads and sets the data set }
    property  DimensionMap:	TCubeDims;     { Reads or sets TCubeDims }
    property  ShowProgressDialog: Boolean;
    property  MaxDimensions: Integer;
    property  MaxSummaries: Integer;
    property  MaxCells: Integer;
    property  OnLowCapacity: TCapacityErrorEvent;
    property  BeforeOpen: TCubeNotifyEvent;
    property  AfterOpen: TCubeNotifyEvent;
    property  BeforeClose: TCubeNotifyEvent;
    property  AfterClose: TCubeNotifyEvent;
    property  OnRefresh: TCubeRefreshEvent;
  end;

  //
  // This object handles the interface to a datasource, be it a table or a query.
  //
  TMultiDimDataLink = class(TDataLink)
  protected
    function  AddDimension( DimMap: TCubeDim; Fld: TField ): Integer;
    procedure AddSummary( DimMap: TCubeDim; Fld: TField );
    procedure ActiveChanged; override;
    procedure LayoutChanged; override;
    procedure UpdateCache( Sender: TObject );
    procedure UpdateDimensions( DimAllList: TList );
    procedure FetchValues( DimAllList: TList );
    procedure FetchAndBinValues( DimAllList: TList );
    procedure CreateSummaryIndex( DimAllList: TList );
    procedure UpdateFormatStrings;
  public
    constructor Create( AStore: TCustomDataStore );
    destructor Destroy; override;
  end;

  //
  //  The basic field definition, dependent on DB implementation.
  //
  TFormatType = ( fxNone, fxFloat, fxCurrency, fxDateTime, fxTime, fxDate, fxString, fxInteger, fxBoolean );
  TFieldDefinition = class
  public
    constructor Create;
    function FormatVariantToStr( Value: Variant ): string;
    procedure SetFieldType( FType: TFieldType );
    procedure SetName( Value: String );
    property Width: Integer;
    property FormatString: string;
    property FieldType: TFieldType;
    property Precision: integer;
    property DisplayName: String;
    property FieldNo: Integer;
  end;

  //
  //  This is the dimension object that contains unique members for a field
  //
  TDimension = class(TCustomArray)
  public
    constructor Create( Items: Cardinal; DataType: TFieldType );
    destructor  Destroy; override;
    function    IsString: Boolean;
    procedure   SetFlag( aFlag: TDimFlags );
    Function    HasFlag( aFlag: TDimFlags ): Boolean;
    Procedure   ClearFlag( aFlag: TDimFlags );
    procedure   SetRangeCounting( bRange: Boolean );
    procedure   AssignSorted( Dim: TDimension; bUnique: Boolean );
    property    Range: Integer;
    property    Attributes: TDimFlags;
    property    DimensionName: String;
    property    FieldType: TFieldType;
    property    Position: Integer;
    property    FieldDefinition: TFieldDefinition;
    property    FieldName: string;
  end;

  TIndexFlag = ( idxNormal, idxSparsed, idxFiltered, idxSubTotals, idxDeleted );
  TIndexFlags = set of TIndexFlag;

  PIndexInfoRec = ^TIndexInfoRec;
  TIndexInfoRec = Record
    SparseCnt,
    SubTotalCnt,
    AggOffset: Integer;
    Flags: TIndexFlags;
  end;

  TIndexInfo = class
  public
    constructor Create;
    destructor Destroy; override;
    procedure SetCapacity( Value: Integer );
    function  GetCapacity: Integer;
    function  Add( pIdxRec: PIndexInfoRec ): Integer;
    function  IsSparse( Index: Integer ): Boolean;
    function  IsSparseAgg( Index: Integer ): Boolean;
    procedure AddOffset( Index, IdxType: Integer );
    function  LockIndex: TIntArray;
    procedure UnlockIndex;
    property Count: Integer;
    property Capacity: Integer;
    property AddAggs: Boolean;
  end;

  TDerivedAggProc = function( Val1, Val2: Variant ): Variant;
  TFieldArgs = array[0..255] of Byte;

  TAggDefinition = class
  public
    property AggProc: TDerivedAggProc;
  end;

  TSummary = class;
  TSumMethod = function ( SumIndex: TSmallIntArray; Summary: TSummary; var Value: Variant ): Boolean of object;

  //
  //  This is the summary object that contains the summary data and sub-totals
  //
  TSummary = class(TCustomArray)
  protected
    Function    HasFlag( aFlag: TDimFlags ): Boolean;
    function    SetAggregator( aName: string; DimMap: TCubeDims; dimType: TDimFlags; var dIdx: Integer ): Boolean;
  public
    constructor Create( Items: Cardinal; DataType: TFieldType );
    destructor  Destroy; override;
    procedure   ClearTotals;
    function    MemoryUsage: Integer; override;
    function    IsSparse( Index: Integer ): Boolean;
    procedure   UpdateIndexInfo( Index: Integer; Value: Variant );
    function    AddIndexInfo( BTotal, bSparse: Boolean; iAggOffset: Integer ): Integer;
    function    AddSubTotal( Value: Variant ): Integer;
    procedure   AddSum( var SumIndex: TSmallIntArray; vNew: Variant );
    property    Name: String;
    property    Attributes: TDimFlags;
    property    FieldType: TFieldType;
    property    Position: Integer;
    property    FieldDefinition: TFieldDefinition;
    property    FieldName: string;
    property    SumMethod: TSumMethod;
    property    CubeDimIndex: Integer;
    property    AggDefinition: TAggDefinition;
    property    IsDerived: Boolean;
  end;

  //
  // This class contains the main summary data cache
  //

  ECacheError = class(Exception);
  TAggProc = function ( eCnt, Range: Integer; Summary: TSummary; SumIndex: TSmallIntArray; var vNew: Variant ): Boolean;

  // These flags govern the general build state of the cache.
  TCacheStateFlags = ( csHasIndex, csDirty, csSuccess, csShowProgress, csRefreshing );
  TCacheState = set of TCacheStateFlags;

  // These flags govern the building of lookups for pivoting
  TLookupStateFlags = ( lsSparsing, lsCursor, lsShowProgress );
  TLookupState = set of TLookupStateFlags;

  // These flags govern how totals will be calculated and stored
  TCalcTotalsFlags = ( ctPreCalc, ctRunning, ctNone );
  TCalcTotals = set of TCalcTotalsFlags;

  TDataCache = class
  protected
    procedure FreeCache;
  public
    constructor Create;
    destructor  Destroy; override;
    function    GetMemoryUsage: Integer;
    procedure   CalcSubTotals;
    procedure   ClearIndexInfo;
    function    AddAggIndex( SumIndex: TSmallIntArray; BuilderDims: TList  ):Integer;
    function    AddIndex( SumIndex: TSmallIntArray; bSparse: Boolean ):Integer;
    function    IsDimension( Position: Integer ): Boolean;
    function    IsSummary( Position: Integer ): Boolean;
    function    SummaryFromPosition( Position: Integer ): TSummary;
    function    SummaryFromFieldName( FldName: string ): TSummary;
    function    SummaryFromCubeDimIndex( Index: Integer ): TSummary;
    function    DimensionFromFieldName( FldName: string ): TDimension;
    function    AppendDimension( Value: TDimension ): Integer;
    function    AppendSummary( Value: TSummary ): Integer;
    function    GetDimensionName( DimIndex: Integer ): String;
    function    GetSummaryName( ISum: Integer ): String;
    function    GetDimensionMember( DimIndex, MemberIndex: Integer ): String;
    function    GetDimensionMemberAsVariant( DimIndex, MemberIndex: Integer ): Variant;
    function    GetDimensionMemberCount( DimIndex : Integer ): Integer;
    function    GetIndexCount: Integer;
    function    IncSummaryIndex( Summary: TSummary; SumIndex, rangeCount: TSmallIntArray; var bGroupBreak: Boolean ): Boolean;
    function    HasSubTotals( SumIndex: TSmallIntArray ): Boolean;
    function    HasValidSubTotals( Summary: TSummary ; SumIndex: TSmallIntArray ): Boolean;
    function    GetSummaryAsString( SumIndex: TSmallIntArray ): String;
    function    GetSummaryAsVariant( SumIndex: TSmallIntArray ): Variant;
    procedure   CreateTable( Const Filename: String );
    function    GetDomain( DimensionIDs: TIntArray; nDims: Integer; ATotals: Boolean; Domain: TTwoDimArray ): Integer; //!!
    property    PreCalculateTotals: Boolean;
    property    CurrentSummary: Integer;
    property    DimensionCount: Integer;
    property    SummaryCount: Integer;
    property    Summaries[Index: Integer]: TSummary;
    property    Dimensions[Index: Integer]: TDimension;
    property    Active: Boolean;
    property    Sparsing: Boolean;
    property    IndexCount: Integer;
    property    Success: Boolean;
    property    ErrorCode: Integer;
    property    HasIndex: Boolean;
{$IFDEF PROFILE}
    property  Ticks: TTicks;
    property  ProfileLogFile: string;
{$ENDIF}
  end;

  TBuilderDim = class( TDimension )
  protected
    function GetLastVal: Variant;
    procedure SetLastVal( Value: Variant );
  public
    constructor Create( Items: Cardinal; DataType: TFieldType );
    destructor Destroy; override;
    function  GetSumCount: Integer;
    function  GetSummary( Value: Variant ): Variant;
    procedure InitSummary( DataType: Integer );
    procedure Add( Value: Variant );         // Add the value
    procedure AddSummary( Value: Variant );  // Add to the running summary
    function  MatchLastVal( Value: Variant ): Boolean;
    property  GroupBreak: Boolean;
    property  LastVal: Variant;
    property  SumCount: Integer;
  end;

  function TestMatch( SumIdx: TSmallIntArray ): Boolean;

implementation
