unit uutlObservableGenerics; {$mode objfpc}{$H+} interface uses Classes, SysUtils, uutlGenerics, uutlInterfaces; type //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlEventList = class(specialize TutlHashSetBase) private type TComparer = class(TInterfacedObject, IComparer) public function Compare(const i1, i2: T): Integer; end; public function RegisterEvent(const aEvent: T): Boolean; function UnregisterEvent(const aEvent: T): Boolean; constructor Create; end; TutlNotifyEventList = specialize TutlEventList; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlObservableCustomList = class(specialize TutlCustomList) public type TEventList = specialize TutlEventList; private fOnAddItem: TEventList; fOnRemoveItem: TEventList; protected procedure InsertIntern(const aIndex: Integer; const aItem: T); override; procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); override; procedure DoAddItem(const aIndex: Integer; const aItem: T); virtual; procedure DoRemoveItem(const aIndex: Integer; const aItem: T); virtual; public property OnAddItem: TEventList read fOnAddItem; property OnRemoveItem: TEventList read fOnRemoveItem; constructor Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean = true); destructor Destroy; override; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlObservableList = class(specialize TutlObservableCustomList) public type TEqualityComparer = specialize TutlEqualityComparer; public constructor Create(const aOwnsObjects: Boolean = true); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlObservableCustomHashSet = class(specialize TutlCustomHashSet) public type TEventList = specialize TutlEventList; private fOnAddItem: TEventList; fOnRemoveItem: TEventList; protected procedure InsertIntern(const aIndex: Integer; const aItem: T); override; procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); override; procedure DoAddItem(const aItem: T); virtual; procedure DoRemoveItem(const aItem: T); virtual; public property OnAddItem: TEventList read fOnAddItem; property OnRemoveItem: TEventList read fOnRemoveItem; constructor Create(aComparer: IComparer; const aOwnsObjects: Boolean = true); destructor Destroy; override; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlObservableHashSet = class(specialize TutlObservableCustomHashSet) public type TComparer = specialize TutlComparer; public constructor Create(const aOwnsObjects: Boolean = true); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlObservableCustomMap = class(specialize TutlMapBase) public type TEventList = specialize TutlEventList; TObservableHashSet = class(THashSet) private fOwner: TutlObservableCustomMap; protected procedure InsertIntern(const aIndex: Integer; const aItem: TKeyValuePair); override; procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); override; public constructor Create(const aOwner: TutlObservableCustomMap; const aComparer: IComparer; const aOwnsObjects: Boolean = true); end; private fHashSetImpl: TObservableHashSet; fOnAddItem: TEventList; fOnRemoveItem: TEventList; protected procedure DoAddItem(const aKey: TKey; const aValue: TValue); virtual; procedure DoRemoveItem(const aKey: TKey; const aValue: TValue); virtual; public property OnAddItem: TEventList read fOnAddItem; property OnRemoveItem: TEventList read fOnRemoveItem; constructor Create(const aComparer: IComparer; const aOwnsObjects: Boolean = true); destructor Destroy; override; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// generic TutlObservableMap = class(specialize TutlObservableCustomMap) public type TComparer = specialize TutlComparer; public constructor Create(const aOwnsObjects: Boolean = true); end; implementation //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlEventList///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlEventList.TComparer.Compare(const i1, i2: T): Integer; var m1, m2: TMethod; begin m1 := TMethod(i1); m2 := TMethod(i2); if (m1.Data < m2.Data) then result := -1 else if (m1.Data > m2.Data) then result := 1 else if (m1.Code < m2.Code) then result := -1 else if (m1.Code > m2.Code) then result := 1 else result := 0; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlEventList.RegisterEvent(const aEvent: T): Boolean; var i: Integer; begin result := (SearchItem(0, List.Count-1, aEvent, i) < 0); if result then InsertIntern(i, aEvent); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// function TutlEventList.UnregisterEvent(const aEvent: T): Boolean; var i, tmp: Integer; begin i := SearchItem(0, List.Count-1, aEvent, tmp); result := (i >= 0); if result then DeleteIntern(i); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlEventList.Create; begin inherited Create(TComparer.Create, true); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlObservableCustomList////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomList.InsertIntern(const aIndex: Integer; const aItem: T); begin inherited InsertIntern(aIndex, aItem); DoAddItem(aIndex, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomList.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); begin DoRemoveItem(aIndex, aIndex); inherited DeleteIntern(aIndex, aFreeItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomList.DoAddItem(const aIndex: Integer; const aItem: T); var e: TItemEvent; begin if Assigned(fOnAddItem) then for e in fOnAddItem do e(self, aIndex, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomList.DoRemoveItem(const aIndex: Integer; const aItem: T); var e: TItemEvent; begin if Assigned(fOnRemoveItem) then for e in fOnRemoveItem do e(self, aIndex, GetItem(aIndex)); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlObservableCustomList.Create(aEqualityComparer: IEqualityComparer; const aOwnsObjects: Boolean); begin inherited Create(aEqualityComparer, aOwnsObjects); fOnAddItem := TEventList.Create; fOnRemoveItem := TEventList.Create; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TutlObservableCustomList.Destroy; begin FreeAndNil(fOnRemoveItem); FreeAndNil(fOnAddItem); inherited Destroy; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlObservableList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlObservableList.Create(const aOwnsObjects: Boolean); begin inherited Create(TEqualityComparer.Create, aOwnsObjects); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlObservableCustomHashSet/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomHashSet.InsertIntern(const aIndex: Integer; const aItem: T); begin inherited InsertIntern(aIndex, aItem); DoAddItem(aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomHashSet.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); begin DoRemoveItem(GetItem(aIndex)); inherited DeleteIntern(aIndex, aFreeItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomHashSet.DoAddItem(const aItem: T); var e: THashItemEvent; begin if Assigned(fOnAddItem) then for e in fOnAddItem do e(self, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomHashSet.DoRemoveItem(const aItem: T); var e: THashItemEvent; begin if Assigned(fOnRemoveItem) then for e in fOnRemoveItem do e(self, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlObservableCustomHashSet.Create(aComparer: IComparer; const aOwnsObjects: Boolean); begin inherited Create(aComparer, aOwnsObjects); fOnAddItem := TEventList.Create; fOnRemoveItem := TEventList.Create; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TutlObservableCustomHashSet.Destroy; begin inherited Destroy; // calls clear -> Free EventLists after FreeAndNil(fOnAddItem); FreeAndNil(fOnRemoveItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlObservableHashSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlObservableHashSet.Create(const aOwnsObjects: Boolean); begin inherited Create(TComparer.Create, aOwnsObjects); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlObservableCustomMap/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomMap.TObservableHashSet.InsertIntern(const aIndex: Integer; const aItem: TKeyValuePair); begin inherited InsertIntern(aIndex, aItem); fOwner.DoAddItem(aItem.Key, aItem.Value); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomMap.TObservableHashSet.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); var kvp: TKeyValuePair; begin kvp := GetItem(aIndex); fOwner.DoRemoveItem(kvp.Key, kvp.Value); inherited DeleteIntern(aIndex, aFreeItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlObservableCustomMap.TObservableHashSet.Create( const aOwner: TutlObservableCustomMap; const aComparer: IComparer; const aOwnsObjects: Boolean); begin inherited Create(aComparer, aOwnsObjects); fOwner := aOwner; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomMap.DoAddItem(const aKey: TKey; const aValue: TValue); var e: TKeyValuePairEvent; begin if not Assigned(fOnAddItem) then exit; for e in fOnAddItem do e(self, aKey, aValue); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomMap.DoRemoveItem(const aKey: TKey; const aValue: TValue); var e: TKeyValuePairEvent; begin if not Assigned(fOnRemoveItem) then exit; for e in fOnRemoveItem do e(self, aKey, aValue); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlObservableCustomMap.Create(const aComparer: IComparer; const aOwnsObjects: Boolean); begin fOnAddItem := TEventList.Create; fOnRemoveItem := TEventList.Create; fHashSetImpl := TObservableHashSet.Create(self, TKeyValuePairComparer.Create(aComparer), aOwnsObjects); inherited Create(fHashSetImpl); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// destructor TutlObservableCustomMap.Destroy; begin inherited Destroy; FreeAndNil(fHashSetImpl); FreeAndNil(fOnAddItem); FreeAndNil(fOnRemoveItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //TutlObservableMap///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlObservableMap.Create(const aOwnsObjects: Boolean); begin inherited Create(TComparer.Create, aOwnsObjects); end; end.