memtabledataeh.pas

增加了条件求和功能

{*******************************************************}
{                                                       }
{                     EhLib vX.X                        }
{                                                       }
{          TMemTableDataEh component (Build 5)          }
{                                                       }
{        Copyright (c) 2003 by EhLib Team and           }
{                Dmitry V. Bolshakov                    }
{                                                       }
{*******************************************************}

unit MemTableDataEh;

{$I EhLib.Inc}

interface

uses Windows, SysUtils, Classes,
{$IFDEF EH_LIB_6}
  Variants, MaskUtils, SqlTimSt, FMTBcd,
{$ELSE}
  ActiveX,
{$ENDIF}
  Db, Contnrs, DBCommon;

type

  TMemTableDataEh = class;
  TMTDataStructEh = class;
  TRecordsViewEh = class;

{ TDataSetExprParserEh }

  TDataSetExprParserTypeEh = (dsptFilterEh, dsptAggregateEh);

  TDataSetExprParserEh = class
  private
    FDataSet: TDataSet;
    FExprData: TExprData;
    FExprDataSize: Integer;
    FExprParserType: TDataSetExprParserTypeEh;
  public
    constructor Create(ADataSet: TDataSet; ExprParserType: TDataSetExprParserTypeEh);
    procedure ParseExpression(Expr: String);
    function IsCurRecordInFilter: Boolean;
    function CalcAggregateValue(RecordsView: TRecordsViewEh): Variant;
    function HasData: Boolean;
  end;

{ TMTDataFieldEh }

  TMTDataFieldEh = class(TComponent)
  private
    FDataStruct: TMTDataStructEh;
    FFieldId: Largeint;
    FFieldName: String;
    FAlignment: TAlignment;
    FDefaultExpression: String;
    FDisplayWidth: Integer;
    FEditMask: String;
    FReadOnly: Boolean;
    FRequired: Boolean;
    FSize: Integer;
    FVisible: Boolean;
    FDisplayLabel: String;
    procedure SetDataStruct(const Value: TMTDataStructEh);
    function GetIndex: Integer;
  protected
    function DefaultSize: Integer; virtual;
    function DefaultAlignment: TAlignment; virtual;
    function DefValueForDefaultExpression: String; virtual;
    function DefaultDisplayLabel: String; virtual;
    function DefaultDisplayWidth: Integer; virtual;
    function DefaultEditMask: String; virtual;
    function DefaultRequired: Boolean; virtual;
    function DefaultVisible: Boolean; virtual;
    function GetAlignment: TAlignment; virtual;
    function GetDataType: TFieldType; virtual;
    function GetDefaultExpression: String; virtual;
    function GetDisplayLabel: String; virtual;
    function GetDisplayWidth: Integer; virtual;
    function GetEditMask: String; virtual;
    function GetFieldName: String; virtual;
    function GetReadOnly: Boolean; virtual;
    function GetRequired: Boolean; virtual;
    function GetSize: Integer; virtual;
    function GetVisible: Boolean; virtual;
    procedure SetAlignment(const Value: TAlignment); virtual;
    procedure SetDefaultExpression(const Value: String); virtual;
    procedure SetDisplayLabel(const Value: String); virtual;
    procedure SetDisplayWidth(const Value: Integer); virtual;
    procedure SetEditMask(const Value: String); virtual;
    procedure SetFieldName(const Value: String); virtual;
    procedure SetReadOnly(const Value: Boolean); virtual;
    procedure SetRequired(const Value: Boolean); virtual;
    procedure SetSize(const Value: Integer); virtual;
    procedure SetVisible(const Value: Boolean); virtual;

    procedure CheckInactive;

    procedure SetParentComponent(AParent: TComponent); override;
    procedure ReadState(Reader: TReader); override;
    procedure AssignDataType(FieldType: TFieldType); virtual;

  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    function CanDinaSize: Boolean; virtual;
    function GetVarDataType: TVarType; virtual;
    procedure Assign(Source: TPersistent); override;
    procedure AssignProps(Field: TField); virtual;

    property DataStruct: TMTDataStructEh read FDataStruct write SetDataStruct;
    property DataType: TFieldType read GetDataType;
    property Size: Integer read GetSize write SetSize;

    property Alignment: TAlignment read GetAlignment write SetAlignment;
    property DefaultExpression: String read GetDefaultExpression write SetDefaultExpression;
    property DisplayLabel: String read GetDisplayLabel write SetDisplayLabel;
    property DisplayWidth: Integer read GetDisplayWidth write SetDisplayWidth;
    property EditMask: String read GetEditMask write SetEditMask;
    property Required: Boolean read GetRequired write SetRequired;
    property Visible: Boolean read GetVisible write SetVisible;
    property Index: Integer read GetIndex;

  published
    property FieldName: String read GetFieldName write SetFieldName;
  end;

  TStringDataFieldTypesEh = (fdtStringEh, fdtFixedCharEh, fdtWideStringEh);

  TMTDataFieldClassEh = class of TMTDataFieldEh;

