|
- unit uutlObservableGenerics;
-
- {$mode objfpc}{$H+}
-
- interface
-
- uses
- Classes, SysUtils,
- uutlGenerics, uutlInterfaces;
-
- type
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlEventList<T> = class(specialize TutlHashSetBase<T>)
- 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<TNotifyEvent>;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlObservableCustomList<T> = class(specialize TutlCustomList<T>)
- public type
- TEventList = specialize TutlEventList<TItemEvent>;
- 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<T> = class(specialize TutlObservableCustomList<T>)
- public type
- TEqualityComparer = specialize TutlEqualityComparer<T>;
- public
- constructor Create(const aOwnsObjects: Boolean = true);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlObservableCustomHashSet<T> = class(specialize TutlCustomHashSet<T>)
- public type
- TEventList = specialize TutlEventList<THashItemEvent>;
- 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<T> = class(specialize TutlObservableCustomHashSet<T>)
- public type
- TComparer = specialize TutlComparer<T>;
- public
- constructor Create(const aOwnsObjects: Boolean = true);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlObservableCustomMap<TKey, TValue> = class(specialize TutlMapBase<TKey, TValue>)
- public type
- TEventList = specialize TutlEventList<TKeyValuePairEvent>;
- 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<TKey, TValue> = class(specialize TutlObservableCustomMap<TKey, TValue>)
- public type
- TComparer = specialize TutlComparer<TKey>;
- 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.
|