memtabledataeh.pas

最新的 DBGRIDEH4.0

    property DefaultExpression;
    property DisplayLabel;
    property DisplayWidth;
    property InterfaceDataType: TInterfaceDataFieldTypesEh read FInterfaceDataType write FInterfaceDataType;
    property Required;
    property Visible;
  end;

  { TMTVariantDataFieldEh }

  TVariantDataFieldTypesEh = (fdtVariant, fdtBytes, fdtVarBytes);

  TMTVariantDataFieldEh = class(TMTDataFieldEh)
  private
    FVariantDataType: TVariantDataFieldTypesEh;
  protected
    function GetDataType: TFieldType; override;
  public
    function CanDinaSize: Boolean; override;
    procedure AssignDataType(FieldType: TFieldType); override;
  published
    property Alignment;
    property DefaultExpression;
    property DisplayLabel;
    property DisplayWidth;
    property VariantDataType: TVariantDataFieldTypesEh read FVariantDataType write FVariantDataType;
    property Required;
    property Visible;
  end;

  { TMTRefObjectFieldEh }

  TMTRefObjectFieldEh = class(TMTDataFieldEh)
  protected
    function GetDataType: TFieldType; override;
  public
    function CanDinaSize: Boolean; override;
    procedure AssignDataType(FieldType: TFieldType); override;
  published
    property Alignment;
    property DisplayLabel;
    property DisplayWidth;
    property Required;
    property Visible;
  end;

{$IFDEF EH_LIB_6}

  TSQLTimeStampDataFieldTypesEh = (fdtTimeStampEh
{$IFDEF EH_LIB_10}
   ,fdtOraTimeStampEh
{$ENDIF}
   );

{ TMTSQLTimeStampDataFieldEh }

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

    property DisplayFormat: string read FDisplayFormat write FDisplayFormat;
  end;

{$ENDIF}

{ TMTDataStructEh }

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

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

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


  TRecordsListEh = class;

// MemoryRecords

  TRecDataValues = array of Variant;
  PRecValues = ^TRecDataValues;

  TMemBlobData = Variant;
  TCompareRecords = function (Rec1, Rec2: TMemoryRecordEh; ParamSort: TObject): Integer of object;

  TRecordsListNotification =
    (rlnRecAddingEh, rlnRecAddedEh,
     rlnRecChangingEh, rlnRecChangedEh,
     rlnRecDeletingEh, rlnRecDeletedEh,
     rlnListChangingEh, rlnListChangedEh,
     rlnRecMarkingForDelEh, rlnRecMarkedForDelEh);

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

//  TRecIdEh = LongWord;

  TDataValueVersionEh = (dvvOldValueEh, dvvCurValueEh, dvvEditValueEh, dvvValueEh,
    dvvOldestValue, dvvRefreshValue);
  TRecordEditStateEh = (resBrowseEh, resEditEh, resInsertEh);

{ TMemoryRecordEh }

  TMemoryRecordEh = class(TPersistent)
  private
//    FChangeCount: Integer;
//    FMemoryData: TCustomMemTableEh;
    FData: TRecDataValues;
    FEditChanged: Boolean;
    FEditState: TRecordEditStateEh;
    FHashCode: LongWord;
    FIndex: Integer;
    FOldData: TRecDataValues;
    FRecordsList: TRecordsListEh;
    FTmpOldRecValue: TRecDataValues;
    FUpdateError: TUpdateErrorEh;
    FUpdateIndex: Integer;
    FUpdateStatus: TUpdateStatus;
    function GetAttached: Boolean;
    function GetDataIndexValues(const FieldIndexes: TIntArray; DataValueVersion: TDataValueVersionEh): Variant;
    function GetDataStruct: TMTDataStructEh;
    function GetDataValue(const FieldIndex: Integer; DataValueVersion: TDataValueVersionEh): Variant;
    function GetDataValues(const FieldNames: string; DataValueVersion: TDataValueVersionEh): Variant;
    function GetIndex: Integer;
    procedure SetDataIndexValues(const FieldIndexes: TIntArray; DataValueVersion: TDataValueVersionEh; const VarValue: Variant);
    procedure SetDataValue(const FieldIndex: Integer; DataValueVersion: TDataValueVersionEh; const Value: Variant);
    procedure SetDataValues(const FieldNames: string; DataValueVersion: TDataValueVersionEh; const VarValue: Variant);
    procedure SetUpdateStatus(const Value: TUpdateStatus);
  protected
    procedure ReadData(Reader: TReader);
    procedure SetIndex(Value: Integer);
    procedure WriteData(Writer: TWriter);
    property Data: TRecDataValues read FData;
  public
    constructor Create;
    destructor Destroy; override;