{ TMTStringDataFieldEh }

  TMTStringDataFieldEh = class(TMTDataFieldEh)
  private
    FFixedChar: Boolean;
    FTransliterate: Boolean;
    FStringDataType: TStringDataFieldTypesEh;
  protected
    function DefaultSize: Integer; override;
    function GetDataType: TFieldType; override;
    procedure AssignDataType(FieldType: TFieldType); override;
  public
    function CanDinaSize: Boolean; override;
    procedure AssignProps(Field: TField); override;
    procedure Assign(Source: TPersistent); override;
  published
    property StringDataType: TStringDataFieldTypesEh read FStringDataType write FStringDataType;
    property Alignment;
    property DefaultExpression;
    property DisplayLabel;
    property DisplayWidth;
    property EditMask;
    property Required;
    property Visible;

    property FixedChar: Boolean read FFixedChar write FFixedChar default False;
    property Size;// default 20;
    property Transliterate: Boolean read FTransliterate write FTransliterate default True;

  end;

  TNumericDataFieldTypesEh = (fdtSmallintEh, fdtIntegerEh, fdtWordEh,
    fdtFloatEh, fdtCurrencyEh, fdtBCDEh, fdtAutoIncEh, fdtLargeintEh
{$IFDEF EH_LIB_6}
    ,fdtFMTBcdEh
{$ENDIF}
    );

{ TMTNumericDataFieldEh }

  TMTNumericDataFieldEh = class(TMTDataFieldEh)
  private
    FDisplayFormat: string;
    FEditFormat: string;
    FCurrency: Boolean;
    FMaxValue: Double;
    FMinValue: Double;
    FPrecision: Integer;
    FNumericDataType: TNumericDataFieldTypesEh;
  protected
    function GetDataType: TFieldType; override;
    procedure AssignDataType(FieldType: TFieldType); override;
  public
    procedure AssignProps(Field: TField); override;
    procedure Assign(Source: TPersistent); override;
  published
    property NumericDataType: TNumericDataFieldTypesEh read FNumericDataType write FNumericDataType;
    property Alignment;
    property DefaultExpression;
    property DisplayLabel;
    property DisplayWidth;
    property EditMask;
    property Required;
    property Visible;

    property DisplayFormat: string read FDisplayFormat write FDisplayFormat;
    property EditFormat: string read FEditFormat write FEditFormat;
    property currency: Boolean read FCurrency write FCurrency;
    property MaxValue: Double read FMaxValue write FMaxValue;
    property MinValue: Double read FMinValue write FMinValue;
    property Precision: Integer read FPrecision write FPrecision;

  end;

  TDateTimeDataFieldTypesEh = (fdtDateEh, fdtTimeEh, fdtDateTimeEh
{$IFDEF EH_LIB_6}
   ,fdtTimeStampEh
{$ENDIF}
   );

