memtabledataeh.pas

Ehlib.v3.4.for.Delphi5678.rar是DELPHI的三方控件源码.此控件适用于DELPHI5,6,7,8.

    (rlnRecAddedEh, rlnRecChangedEh, rlnRecDeletedEh, rlnListChangedEh,
     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;
    FEditChanged: Boolean;
    FData: TRecDataValues;
//    FMemoryData: TCustomMemTableEh;
    FOldData: TRecDataValues;
    FRecordsList: TRecordsListEh;
    FTmpOldRecValue: TRecDataValues;
    FUpdateIndex: Integer;
    FUpdateStatus: TUpdateStatus;
    FID: TRecIdEh;
    FEditState: TRecordEditStateEh;
    FUpdateError: TUpdateErrorEh;
    function GetAttached: Boolean;
    function GetIndex: Integer;
    procedure SetUpdateStatus(const Value: TUpdateStatus);
    function GetDataStruct: TMTDataStructEh;
    function GetDataValues(const FieldNames: string; DataValueVersion: TDataValueVersionEh): Variant;
    procedure SetDataValues(const FieldNames: string; DataValueVersion: TDataValueVersionEh; const VarValue: Variant);
    function GetDataValue(const FieldIndex: Integer; DataValueVersion: TDataValueVersionEh): Variant;
    procedure SetDataValue(const FieldIndex: Integer; DataValueVersion: TDataValueVersionEh; const Value: Variant);
  protected
    procedure SetIndex(Value: Integer);
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
    property Data: TRecDataValues read FData;
  public
    constructor Create;
    destructor Destroy; override;
    function EditState: TRecordEditStateEh;
//    procedure BeginEdit;
//    procedure EndEdit(Changed: Boolean);
    procedure Edit;
    procedure Post;
    procedure Cancel;
    procedure MergeChanges;
    procedure RevertRecord;
    procedure RefreshRecord(Rec: TMemoryRecordEh);
    property Attached: Boolean read GetAttached;
    property DataValues[const FieldNames: string; DataValueVersion: TDataValueVersionEh]:
      Variant read GetDataValues write SetDataValues;
    property Value[const FieldIndex: Integer; DataValueVersion: TDataValueVersionEh]:
      Variant read GetDataValue write SetDataValue;
    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: TRecDataValues read FOldData;
    property UpdateIndex: Integer read FUpdateIndex write FUpdateIndex;
    property UpdateError: TUpdateErrorEh read FUpdateError write FUpdateError;
  end;

  TMemoryRecordEhClass = class of TMemoryRecordEh;

{ TRecordsListNotificatorEh }

  TRecordsListNotificatorEh = class
  private
    FOnDataEvent: TRecordsListNotificatorDataEventEh;
    FRecordsList: TRecordsListEh;
    procedure SetRecordsList(const Value: TRecordsListEh);
  protected
    procedure DataEvent(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification); virtual;
    procedure RecordAdded(MemRec: TMemoryRecordEh; Index: Integer); virtual;
    procedure RecordChanged(MemRec: TMemoryRecordEh; Index: Integer); virtual;
    procedure RecordDeleted(MemRec: TMemoryRecordEh; Index: Integer); virtual;
    procedure RecordListChanged; virtual;
  public
    constructor Create;
    destructor Destroy; override;
    property RecordsList: TRecordsListEh read FRecordsList write SetRecordsList;
    property OnDataEvent: TRecordsListNotificatorDataEventEh read FOnDataEvent write FOnDataEvent;
  end;

  {TRecordsListEh}

  TRecordsListEh = class(TComponent)
  private
    FCachedUpdates: Boolean;
    FDeltaList: TList;
    FDeletedList: TList;
    FItemClass: TMemoryRecordEhClass;
    FNewRecId: TRecIdEh;
    FNotificators: TList;
//    FRecValCount: Integer;
    FRecList: TList;
    FMemTableData: TMemTableDataEh;
//    FRecListById: TList;
    function GetRec(Index: Integer): TMemoryRecordEh;
//tmp    function GetRecValues(RecNo: Integer): TRecDataValues;
    function GetValue(RecNo, ValNo: Integer): Variant;
    procedure SetCachedUpdates(const Value: Boolean);
    procedure SetRec(Index: Integer; const Value: TMemoryRecordEh);
//    procedure SetRecValCount(const Value: Integer);
//tmp    procedure SetRecValues(RecNo: Integer; const Value: TRecDataValues);
    procedure SetValue(RecNo, ValNo: Integer; const Value: Variant);
    procedure ReadData(Reader: TReader);
    procedure WriteData(Writer: TWriter);
    function IsEmpty: Boolean;
    function GetDataStruct: TMTDataStructEh;
    function GetRecsCount: Integer;
    function GeRecValCount: Integer;
  protected
    function NewRecId: TRecIdEh;
    procedure AddNotificator(RecordsList: TRecordsListNotificatorEh);
    procedure InitRecord(RecValues: TRecDataValues);
    procedure Notify(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification); reintroduce; virtual;
    procedure RemoveNotificator(RecordsList: TRecordsListNotificatorEh);
    procedure Delete(Index: Integer);
    procedure DefineProperties(Filer: TFiler); override;
    function AddInsertRecord(Rec: TMemoryRecordEh; Index: Integer; Append: Boolean; Fetching: Boolean): Integer;
  public
    constructor Create(AMemTableData: TMemTableDataEh); reintroduce;
    destructor Destroy; override;

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

  TVariantEh = class(TObject)
  public
    Value: Variant;
  end;

{ TMTIndexEh }

  TMTIndexEh = class(TCollectionItem)
  private
    FRecList: TList;
    FPrimary: Boolean;
    FFields: String;
    FUnical: Boolean;
    FActive: Boolean;
    procedure SetFields(const Value: String);
    procedure SetPrimary(const Value: Boolean);
    procedure SetUnical(const Value: Boolean);
    procedure SetActive(const Value: Boolean);
  protected
    property RecList: TList read FRecList;
    procedure RLDataEvent(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    property Fields: String read FFields write SetFields;
    property Primary: Boolean read FPrimary write SetPrimary;
    property Unical: Boolean read FUnical write SetUnical;
    property Active: Boolean read FActive write SetActive;
  end;

{ TMTAggregateEh }

  TMTAggregatesEh = class;

  TMTAggregateEh = class(TCollectionItem)
  private
    FExpression: string;
    FActive: Boolean;
    FDataSet: TDataSet;
    FValue: Variant;
    FInUse: Boolean;
    FDataType: TFieldType;
    FAggrExpr: TDataSetExprParserEh;
    procedure SetActive(Value: Boolean);
    procedure SetExpression(const Text: string);
  public
    constructor Create(Aggregates: TMTAggregatesEh; ADataSet: TDataSet); reintroduce; overload;
//    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    procedure Recalc;
    procedure Reset;
    function GetDisplayName: string; override;
    function Value: Variant;
    function Aggregates: TMTAggregatesEh;
    property DataSet: TDataSet read FDataSet;
    property DataType: TFieldType read FDataType;
  published
    property Active: Boolean read FActive write SetActive default False;
    property Expression: string read FExpression write SetExpression;
  end;

{ TMTAggregatesEh }

  TMTAggregatesEh = class(TCollection)
  private
    FOwner: TPersistent;
    FActive: Boolean;
    function GetItem(Index: Integer): TMTAggregateEh;
    procedure SetItem(Index: Integer; Value: TMTAggregateEh);
    procedure SetActive(const Value: Boolean);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(Owner: TPersistent);
    function Add: TMTAggregateEh;
    function DataSet: TDataSet;
    procedure Clear;
    procedure Reset;
    procedure Recalc;
    property Items[Index: Integer]: TMTAggregateEh read GetItem write SetItem; default;
    property Active: Boolean read FActive write SetActive;
    property UpdateCount;
  end;

  TMemoryTreeListEh = class;

{ TMemoryTreeNodeEh }

  TMemoryTreeNodeEh = class(TTreeNodeEh)
  private
    function GetData: TMemoryRecordEh;
    function GetOwner: TMemoryTreeListEh;
    function GetItem(const Index: Integer): TMemoryTreeNodeEh; reintroduce;
    function GetParent: TMemoryTreeNodeEh;
    procedure SetParent(const Value: TMemoryTreeNodeEh);
  public
    destructor Destroy; override;
    procedure SortByFields(const SortByStr: string);
    property Data: TMemoryRecordEh read GetData;
    property Owner: TMemoryTreeListEh read GetOwner;
    property Items[const Index: Integer]: TMemoryTreeNodeEh read GetItem; default;
    property Parent: TMemoryTreeNodeEh read GetParent write SetParent;
  end;

{ TMemoryTreeListEh }

  TMemoryTreeListEh = class(TTreeListEh)
  private
    FVisibleItems: TList;
    FVisibleExpandedItems: TList;
    FVisibleItemsObsolete: Boolean;
    FDefaultNodeExpanded: Boolean;
    FDefaultNodeHasChildren: Boolean;
    FDefaultParentNode: TMemoryTreeNodeEh;
    FLastParentNodeForNewChild: TMemoryTreeNodeEh;
  protected
    FRecordsViewEh: TRecordsViewEh;
    function GetVisibleItem(const Index: Integer): TMemoryTreeNodeEh; virtual;
    function GetVisibleCount: Integer;
  public
    constructor Create(ARecordsViewEh: TRecordsViewEh);
    destructor Destroy; override;
    function AddChild(const Name: string; Parent: TMemoryTreeNodeEh; MemRecord: TMemoryRecordEh): TMemoryTreeNodeEh;
    function AddChildAtKey(const Name, KeyFieldNames, ParentFieldNames: String; MemRecord: TMemoryRecordEh): TMemoryTreeNodeEh;
    function GetNode(StartNode: TMemoryTreeNodeEh; MemRecord: TMemoryRecordEh): TMemoryTreeNodeEh;
    function GetNodeAtValue(StartNode: TTreeNodeEh; const FieldNames: String; const Value: Variant): TTreeNodeEh;
    function GetParentNodeAtKey(StartNode: TMemoryTreeNodeEh; const KeyFieldNames: String; const ParentFieldNames: String; MemRecord: TMemoryRecordEh): TMemoryTreeNodeEh;
    function UpdateParent(Node: TMemoryTreeNodeEh; const KeyFieldNames: String; const ParentFieldNames: String; MemRecord: TMemoryRecordEh; ReIndex: Boolean): TMemoryTreeNodeEh;
    procedure BuildVisibleItems;
    procedure SortData(CompareProg: TCompareNodesEh; ParamSort: TObject; ARecurse: Boolean = True); override;
    procedure UpdateNodeState(Node: TMemoryTreeNodeEh);
    procedure UpdateNodesState(Parent: TMemoryTreeNodeEh);
    property VisibleCount: Integer read GetVisibleCount;
    property VisibleItems[const Index: Integer]: TMemoryTreeNodeEh read GetVisibleItem; default;
    property DefaultNodeExpanded: Boolean read FDefaultNodeExpanded write FDefaultNodeExpanded default False;
    property DefaultNodeHasChildren: Boolean read FDefaultNodeHasChildren write FDefaultNodeHasChildren default False;
    property DefaultParentNode: TMemoryTreeNodeEh read FDefaultParentNode write FDefaultParentNode;
  end;

{ TRecordsViewEh }
  TRecordsViewFilterEventEh = function (Rec: TMemoryRecordEh): Boolean of object;
  TParseOrderByStrEventEh = function (OrderByStr: String): TObject of object;

  TRecordsViewEh = class(TPersistent)
  private
    FCachedUpdates: Boolean;
    FCachedUpdatesLockCount: Integer;
    FCatchChanged: Boolean;
    FFilteredRecsList: TList;
//    FRecordsList: TRecordsListEh;
    FMemTableData: TMemTableDataEh;
    FRLNotificator: TRecordsListNotificatorEh;
    FAggregates: TMTAggregatesEh;
    FOnFilterRecord: TRecordsViewFilterEventEh;
    FTreeViewRefParentFieldName: String;
    FTreeViewKeyFieldName: String;
    FViewAsTreeList: Boolean;
    FOnParseOrderByStr: TParseOrderByStrEventEh;
    FOnCompareRecords: TCompareRecords;
    FOnCompareTreeNode: TCompareNodesEh;
    function GetCount: Integer;
    function GetOldRecVals(Index: Integer): TRecDataValues;
    function GetRec(Index: Integer): TMemoryRecordEh;
    function GetRecValCount: Integer;
//tmp    function GetRecValues(RecNo: Integer): TRecDataValues;
    function GetValue(RecNo, ValNo: Integer): Variant;
    procedure SetCachedUpdates(const Value: Boolean);
    procedure SetRec(Index: Integer; const Value: TMemoryRecordEh);
//    procedure SetRecValCount(const Value: Integer);
//tmp    procedure SetRecValues(RecNo: Integer; const Value: TRecDataValues);
    procedure SetValue(RecNo, ValNo: Integer; const Value: Variant);
    function GetViewAsTreeList: Boolean;
    procedure SetViewAsTreeList(const Value: Boolean);
    function GetViewRecord(Index: Integer): TMemoryRecordEh;
  protected
    FDisableFilterCount: Integer;
    FDataSet: TDataSet;
    FMemoryTreeList: TMemoryTreeListEh;
    function FilterRecord(MemRec: TMemoryRecordEh; Index: Integer): Boolean; virtual;
    procedure Notify(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification); virtual;
    procedure RLDataEvent(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification);
    procedure RebuildMemoryTreeList;
    procedure ClearMemoryTreeList;
  public
    constructor Create(ADataSet: TDataSet);
    destructor Destroy; override;
    function FetchRecord(Rec: TMemoryRecordEh): Boolean;
    function AddRecord(Rec: TMemoryRecordEh): Integer;
    function FindRecId(RecId: TRecIdEh): Integer;
    function NewRecord: TMemoryRecordEh;
    function CalcAggrFieldFunc(FieldName, AggrFuncName: String): Variant;
    function ViewItemsCount: Integer;
    procedure CancelUpdates;
    procedure DeleteRecord(Index: Integer);
    procedure InsertRecord(Index: Integer; Rec: TMemoryRecordEh);
    procedure LockCachedUpdates;
    procedure MergeChangeLog;
    procedure RevertRecord(Index: Integer);
    procedure RefreshFilteredRecsList;
    procedure RefreshRecord(Index: Integer; Rec: TMemoryRecordEh);
    procedure UnlockCachedUpdates;
    procedure InstantDisableFilter;
    procedure InstantEnableFilter;
    property CachedUpdates: Boolean read FCachedUpdates write SetCachedUpdates;
    property Count: Integer read GetCount;
    property OldRecVals[Index: Integer]: TRecDataValues read GetOldRecVals;
    property Rec[Index: Integer]: TMemoryRecordEh read GetRec write SetRec; default;
    property RecValCount: Integer read GetRecValCount;
    property Value[RecNo, ValNo: Integer]: Variant read GetValue write SetValue;

    property MemTableData: TMemTableDataEh read FMemTableData;
    property Aggregates: TMTAggregatesEh read FAggregates;
    property CatchChanged: Boolean read FCatchChanged write FCatchChanged;
    property OnFilterRecord: TRecordsViewFilterEventEh read FOnFilterRecord write FOnFilterRecord;
    property OnParseOrderByStr: TParseOrderByStrEventEh read FOnParseOrderByStr write FOnParseOrderByStr;
    property OnCompareRecords: TCompareRecords read FOnCompareRecords write FOnCompareRecords;
    property OnCompareTreeNode: TCompareNodesEh read FOnCompareTreeNode write FOnCompareTreeNode;

    property ViewAsTreeList: Boolean read GetViewAsTreeList write SetViewAsTreeList;
    property TreeViewKeyFieldName: String read FTreeViewKeyFieldName write FTreeViewKeyFieldName;
    property TreeViewRefParentFieldName: String read FTreeViewRefParentFieldName write FTreeViewRefParentFieldName;
    property MemoryTreeList: TMemoryTreeListEh read FMemoryTreeList;
    property ViewRecord[Index: Integer]: TMemoryRecordEh read GetViewRecord;
  end;


const
  mrEditStatesEh = [resEditEh, resInsertEh];
  StringDataFieldsToFields: array[TStringDataFieldTypesEh] of TFieldType =
    (ftString, ftFixedChar, ftWideString);
  NumericDataFieldsToFields: array[TNumericDataFieldTypesEh] of TFieldType =
    (ftSmallint, ftInteger, ftWord, ftFloat, ftCurrency, ftBCD, ftAutoInc,
     ftLargeint
{$IFDEF EH_LIB_6}
     ,ftFMTBcd
{$ENDIF}
     );
  DateTimeDataFieldsToFields: array[TDateTimeDataFieldTypesEh] of TFieldType =
    (ftDate, ftTime, ftDateTime
{$IFDEF EH_LIB_6}
     ,ftTimeStamp
{$ENDIF}
     );

var
  DefaultDataFieldClasses: array[TFieldType] of TMTDataFieldClassEh = (
    nil,                        { ftUnknown }
    TMTStringDataFieldEh,       { ftString }
    TMTNumericDataFieldEh,      { ftSmallint }
    TMTNumericDataFieldEh,      { ftInteger }
    TMTNumericDataFieldEh,      { ftWord }