memtabledataeh.pas

最新的 DBGRIDEH4.0

    procedure RemoveNotificator(RecordsList: TRecordsListNotificatorEh);
    procedure Restruct;
    procedure SetAutoIncrement(const Value: TAutoIncrementEh); virtual;
    procedure SetAutoIncValue(Rec: TMemoryRecordEh); virtual;
    procedure StructChanged; virtual;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;

    function BeginRestruct: TMTDataStructEh; virtual;
    function FetchRecords(Count: Integer): Integer; virtual;
    procedure CancelRestruct; virtual;
    procedure CommitRestruct; virtual;
    procedure DestroyTable; virtual;

    property AutoIncrement: TAutoIncrementEh read GetAutoIncrement write SetAutoIncrement;
    property DataStruct: TMTDataStructEh read GetDataStruct;
    property IsEmpty: Boolean read GetIsEmpty;
    property RecordsList: TRecordsListEh read GetRecordsList;
  end;

{ TMemTableDataShadowEh }

  TMemTableDataShadowEh = class(TMemTableDataEh)
  private
    FMasterTable: TMemTableDataEh;
  protected
    function GetDataStruct: TMTDataStructEh; override;
    procedure SetAutoIncValue(Rec: TMemoryRecordEh); override;
  public
    constructor Create(AMasterTable: TMemTableDataEh); reintroduce; virtual;
    destructor Destroy; override;
  end;

{ TIndexItemEh }

  TIndexItemEh = class(TObject)
  public
    Value: Variant;
    RecIndex: Integer;
    constructor Create(AValue: Variant; ARecIndex: Integer);
  end;

{ TMTIndexEh }

  EUnicalKeyViolationEh = Exception;

  TMTIndexEh = class(TCollectionItem)
  private
    FActive: Boolean;
    FFields: String;
    FOldValue: Variant;
    FPrimary: Boolean;
    FRecList: TObjectList;
    FRecordsList: TRecordsListEh;
    FUnical: Boolean;
    function GetItems(Index: Integer): TIndexItemEh;
    function GetKeyValue(Index: Integer): Variant;
    procedure SetActive(const Value: Boolean);
    procedure SetFields(const Value: String);
    procedure SetKeyValue(Index: Integer; const Value: Variant);
    procedure SetPrimary(const Value: Boolean);
    procedure SetUnical(const Value: Boolean);
  protected
    property RecList: TObjectList read FRecList;
    procedure RLDataEvent(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification);
    procedure RecordMoved(Item: TMemoryRecordEh; OldIndex, NewIndex: Integer); virtual;
    procedure InsertIndexItemForValue(InitIndex: Integer; Value: Variant; IndexItem: TIndexItemEh); virtual;
  public
    constructor Create(Collection: TCollection); override;
    constructor CreateApart(ARecordsList: TRecordsListEh);
    destructor Destroy; override;
    function Count: Integer;
    function FindKeyValueIndex(Value: Variant; var Index: Integer): Boolean;
    function FindRecordIndexByKey(Value: Variant; var Index: Integer): Boolean;
    function RecordsList: TRecordsListEh;
    procedure ClearIndex;
    procedure FillMatchedKeyList(Value: Variant; List: TObjectList);
    procedure FillMatchedRecsList(Value: Variant; List: TObjectList);
    procedure QuickSort(L, R: Integer);
    procedure RebuildIndex;
    property Active: Boolean read FActive write SetActive default False;
    property Fields: String read FFields write SetFields;
    property Item[Index: Integer]: TIndexItemEh read GetItems;
    property KeyValue[Index: Integer]: Variant read GetKeyValue;
    property Primary: Boolean read FPrimary write SetPrimary default False;
    property Unical: Boolean read FUnical write SetUnical default False;
  end;

{ TMTIndexesEh }

  TMTIndexesEh = class(TCollection)
  private
    FRecList: TRecordsListEh;
    function GetItem(Index: Integer): TMTIndexEh;
    procedure SetItem(Index: Integer; const Value: TMTIndexEh);
  protected
    procedure RecordMoved(Item: TMemoryRecordEh; OldIndex, NewIndex: Integer); virtual;
    procedure RLDataEvent(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification);
  public
    constructor Create(ARecList: TRecordsListEh);
    destructor Destroy; override;
    function Add: TMTIndexEh;
    function GetIndexForFields(Fields: String): TMTIndexEh;
    property Items[Index: Integer]: TMTIndexEh read GetItem write SetItem;
  end;