{ TMTDateTimeDataFieldEh }

  TMTDateTimeDataFieldEh = class(TMTDataFieldEh)
  private
    FDisplayFormat: string;
    FDateTimeDataType: TDateTimeDataFieldTypesEh;
  protected
    function GetDataType: TFieldType; override;
    procedure AssignDataType(FieldType: TFieldType); override;
  public
    procedure AssignProps(Field: TField); override;
    procedure Assign(Source: TPersistent); override;
  published
    property DateTimeDataType: TDateTimeDataFieldTypesEh read FDateTimeDataType write FDateTimeDataType;
    property Alignment;
    property DefaultExpression;
    property DisplayLabel;
    property DisplayWidth;
    property EditMask;
    property Required;
    property Visible;

    property DisplayFormat: string read FDisplayFormat write FDisplayFormat;
  end;

{ TMTBlobDataFieldEh }

  TMTBlobDataFieldEh = class(TMTDataFieldEh)
  private
    FGraphicHeader: Boolean;
    FTransliterate: Boolean;
    FBlobType: TBlobType;
  protected
    function GetDataType: TFieldType; override;
    procedure AssignDataType(FieldType: TFieldType); override;
  public
    procedure AssignProps(Field: TField); override;
    procedure Assign(Source: TPersistent); override;
  published
    property Alignment;
    property DefaultExpression;
    property DisplayLabel;
    property DisplayWidth;
    property EditMask;
    property Required;
    property Visible;

    property BlobType: TBlobType read FBlobType write FBlobType;
    property GraphicHeader: Boolean read FGraphicHeader write FGraphicHeader;
    property Transliterate: Boolean read FTransliterate write FTransliterate;
  end;

{ TMTBooleanDataFieldEh }

  TMTBooleanDataFieldEh = class(TMTDataFieldEh)
  private
    FDisplayValues: string;
    procedure SetDisplayValues(const Value: string);
  protected
    function GetDataType: TFieldType; override;
    procedure AssignDataType(FieldType: TFieldType); override;
  public
    procedure AssignProps(Field: TField); override;
    procedure Assign(Source: TPersistent); override;
  published
    property Alignment;
    property DefaultExpression;
    property DisplayLabel;
    property DisplayWidth;
    property EditMask;
    property Required;
    property Visible;

    property DisplayValues: string read FDisplayValues write SetDisplayValues;
  end;

{ TMTDataStructEh }

  TMTDataStructEh = class(TComponent)
  private
    FList: TList;
    FMemTableData: TMemTableDataEh;
    FNextFieldId: Largeint;
    function GetCount: Integer;
    function GetDataField(Index: Integer): TMTDataFieldEh;
  protected
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    function GetChildOwner: TComponent; override;
  public
    constructor Create(AMemTableData: TMemTableDataEh); reintroduce;
    destructor Destroy; override;

    function CreateField(FieldClass: TMTDataFieldClassEh): TMTDataFieldEh;
    function FindField(const FieldName: string): TMTDataFieldEh;
    function FieldIndex(const FieldName: string): Integer;
    function FieldByName(const FieldName: string): TMTDataFieldEh;
    procedure Assign(Source: TPersistent); override;
    procedure CheckFieldName(const FieldName: string);
    procedure GetFieldList(List: TList; const FieldNames: string);
    procedure Clear;
    procedure InsertField(Field: TMTDataFieldEh);
    procedure RemoveField(Field: TMTDataFieldEh);
    procedure BuildStructFromFields(Fields: TFields);
    procedure BuildStructFromFieldDefs(FieldDefs: TFieldDefs);
    procedure BuildFieldDefsFromStruct(FieldDefs: TFieldDefs);

    property Count: Integer read GetCount;
    property MemTableData: TMemTableDataEh read FMemTableData;
    property DataFields[Index: Integer]: TMTDataFieldEh read GetDataField; default;
  end;

{ TMemoryRecordsEh }
  TRecordsListEh = class;

  TMemoryRecordsEh = class(TPersistent)
  private
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
    function IsEmpty: Boolean;
  protected
    procedure DefineProperties(Filer: TFiler); override;
  end;