//    procedure BeginEdit;
//    procedure EndEdit(Changed: Boolean);
    function EditState: TRecordEditStateEh;
    procedure Cancel;
    procedure Edit;
    procedure MergeChanges;
    procedure Post;
    procedure RefreshRecord(Rec: TMemoryRecordEh);
    procedure RevertRecord;
    property Index: Integer read GetIndex;
    property Attached: Boolean read GetAttached;
    property DataValues[const FieldNames: string; DataValueVersion: TDataValueVersionEh]:
      Variant read GetDataValues write SetDataValues;
    property DataIndexValues[const FieldIndexes: TIntArray; DataValueVersion: TDataValueVersionEh]:
      Variant read GetDataIndexValues write SetDataIndexValues;
    property Value[const FieldIndex: Integer; DataValueVersion: TDataValueVersionEh]:
      Variant read GetDataValue write SetDataValue;
//    property MemoryData: TCustomMemTableEh read FMemoryData;
    property DataStruct: TMTDataStructEh read GetDataStruct;
    property HashCode: LongWord read FHashCode;
    property OldData: TRecDataValues read FOldData;
    property RecordsList: TRecordsListEh read FRecordsList;
    property UpdateError: TUpdateErrorEh read FUpdateError write FUpdateError;
    property UpdateIndex: Integer read FUpdateIndex write FUpdateIndex;
    property UpdateStatus: TUpdateStatus read FUpdateStatus write SetUpdateStatus;
  end;

  TMemoryRecordEhClass = class of TMemoryRecordEh;

  TRecordsListFetchRecordsEventEh = function (Count: Integer): Integer of object;
  TRecordsListApplyUpdatesEventEh = procedure (AMemTableData: TMemTableDataEh) of object;
  TRecordsListRecordMovedEventEh = procedure (Item: TMemoryRecordEh; OldIndex, NewIndex: Integer) of object;

{ TRecordsListNotificatorEh }

  TRecordsListNotificatorEh = class(TComponent)
  private
//    FRecordsList: TRecordsListEh;
//    procedure SetRecordsList(const Value: TRecordsListEh);
    FMemTableData: TMemTableDataEh;
    FOnAfterDataEvent: TRecordsListNotificatorDataEventEh;
    FOnApplyUpdates: TRecordsListApplyUpdatesEventEh;
    FOnDataEvent: TRecordsListNotificatorDataEventEh;
    FOnFetchRecords: TRecordsListFetchRecordsEventEh;
    FOnRecordMoved: TRecordsListRecordMovedEventEh;
    FDataObject: TComponent;
    procedure SetMemTableData(const Value: TMemTableDataEh);
    procedure SetDataObject(const Value: TComponent);
  protected
    function FetchRecords(Count: Integer): Integer; virtual;
    procedure AfterDataEvent(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification); virtual;
    procedure ApplyUpdates(AMemTableData: TMemTableDataEh);
    procedure DataEvent(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification); virtual;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure RecordAdded(MemRec: TMemoryRecordEh; Index: Integer); virtual;
    procedure RecordChanged(MemRec: TMemoryRecordEh; Index: Integer); virtual;
    procedure RecordDeleted(MemRec: TMemoryRecordEh; Index: Integer); virtual;
    procedure RecordListChanged; virtual;
    procedure RecordMoved(Item: TMemoryRecordEh; OldIndex, NewIndex: Integer); virtual;
//    procedure StructChanged();
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
//    property RecordsList: TRecordsListEh read FRecordsList write SetRecordsList;
//    property MemTableData: TMemTableDataEh read FMemTableData write SetMemTableData;
    property DataObject: TComponent read FDataObject write SetDataObject;
    property OnAfterDataEvent: TRecordsListNotificatorDataEventEh read FOnAfterDataEvent write FOnAfterDataEvent;
    property OnApplyUpdates: TRecordsListApplyUpdatesEventEh read FOnApplyUpdates write FOnApplyUpdates;
    property OnDataEvent: TRecordsListNotificatorDataEventEh read FOnDataEvent write FOnDataEvent;
    property OnFetchRecords: TRecordsListFetchRecordsEventEh read FOnFetchRecords write FOnFetchRecords;
    property OnRecordMoved: TRecordsListRecordMovedEventEh read FOnRecordMoved write FOnRecordMoved;
  end;

  TMTIndexEh = class;
  TMTIndexesEh = class;

  {TRecordsListEh}

  TRecordsListEh = class(TComponent)
  private
//    FNotificators: TObjectList;
    FCachedUpdates: Boolean;
    FDeletedList: TObjectList;
    FDeltaList: TObjectList;
    FIndexes: TMTIndexesEh;
    FItemClass: TMemoryRecordEhClass;
    FMemTableData: TMemTableDataEh;
    FNewHashCode: LongWord;
    FRecList: TObjectList;
    FUpdateCount: Integer;
    function GeRecValCount: Integer;
    function GetCount: Integer;
    function GetDataStruct: TMTDataStructEh;
    function GetRec(Index: Integer): TMemoryRecordEh;
    function GetValue(RecNo, ValNo: Integer): Variant;
    function IsEmpty: Boolean;
    procedure ReadData(Reader: TReader);
    procedure SetCachedUpdates(const Value: Boolean);
    procedure SetRec(Index: Integer; const Value: TMemoryRecordEh);
    procedure SetValue(RecNo, ValNo: Integer; const Value: Variant);
    procedure WriteData(Writer: TWriter);
  protected