{ TMTAggregateEh }

  TMTAggregatesEh = class;

  TMTAggregateEh = class(TCollectionItem)
  private
    FActive: Boolean;
    FAggrExpr: TDataSetExprParserEh;
    FDataSet: TDataSet;
    FDataType: TFieldType;
    FExpression: string;
    FInUse: Boolean;
    FValue: Variant;
    procedure SetActive(Value: Boolean);
    procedure SetExpression(const Text: string);
  public
    constructor Create(Aggregates: TMTAggregatesEh; ADataSet: TDataSet); reintroduce; overload;
    destructor Destroy; override;
    function Aggregates: TMTAggregatesEh;
    function GetDisplayName: string; override;
    function Value: Variant;
    procedure Assign(Source: TPersistent); override;
    procedure Recalc;
    procedure Reset;
    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
    FActive: Boolean;
    FOwner: TPersistent;
    function GetItem(Index: Integer): TMTAggregateEh;
    procedure SetActive(const Value: Boolean);
    procedure SetItem(Index: Integer; Value: TMTAggregateEh);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(Owner: TPersistent);
    function Add: TMTAggregateEh;
    function DataSet: TDataSet;
    procedure Clear;
    procedure Recalc;
    procedure Reset;
    property Active: Boolean read FActive write SetActive;
    property Items[Index: Integer]: TMTAggregateEh read GetItem write SetItem; default;
    property UpdateCount;
  end;

  TMemoryTreeListEh = class;

{ TMemRecViewEh }

  TMemRecViewEh = class(TBaseTreeNodeEh)
  private
    function GetRec: TMemoryRecordEh;
    function GetItem(const Index: Integer): TMemRecViewEh; reintroduce;
    function GetNodeOwner: TMemoryTreeListEh;
    function GetNodeParent: TMemRecViewEh;
    procedure SetNodeParent(const Value: TMemRecViewEh);
    function GetNodeExpanded: Boolean;
    function GetNodeHasChildren: Boolean;
    function GetNodeIndex: Integer;
    function GetNodeLevel: Integer;
    function GetNodeVisible: Boolean;
    function GetVisibleNodesCount: Integer;
    function GetVisibleNodeIndex: Integer;
    function GetVisibleNodeItem(const Index: Integer): TMemRecViewEh;
    procedure SetNodeExpanded(const Value: Boolean);
    function GetNodesCount: Integer;
    procedure SetNodeHasChildren(const Value: Boolean);
  public
    destructor Destroy; override;
    procedure SortByFields(const SortByStr: string);
    property Rec: TMemoryRecordEh read GetRec;
    property NodeItems[const Index: Integer]: TMemRecViewEh read GetItem; default;
    property NodesCount: Integer read GetNodesCount;
    property NodeOwner: TMemoryTreeListEh read GetNodeOwner;
    property NodeParent: TMemRecViewEh read GetNodeParent write SetNodeParent;
    property NodeHasChildren: Boolean read GetNodeHasChildren write SetNodeHasChildren;
    property NodeLevel: Integer read GetNodeLevel;
    property NodeExpanded: Boolean read GetNodeExpanded write SetNodeExpanded;
    property VisibleNodesCount: Integer read GetVisibleNodesCount;
    property NodeIndex: Integer read GetNodeIndex;
    property NodeVisible: Boolean read GetNodeVisible;
    property VisibleNodeItems[const Index: Integer]: TMemRecViewEh read GetVisibleNodeItem;
    property VisibleNodeIndex: Integer read GetVisibleNodeIndex;
  end;