{ TMemTableDataEh }

  TMemTableDataEh = class(TComponent)
  private
    FDataStruct: TMTDataStructEh;
    FNewDataStruct: TMTDataStructEh;
    FRestructMode: Boolean;
    FRecordsList: TRecordsListEh;
    procedure AncestorNotFound(Reader: TReader; const ComponentName: string; ComponentClass: TPersistentClass; var Component: TComponent);
    procedure CreateComponent(Reader: TReader; ComponentClass: TComponentClass; var Component: TComponent);
    function GetIsEmpty: Boolean;
  protected
    procedure ReadState(Reader: TReader); override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure CheckInactive;
    procedure Restruct;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function BeginRestruct: TMTDataStructEh;
    procedure CancelRestruct;
    procedure CommitRestruct;
    procedure DestroyTable;

    property DataStruct: TMTDataStructEh read FDataStruct;
    property RecordsList: TRecordsListEh read FRecordsList;
    property IsEmpty: Boolean read GetIsEmpty; 
  end;


// MemoryRecords

  TRecDataValues = array of Variant;
  PRecValues = ^TRecDataValues;

  TMemBlobData = string;
  TMemoryRecordEh = class;
  TCompareRecords = function (Item1, Item2: PRecValues): Integer of object;

  TRecordsListNotification =
    (rlnRecAddedEh, rlnRecChangedEh, rlnRecDeletedEh, rlnListChangedEh,
     rlnRecMarkedForDelEh);

  TRecordsListNotificatorDataEventEh =
    procedure (MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification) of object;

  TRecIdEh = LongWord;

  TDataValueTypeEh = (dvtOldValueEh, dvtCurValueEh, dvtEditValueEh, dvtValueEh, dvtOldestValue);

{ TMemoryRecordEh }

  TMemoryRecordEh = class(TPersistent)
  private
    FChangeCount: Integer;
    FChanged: Boolean;
    FData: PRecValues;
//    FMemoryData: TCustomMemTableEh;
    FOldData: PRecValues;
    FRecordsList: TRecordsListEh;
    FTmpOldRecValue: PRecValues;
    FUpdateIndex: Integer;
    FUpdateStatus: TUpdateStatus;
    FID: TRecIdEh;
    function GetAttached: Boolean;
    function GetIndex: Integer;
    procedure SetUpdateStatus(const Value: TUpdateStatus);
    function GetDataStruct: TMTDataStructEh;
    function GetDataValues(const FieldNames: string; DataValueType: TDataValueTypeEh): Variant;
    procedure SetDataValues(const FieldNames: string; DataValueType: TDataValueTypeEh; const Value: Variant);
  protected
    procedure SetIndex(Value: Integer);
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
  public
    constructor Create;
    destructor Destroy; override;
    procedure BeginEdit;
    procedure EndEdit(Changed: Boolean);
    procedure MergeChanges;
    procedure RevertRecord;
    procedure RefreshRecord(RecValues: TRecDataValues);
    property Attached: Boolean read GetAttached;
    property Data: PRecValues read FData;
    property DataValues[const FieldNames: string; DataValueType: TDataValueTypeEh]:
      Variant read GetDataValues write SetDataValues;
    property Index: Integer read GetIndex write SetIndex;
//    property MemoryData: TCustomMemTableEh read FMemoryData;
    property RecordsList: TRecordsListEh read FRecordsList;
    property DataStruct: TMTDataStructEh read GetDataStruct;
    property ID: TRecIdEh read FID;
    property UpdateStatus: TUpdateStatus read FUpdateStatus write SetUpdateStatus;
    property OldData: PRecValues read FOldData;
    property UpdateIndex: Integer read FUpdateIndex write FUpdateIndex;
  end;

  TMemoryRecordEhClass = class of TMemoryRecordEh;

{ TRecordsListNotificatorEh }