|
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335 |
- unit uutlEvent;
-
- {$mode objfpc}{$H+}
-
- interface
-
- uses
- Classes, SysUtils, syncobjs,
- uutlTypes, uutlCommon, uutlGenerics, uutlInterfaces;
-
- type
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- IutlEventArgs = interface(IUnknown)
- ['{FC7AA96D-9C2C-42AD-A680-DE55341F2B35}']
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- IutlEventListener = interface(IUnknown)
- ['{BC45E26B-96F7-4151-87F1-C330C8C668E5}']
- procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventHandler = procedure (aSender: TObject; aEventArgs: IutlEventArgs) of object;
- TutlEventArgs = class(TutlInterfacedObject, IutlEventArgs)
- public
- constructor Create;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- IutlObservable = interface(IUnknown)
- ['{C54BD844-8273-4ACF-90C5-05DACF4359AF}']
- procedure RegisterEventListener (aListener: IutlEventListener);
- procedure UnregisterEventListener(aListener: IutlEventListener);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- generic TutlEventList<T> = class(specialize TutlCustomHashSet<T>)
- private type
- TComparer = class(TInterfacedObject, IComparer)
- public
- function EqualityCompare(constref i1, i2: T): Boolean;
- function Compare (constref i1, i2: T): Integer;
- end;
-
- public
- constructor Create;
- end;
- TutlNotifyEventList = specialize TutlEventList<TNotifyEvent>;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventListenerList = class(
- specialize TutlEventList<TutlEventHandler>
- , IutlEventListener)
-
- public { IutlEventListener }
- procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
-
- public
- constructor Create;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventListenerSet = class(
- specialize TutlCustomHashSet<IutlEventListener>
- , IutlEventListener
- , IutlObservable)
-
- private type
- TComparer = class(TInterfacedObject, IComparer)
- public
- function EqualityCompare(constref i1, i2: IutlEventListener): Boolean;
- function Compare (constref i1, i2: IutlEventListener): Integer;
- end;
-
- public { IutlEventListener }
- procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
-
- public { IutlObservable }
- procedure RegisterEventListener (aListener: IutlEventListener);
- procedure UnregisterEventListener(aListener: IutlEventListener);
-
- public
- constructor Create; reintroduce;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventListenerCallback = class(
- TInterfacedObject
- , IutlEventListener)
-
- private
- fHandler: TutlEventHandler;
-
- public { IEventListener }
- procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
-
- public
- constructor Create(const aHandler: TutlEventHandler);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- TutlEventListenerAsync = class(
- TInterfacedObject
- , IutlEventListener)
-
- private type
- TEventPair = specialize TutlPair<TObject, IutlEventArgs>;
- TEventQueue = class(specialize TutlQueue<TEventPair>)
- protected
- procedure Release(var aItem: TEventPair; const aFreeItem: Boolean); override;
- end;
-
- private
- fEventLock: TCriticalSection;
- fEvents: TEventQueue;
- fListener: IutlEventListener;
-
- function PopEventPair(out aPair: TEventPair): Boolean;
-
- public { IEventListener }
- procedure DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
-
- public
- procedure DispatchEvents;
-
- constructor Create(const aListener: IutlEventListener);
- destructor Destroy; override;
- end;
-
- implementation
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlEventArgs/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlEventArgs.Create;
- begin
- inherited Create;
- AutoFree := true;
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlEventList/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlEventList.TComparer.EqualityCompare(constref i1, i2: T): Boolean;
- begin
- result := (TMethod(i1).Data = TMethod(i2).Data)
- and (TMethod(i1).Code = TMethod(i2).Code);
- end;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlEventList.TComparer.Compare(constref 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;
-
- ////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlEventList.Create;
- begin
- inherited Create(TComparer.Create, true);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlEventListenerList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlEventListenerList.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
- var
- e: TutlEventHandler;
- begin
- for e in self do
- e(aSender, aEventArgs);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlEventListenerList.Create;
- begin
- inherited Create;
- AutoFree := true;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlEventListenerSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlEventListenerSet.TComparer.EqualityCompare(constref i1, i2: IutlEventListener): Boolean;
- begin
- result := (i1 = i2);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlEventListenerSet.TComparer.Compare(constref i1, i2: IutlEventListener): Integer;
- begin
- if (Pointer(i1) < Pointer(i2)) then
- result := -1
- else if (Pointer(i1) > Pointer(i2)) then
- result := 1
- else
- result := 0;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlEventListenerSet///////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlEventListenerSet.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
- var
- e: IutlEventListener;
- begin
- for e in self do
- e.DispatchEvent(aSender, aEventArgs);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlEventListenerSet.RegisterEventListener(aListener: IutlEventListener);
- begin
- Add(aListener);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlEventListenerSet.UnregisterEventListener(aListener: IutlEventListener);
- begin
- Remove(aListener);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlEventListenerSet.Create;
- begin
- inherited Create(TComparer.Create, true);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlEventListenerCallback//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlEventListenerCallback.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
- begin
- fHandler(aSender, aEventArgs);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlEventListenerCallback.Create(const aHandler: TutlEventHandler);
- begin
- inherited Create;
- if not Assigned(aHandler) then
- raise EArgumentNilException.Create('aHandler is not assigned');
- fHandler := aHandler;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlEventListenerAsync.TEventList//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlEventListenerAsync.TEventQueue.Release(var aItem: TEventPair; const aFreeItem: Boolean);
- begin
- aItem.first := nil;
- aItem.second := nil;
- inherited Release(aItem, aFreeItem);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- //TutlEventListenerAsync/////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- function TutlEventListenerAsync.PopEventPair(out aPair: TEventPair): Boolean;
- begin
- fEventLock.Enter;
- try
- result := not fEvents.IsEmpty;
- if result
- then aPair := fEvents.Dequeue
- else FillByte(aPair, SizeOf(aPair), 0);
- finally
- fEventLock.Leave;
- end;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlEventListenerAsync.DispatchEvent(aSender: TObject; aEventArgs: IutlEventArgs);
- var
- p: TEventPair;
- begin
- p.first := aSender;
- p.second := aEventArgs;
- fEventLock.Enter;
- try
- fEvents.Enqueue(p);
- finally
- fEventLock.Leave;
- end;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- procedure TutlEventListenerAsync.DispatchEvents;
- var
- p: TEventPair;
- begin
- while PopEventPair(p) do
- fListener.DispatchEvent(p.first, p.second);
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- constructor TutlEventListenerAsync.Create(const aListener: IutlEventListener);
- begin
- if not Assigned(aListener) then
- raise EArgumentNilException.Create('aListener');
- inherited Create;
- fEventLock := TCriticalSection.Create;
- fEvents := TEventQueue.Create(true);
- fListener := aListener;
- end;
-
- /////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
- destructor TutlEventListenerAsync.Destroy;
- begin
- fEventLock.Enter;
- try
- FreeAndNil(fEvents);
- fListener := nil;
- finally
- fEventLock.Leave;
- end;
- FreeAndNil(fEventLock);
- inherited Destroy;
- end;
-
- end.
-
|