unit uutlObservableGenerics; {$mode objfpc}{$H+} interface uses Classes, SysUtils, uutlGenerics; 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; 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; 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: TObject; fOnAddItem: TEventList; fOnRemoveItem: TEventList; protected procedure InsertIntern(const aIndex: Integer; const aItem: TKeyValuePair); override; procedure DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean = true); override; public property OnAddItem: TEventList read fOnAddItem write fOnAddItem; property OnRemoveItem: TEventList read fOnRemoveItem write fOnRemoveItem; constructor Create(const aOwner: TObject; const aComparer: IComparer; const aOwnsObjects: Boolean = true); end; private fHashSetImpl: TObservableHashSet; fOnAddItem: TEventList; fOnRemoveItem: TEventList; 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); var e: TItemEvent; begin inherited InsertIntern(aIndex, aItem); if Assigned(fOnAddItem) then for e in fOnAddItem do e(self, aIndex, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomList.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); var e: TItemEvent; begin if Assigned(fOnRemoveItem) then for e in fOnRemoveItem do e(self, aIndex, GetItem(aIndex)); inherited DeleteIntern(aIndex, aFreeItem); 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); var e: THashItemEvent; begin inherited InsertIntern(aIndex, aItem); if Assigned(fOnAddItem) then for e in fOnAddItem do e(self, aItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomHashSet.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); var e: THashItemEvent; begin if Assigned(fOnRemoveItem) then for e in fOnRemoveItem do e(self, GetItem(aIndex)); inherited DeleteIntern(aIndex, aFreeItem); 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); var e: TKeyValuePairEvent; begin inherited InsertIntern(aIndex, aItem); if Assigned(fOnAddItem) then begin for e in fOnAddItem do e(fOwner, aItem.Key, aItem.Value); end; end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// procedure TutlObservableCustomMap.TObservableHashSet.DeleteIntern(const aIndex: Integer; const aFreeItem: Boolean); var e: TKeyValuePairEvent; tmp: TKeyValuePair; begin if Assigned(fOnRemoveItem) then begin tmp := GetItem(aIndex); for e in fOnRemoveItem do e(fOwner, tmp.Key, tmp.Value); end; inherited DeleteIntern(aIndex, aFreeItem); end; //////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////// constructor TutlObservableCustomMap.TObservableHashSet.Create(const aOwner: TObject; const aComparer: IComparer; const aOwnsObjects: Boolean); begin inherited Create(aComparer, aOwnsObjects); fOwner := aOwner; 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); fHashSetImpl.OnAddItem := fOnAddItem; fHashSetImpl.OnRemoveItem := fOnRemoveItem; 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.