{ TMemoryTreeListEh }

  TMemoryTreeListEh = class(TTreeListEh)
  private
    FDefaultNodeExpanded: Boolean;
    FDefaultNodeHasChildren: Boolean;
    FDefaultParentNode: TMemRecViewEh;
    FFullBuildCheck: Boolean;
    FInsertedNodeStack: TObjectList;
    FVisibleExpandedItems: TObjectList;
    FVisibleItems: TObjectList;
    FVisibleItemsObsolete: Boolean;
    FFilterNodeIfParentVisible: Boolean;
    function GetAccountableCount: Integer;
    function GetAccountableItem(const Index: Integer): TMemRecViewEh;
    function GetKeyFieldNames: String;
    function GetParentFieldNames: String;
  protected
    FRecordsViewEh: TRecordsViewEh;
    function GetVisibleCount: Integer;
    function GetVisibleItem(const Index: Integer): TMemRecViewEh; virtual;
    procedure SetChieldVisibleForVisibleParents(Parent: TMemRecViewEh); virtual;
    procedure SetChieldsVisible(Parent: TMemRecViewEh; Visible: Boolean; ARecurse: Boolean);
  public
    constructor Create(ARecordsViewEh: TRecordsViewEh);
    destructor Destroy; override;
    function AddChild(const Name: string; Parent: TMemRecViewEh; MemRecord: TMemoryRecordEh): TMemRecViewEh;
    function AddChildAtKey(const Name, KeyFieldNames, ParentFieldNames: String; MemRecord: TMemoryRecordEh): TMemRecViewEh;
    function CheckReferenceLoop(MemRecord: TMemoryRecordEh; NewRefValue: Variant): Boolean;
    function GetChildNodesForKey(StartNode: TMemRecViewEh; const KeyFieldNames: String; const ParentFieldNames: String; MemRecord: TMemoryRecordEh; ChildList: TObjectList): TMemRecViewEh;
    function GetIndexForNode(Rec: TMemoryRecordEh; ParentNode: TMemRecViewEh): Integer;
    function GetNode(StartNode: TMemRecViewEh; MemRecord: TMemoryRecordEh): TMemRecViewEh;
    function GetNodeAtValue(StartNode: TMemRecViewEh; const FieldNames: String; const Value: Variant): TMemRecViewEh;
    function GetParentNodeAtKey(StartNode: TMemRecViewEh; const KeyFieldNames: String; const ParentFieldNames: String; MemRecord: TMemoryRecordEh): TMemRecViewEh;
    function GetParentNodeAtKeyValue(StartNode: TMemRecViewEh; const KeyFieldNames: String; const ParentFieldNames: String; RefKeyValue: Variant): TMemRecViewEh;
    function GetParentNodeForRec(MemRecord: TMemoryRecordEh): TMemRecViewEh;
    function GetParentNodeForRefValue(RefValue: Variant): TMemRecViewEh;
    function UpdateParent(Node: TMemRecViewEh; const KeyFieldNames: String; const ParentFieldNames: String; MemRecord: TMemoryRecordEh; ReIndex: Boolean): TMemRecViewEh;
    procedure BuildVisibleItems;
    procedure GetRecordsList(List: TObjectList; Node: TMemRecViewEh; ARecurse: Boolean = True);
    procedure MoveTo(Node: TBaseTreeNodeEh; Destination: TBaseTreeNodeEh; Mode: TNodeAttachModeEh; ReIndex: Boolean); override;
    procedure SortData(CompareProg: TCompareNodesEh; ParamSort: TObject; ARecurse: Boolean = True); override;
    procedure UpdateNodesState(Parent: TMemRecViewEh);
    procedure UpdateNodeState(Node: TMemRecViewEh; IsUpdateParent: Boolean);
    property AccountableCount: Integer read GetAccountableCount;
    property AccountableItem[const Index: Integer]: TMemRecViewEh read GetAccountableItem;
    property DefaultNodeExpanded: Boolean read FDefaultNodeExpanded write FDefaultNodeExpanded default False;
    property DefaultNodeHasChildren: Boolean read FDefaultNodeHasChildren write FDefaultNodeHasChildren default False;
    property DefaultParentNode: TMemRecViewEh read FDefaultParentNode write FDefaultParentNode;
    property FullBuildCheck: Boolean read FFullBuildCheck write FFullBuildCheck;
    property FilterNodeIfParentVisible: Boolean read FFilterNodeIfParentVisible write FFilterNodeIfParentVisible;
    property KeyFieldNames: String read GetKeyFieldNames;
    property ParentFieldNames: String read GetParentFieldNames;
    property VisibleCount: Integer read GetVisibleCount;
    property VisibleItem[const Index: Integer]: TMemRecViewEh read GetVisibleItem; default;
    property VisibleItems: TObjectList read FVisibleExpandedItems;
    property VisibleItemsObsolete: Boolean read FVisibleItemsObsolete;
  end;

{ TOrderByItemEh }

  TOrderByItemEh = class(TObject)
  public
//    Field: TField;
    FieldIndex: Integer;
    Desc: Boolean;
    CaseIns: Boolean;
  end;