//    procedure AddNotificator(RecordsList: TRecordsListNotificatorEh);
//    procedure RemoveNotificator(RecordsList: TRecordsListNotificatorEh);
    function AddInsertRecord(Rec: TMemoryRecordEh; Index: Integer; Append: Boolean; Fetching: Boolean): Integer;
    function Delete(Index: Integer): TMemoryRecordEh;
    function NewHashCode: LongWord;
    procedure ApplyUpdateFor(Rec: TMemoryRecordEh; UpdateStatus: TUpdateStatus);
    procedure ApplyUpdates(AMemTableData: TMemTableDataEh);
    procedure DefineProperties(Filer: TFiler); override;
    procedure InitRecord(RecValues: TRecDataValues);
    procedure Notify(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification); reintroduce; virtual;
    procedure RecordMoved(Item: TMemoryRecordEh; OldIndex, NewIndex: Integer); virtual;
    procedure ReIndexRecs(FromIndex, ToIndex: Integer);
    procedure CheckForDestroyRecord(Rec: TMemoryRecordEh);
    procedure FreeDeletedRecords;
  public
    constructor Create(AMemTableData: TMemTableDataEh); reintroduce;
    destructor Destroy; override;

    function AddRecord(Rec: TMemoryRecordEh): Integer;
    function FetchRecord(Rec: TMemoryRecordEh): Integer;
    function HasCachedChanges: Boolean;
    function IndexOf(Item: TMemoryRecordEh): Integer;
    function NewRecord: TMemoryRecordEh;
    procedure BeginUpdate; virtual;
    procedure CancelUpdates;
    procedure CleanupChangedRecs;
    procedure Clear;
    procedure DeleteRecord(Index: Integer);
    procedure EndUpdate; virtual;
    procedure InsertRecord(Index: Integer; Rec: TMemoryRecordEh);
    procedure MergeChangeLog;
    procedure Move(CurIndex, NewIndex: Integer);
    procedure PersistDeleteRecord(Index: Integer);
    procedure PersistRemoveRecord(Index: Integer);
    procedure QuickSort(L, R: Integer; Compare: TCompareRecords; ParamSort: TObject);
    procedure RefreshRecord(Index: Integer; FromRec: TMemoryRecordEh);
    procedure RevertRecord(Index: Integer);
    procedure SetAutoIncValue(Rec: TMemoryRecordEh);
    procedure SortData(Compare: TCompareRecords; ParamSort: TObject);
//    property RecValues[RecNo: Integer]: TRecDataValues read GetRecValues write SetRecValues;
    property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
    property Count: Integer read GetCount;
    property DataStruct: TMTDataStructEh read GetDataStruct;
    property DeltaList: TObjectList read FDeltaList;
    property Indexes: TMTIndexesEh read FIndexes;
    property MemTableData: TMemTableDataEh read FMemTableData;
    property Rec[Index: Integer]: TMemoryRecordEh read GetRec write SetRec; default;
    property RecValCount: Integer read GeRecValCount;// write SetRecValCount;
    property Value[RecNo, ValNo: Integer]: Variant read GetValue write SetValue;
  end;

{ TMemTableDataEh }

  TMemTableDataEh = class(TComponent)
  private
    FAutoIncrement: TAutoIncrementEh;
    FDataStruct: TMTDataStructEh;
    FIncFieldIndexes: TIntArray;
    FNewDataStruct: TMTDataStructEh;
    FNotificators: TObjectList;
    FRecordsList: TRecordsListEh;
    FRestructMode: Boolean;
    function GetIsEmpty: Boolean;
    procedure AncestorNotFound(Reader: TReader; const ComponentName: string; ComponentClass: TPersistentClass; var Component: TComponent);
    procedure CreateComponent(Reader: TReader; ComponentClass: TComponentClass; var Component: TComponent);
    procedure ReadAutoIncCurValue(Reader: TReader);
    procedure WriteAutoIncCurValue(Writer: TWriter);
  protected
    function GetAutoIncrement: TAutoIncrementEh; virtual;
    function GetDataStruct: TMTDataStructEh; virtual;
    function GetRecordsList: TRecordsListEh; virtual;
    procedure AddNotificator(RecordsList: TRecordsListNotificatorEh); virtual;
    procedure ApplyUpdates(AMemTableData: TMemTableDataEh); virtual;
    procedure CheckInactive;  virtual;
    procedure DefineProperties(Filer: TFiler); override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    procedure Notify(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification); reintroduce; virtual;
    procedure ReadState(Reader: TReader); override;
    procedure RecordMoved(Item: TMemoryRecordEh; OldIndex, NewIndex: Integer); virtual;