{ TOrderByList }

  TOrderByList = class(TObjectList)
  protected
    function GetItem(Index: Integer): TOrderByItemEh;
    procedure SetItem(Index: Integer; const Value: TOrderByItemEh);
    function FindFieldIndex(FieldName: String): Integer; virtual;
  public
    function GetToken(Exp: String; var FromIndex: Integer): String;
    procedure ParseOrderByStr(OrderByStr: String);
    property Items[Index: Integer]: TOrderByItemEh read GetItem write SetItem; default;
  end;

{ TRecordsViewOrderByList }

  TRecordsViewOrderByList = class(TOrderByList)
  protected
    FRecordsView: TRecordsViewEh;
    function FindFieldIndex(FieldName: String): Integer; override;
  public
    constructor Create(ARecordsView: TRecordsViewEh);
  end;

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

//  TRecordsViewEh = class(TPersistent)
  TRecordsViewEh = class(TRecordsListNotificatorEh)
  private
    FAggregates: TMTAggregatesEh;
    FCachedUpdates: Boolean;
    FCachedUpdatesLockCount: Integer;
    FCatchChanged: Boolean;
    FFilteredRecsList: TObjectList;
    FOnCompareRecords: TCompareRecords;
    FOnCompareTreeNode: TCompareNodesEh;
    FOnFilterRecord: TRecordsViewFilterEventEh;
    FOnGetPrefilteredList: TGetPrefilteredListEventEh;
    FOnParseOrderByStr: TParseOrderByStrEventEh;
    FOnViewDataEvent: TRecordsListNotificatorDataEventEh;
    FOrderByList: TRecordsViewOrderByList;
    FSortOrder: String;
    FTreeViewKeyFieldName: String;
    FTreeViewKeyFields: TIntArray;
    FTreeViewRefParentFieldName: String;
    FTreeViewRefParentFields: TIntArray;
    FViewAsTreeList: Boolean;
    FStatusFilter: TUpdateStatusSet;
    FNotificators: TObjectList;
    function  CompareRecords(Rec1, Rec2: TMemoryRecordEh): Integer;
    function  GetSortOrder: String;
    function  SearchNewPos(SortedList: TObjectList; MemRec: TMemoryRecordEh): Integer;
    function  SearchRec(SortedList: TObjectList; MemRec: TMemoryRecordEh): Integer;
    function GetAccountableRecord(Index: Integer): TMemoryRecordEh;
    function GetCount: Integer;
    function GetOldRecVals(Index: Integer): TRecDataValues;
    function GetRec(Index: Integer): TMemoryRecordEh;
    function GetStatusFilter: TUpdateStatusSet;
    function GetValue(RecNo, ValNo: Integer): Variant;
    function GetViewAsTreeList: Boolean;
    function GetViewRecord(Index: Integer): TMemoryRecordEh;
    procedure SetRec(Index: Integer; const Value: TMemoryRecordEh);
    procedure SetSortOrder(const Value: String);
    procedure SetStatusFilter(const Value: TUpdateStatusSet);
    procedure SetTreeViewKeyFieldName(const Value: String);
    procedure SetTreeViewRefParentFieldName(const Value: String);
    procedure SetValue(RecNo, ValNo: Integer; const Value: Variant);
    procedure SetViewAsTreeList(const Value: Boolean);
    function GetMemTableData: TMemTableDataEh;
    procedure SetMemTableData(const Value: TMemTableDataEh);
  protected
//    procedure RLDataEvent(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification);

    FDataSet: TDataSet;
    FDisableFilterCount: Integer;
    FMemoryTreeList: TMemoryTreeListEh;

    function  FilterRecord(MemRec: TMemoryRecordEh; Index: Integer): Boolean; virtual;
    procedure AddNotificator(RecordsList: TRecordsListNotificatorEh); virtual;
    procedure RemoveNotificator(RecordsList: TRecordsListNotificatorEh);
    procedure ClearMemoryTreeList;
    procedure DataEvent(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification); override;
    procedure Notify(MemRec: TMemoryRecordEh; Index: Integer; Action: TRecordsListNotification); virtual;
    procedure RecordMoved(Item: TMemoryRecordEh; OldIndex, NewIndex: Integer); override;
//    procedure SetMemTableData(AMemTableData: TMemTableDataEh);
    procedure Resort; virtual;

  public