PageRenderTime 418ms CodeModel.GetById 191ms app.highlight 8ms RepoModel.GetById 214ms app.codeStats 0ms

/Source/Core/DSharp.Core.Events.pas

http://delphisorcery.googlecode.com/
Pascal | 832 lines | 1 code | 0 blank | 831 comment | 0 complexity | 9966bf97e258fd06dc1df96cf02da2a2 MD5 | raw file
  1(*
  2  Copyright (c) 2011, Stefan Glienke
  3  All rights reserved.
  4
  5  Redistribution and use in source and binary forms, with or without
  6  modification, are permitted provided that the following conditions are met:
  7
  8  - Redistributions of source code must retain the above copyright notice,
  9    this list of conditions and the following disclaimer.
 10  - Redistributions in binary form must reproduce the above copyright notice,
 11    this list of conditions and the following disclaimer in the documentation
 12    and/or other materials provided with the distribution.
 13  - Neither the name of this library nor the names of its contributors may be
 14    used to endorse or promote products derived from this software without
 15    specific prior written permission.
 16
 17  THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
 18  AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
 19  IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
 20  ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
 21  LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
 22  CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
 23  SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
 24  INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
 25  CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
 26  ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
 27  POSSIBILITY OF SUCH DAMAGE.
 28*)
 29
 30unit DSharp.Core.Events;
 31
 32interface
 33
 34uses
 35  Classes,
 36  DSharp.Core.NotificationHandler,
 37  Generics.Collections,
 38  ObjAuto,
 39{$IF CompilerVersion < 23}
 40  ObjAutoPatch,
 41{$IFEND}
 42  Rtti,
 43  TypInfo;
 44
 45type
 46  PDelegate = ^IDelegate;
 47  IDelegate = interface
 48    procedure Invoke;
 49  end;
 50
 51  IEvent = interface
 52    function GetCount: Integer;
 53    function GetEnabled: Boolean;
 54    function GetInvoke: TMethod;
 55    procedure Add(const AEvent: TMethod);
 56    procedure Remove(const AEvent: TMethod);
 57    procedure SetEnabled(const AValue: Boolean);
 58    property Count: Integer read GetCount;
 59    property Enabled: Boolean read GetEnabled write SetEnabled;
 60    property Invoke: TMethod read GetInvoke;
 61  end;
 62
 63  TEvent = class abstract(TInterfacedObject, IEvent, IDelegate)
 64  strict private
 65    FEnabled: Boolean;
 66    FInternalDispatcher: TMethod;
 67    FMethods: TList<TMethod>;
 68    function IEvent.GetInvoke = GetInvokeBase;
 69    procedure InternalInvoke(Params: PParameters; StackSize: Integer);
 70    procedure InternalNotify(Sender: TObject; const Item: TMethod;
 71      Action: TCollectionNotification);
 72    procedure Invoke;
 73  strict protected
 74{$IF CompilerVersion > 22}
 75    FCallingConvention: TCallConv;
 76    FParameters: TArray<TRttiParameter>;
 77{$IFEND}
 78    function GetInvokeBase: TMethod; virtual; abstract;
 79    procedure MethodAdded(const AMethod: TMethod); virtual; abstract;
 80    procedure MethodRemoved(const AMethod: TMethod); virtual; abstract;
 81    procedure Add(const AEvent: TMethod);
 82    function GetCount: Integer;
 83    function GetEnabled: Boolean;
 84    function IndexOf(const AEvent: TMethod): Integer;
 85    function IndexOfInstance(const AInstance: TObject): Integer;
 86    procedure Remove(const AEvent: TMethod);
 87    procedure RemoveInstanceReferences(const AInstance: TObject);
 88    procedure SetDispatcher(out AMethod: TMethod; ATypeData: PTypeData);
 89    procedure SetEnabled(const AValue: Boolean);
 90  public
 91    constructor Create;
 92    destructor Destroy; override;
 93  end;
 94
 95  IEvent<T> = interface(IEvent)
 96    function GetCount: Integer;
 97    function GetInvoke: T;
 98    function GetOnChanged: TNotifyEvent;
 99    procedure Add(AEvent: T);
100    procedure Remove(AEvent: T);
101    procedure SetOnChanged(const Value: TNotifyEvent);
102    property Count: Integer read GetCount;
103    property Invoke: T read GetInvoke;
104    property OnChanged: TNotifyEvent read GetOnChanged write SetOnChanged;
105  end;
106
107  TEvent<T> = class(TEvent, IEvent<T>)
108  strict private
109    FInvoke: T;
110    FNotificationHandler: TNotificationHandler<TEvent<T>>;
111    FOwner: TComponent;
112    FOnChanged: TNotifyEvent;
113    function Cast(const Value: T): TMethod;
114    function GetInvoke: T;
115    function GetOnChanged: TNotifyEvent;
116    procedure Notification(AComponent: TComponent; Operation: TOperation);
117    procedure SetEventDispatcher(out ADispatcher: T; ATypeData: PTypeData);
118    procedure SetOnChanged(const Value: TNotifyEvent);
119  strict protected
120    function GetInvokeBase: TMethod; override;
121    procedure MethodAdded(const AMethod: TMethod); override;
122    procedure MethodRemoved(const AMethod: TMethod); override;
123  public
124    constructor Create(AOwner: TComponent); overload;
125    constructor Create(AOwner: TComponent; AEvents: array of T); overload;
126{$IF CompilerVersion > 21}
127    class function Create<TDelegate>(AOwner: TComponent;
128      ADelegates: array of TDelegate): TEvent<T>; overload;
129{$IFEND}
130    class function Create<TDelegate>(AOwner: TComponent;
131      ADelegates: TArray<TDelegate>): TEvent<T>; overload;
132    destructor Destroy; override;
133    procedure Add(AEvent: T); overload;
134    procedure Add<TDelegate>(ADelegate: TDelegate); overload;
135    procedure Remove(AEvent: T); overload;
136    procedure Remove<TDelegate>(ADelegate: TDelegate); overload;
137    function IndexOf(AEvent: T): Integer;
138    property Count: Integer read GetCount;
139    property Enabled: Boolean read GetEnabled write SetEnabled;
140    property Invoke: T read GetInvoke;
141    property Owner: TComponent read FOwner;
142  end;
143
144  Event<T> = record
145  strict private
146    FEventHandler: IEvent<T>;
147    FInitialized: Boolean;
148    function GetCount: Integer;
149    function GetEnabled: Boolean;
150    function GetEventHandler: IEvent<T>;
151    function GetInvoke: T;
152    function GetOnChanged: TNotifyEvent;
153    procedure SetEnabled(const Value: Boolean);
154    procedure SetOnChanged(const Value: TNotifyEvent);
155  public
156    constructor Create(AEventHandler: IEvent<T>);
157
158    procedure Add(const AEvent: T);
159    procedure Remove(const AEvent: T);
160    property Count: Integer read GetCount;
161    property Enabled: Boolean read GetEnabled write SetEnabled;
162    property EventHandler: IEvent<T> read GetEventHandler;
163    property Invoke: T read GetInvoke;
164    property OnChanged: TNotifyEvent read GetOnChanged write SetOnChanged;
165
166    class operator Implicit(const AValue: Event<T>): IEvent<T>;
167    class operator Implicit(const AValue: Event<T>): T;
168    class operator Implicit(const AValue: IEvent<T>): Event<T>;
169  end;
170
171procedure GetMethodTypeData(Method: TRttiMethod; var TypeData: PTypeData);
172function IsValid(AObject: TObject): Boolean;
173procedure MethodReferenceToMethodPointer(const AMethodReference; var AMethodPointer);
174
175var
176  Context: TRttiContext;
177
178implementation
179
180procedure GetMethodTypeData(Method: TRttiMethod; var TypeData: PTypeData);
181type
182  PParameterInfos = ^TParameterInfos;
183  TParameterInfos = array[0..255] of PPTypeInfo;
184var
185  params: TArray<TRttiParameter>;
186  i: Integer;
187  p: PByte;
188begin
189  TypeData.MethodKind := Method.MethodKind;
190  params := Method.GetParameters;
191  TypeData.ParamCount := Length(params);
192  p := @TypeData.ParamList;
193  for i := Low(params) to High(params) do
194  begin
195    TParamFlags(p[0]) := params[i].Flags;
196    Inc(p);
197    PShortString(p)^ := ShortString(params[i].Name);
198    Inc(p, p[0] + 1);
199    PShortString(p)^ := ShortString(params[i].ParamType.Name);
200    Inc(p, p[0] + 1);
201  end;
202  if method.MethodKind = mkFunction then
203  begin
204    PShortString(p)^ := ShortString(method.ReturnType.Name);
205    Inc(p, p[0] + 1);
206    PPTypeInfo(p)^ := method.ReturnType.Handle;
207    Inc(p, 4);
208  end;
209  TCallConv(p[0]) := method.CallingConvention;
210  Inc(p);
211  for i := Low(params) to High(params) do
212  begin
213    PParameterInfos(Cardinal(p))[i] := PPTypeInfo(Cardinal(params[i].ParamType.Handle) - 4);
214  end;
215end;
216
217function IsValid(AObject: TObject): Boolean;
218{$IFDEF VER210}
219type
220  PNativeInt = ^NativeInt;
221{$ENDIF}
222begin
223  Result := False;
224  if Assigned(AObject) then
225  try
226    if PNativeInt(AObject)^ > $FFFF then  // "hotfix" to prevent some access violations (no clue if this works) :)
227      Result := PNativeInt(AObject)^ = PNativeInt(PNativeInt(AObject)^ + vmtSelfPtr)^;
228  except
229  end;
230end;
231
232procedure MethodReferenceToMethodPointer(const AMethodReference; var AMethodPointer);
233type
234  TVtable = array[0..3] of Pointer;
235  PVtable = ^TVtable;
236  PPVtable = ^PVtable;
237begin
238  // 3 is offset of Invoke, after QI, AddRef, Release
239  TMethod(AMethodPointer).Code := PPVtable(AMethodReference)^^[3];
240  TMethod(AMethodPointer).Data := Pointer(AMethodReference);
241end;
242
243procedure PassArg(Par: TRttiParameter; Params: PParameters; var Dest: TValue;
244  CC: TCallConv; const Index: Integer; var Offset: Byte);
245const
246  PointerSize = SizeOf(Pointer);
247begin
248{$IFDEF CPUX64}
249  if Par.Flags * [pfVar, pfConst, pfOut] <> [] then
250  begin
251    Dest := TValue.From<Pointer>(PPointer(@Params.Stack[Offset])^);
252  end
253  else
254  begin
255    TValue.Make(Pointer(@Params.Stack[Offset]), Par.ParamType.Handle, Dest);
256  end;
257  Inc(Offset, PointerSize);
258{$ENDIF}
259
260{$IFDEF CPUX86}
261  if (CC = ccReg) and (Index < 2) then
262  begin
263    if Par.Flags * [pfVar, pfConst, pfOut] <> [] then
264    begin
265      Dest := TValue.From<Pointer>(Pointer(Params.Registers[Index + 1]));
266    end
267    else
268    begin
269      TValue.Make(NativeInt(Params.Registers[Index + 1]), Par.ParamType.Handle, Dest);
270    end
271  end
272  else
273  begin
274    Dec(Offset, PointerSize);
275    if Par.Flags * [pfVar, pfConst, pfOut] <> [] then
276    begin
277      Dest := TValue.From<Pointer>(PPointer(@Params.Stack[Offset])^);
278    end
279    else
280    begin
281      TValue.Make(Pointer(@Params.Stack[Offset]), Par.ParamType.Handle, Dest);
282    end;
283  end;
284{$ENDIF}
285end;
286
287{ TEventHandler }
288
289constructor TEvent.Create;
290begin
291  FEnabled := True;
292  FMethods := TList<TMethod>.Create();
293  FMethods.OnNotify := InternalNotify;
294end;
295
296destructor TEvent.Destroy;
297begin
298  FMethods.Free();
299  ReleaseMethodPointer(FInternalDispatcher);
300  inherited;
301end;
302
303
304procedure TEvent.InternalInvoke(Params: PParameters; StackSize: Integer);
305const
306  PointerSize = SizeOf(Pointer);
307var
308  LMethod: TMethod;
309{$IF CompilerVersion < 23}
310begin
311  if FEnabled then
312  begin
313    for LMethod in FMethods do
314    begin
315      // "Push" parameters on stack
316      if StackSize > 0 then
317      asm
318        // Put StackSize as third parameter
319        MOV ECX,StackSize
320        // stack address alignment
321        ADD ECX,PointerSize-1
322        AND ECX,NOT(PointerSize-1)
323        AND ECX,$FFFF
324        SUB ESP,ECX
325        // Put Stack Address as second parameter
326        MOV EDX,ESP
327        // Put Params on Stack as first parameter
328        MOV EAX,Params
329        LEA EAX,[EAX].TParameters.Stack[8]
330        CALL System.Move
331      end;
332      asm
333        MOV EAX,Params
334        MOV EDX,[EAX].TParameters.Registers.DWORD[0]
335        MOV ECX,[EAX].TParameters.Registers.DWORD[4]
336        MOV EAX,LMethod.Data
337        CALL LMethod.Code
338      end;
339    end;
340  end;
341end;
342{$ELSE}
343  i: Integer;
344  LArgs: TArray<TValue>;
345  LOffset: Byte;
346begin
347  if FEnabled and (FMethods.Count > 0) then
348  begin
349{$IFDEF CPUX86}
350    LOffset := StackSize;
351{$ENDIF}
352{$IFDEF CPUX64}
353    LOffset := PointerSize;
354{$ENDIF}
355    SetLength(LArgs, Length(FParameters) + 1);
356
357    for i := Low(FParameters) to High(FParameters) do
358    begin
359      PassArg(FParameters[i], Params, LArgs[i + 1],
360        FCallingConvention, i, LOffset);
361    end;
362
363    for LMethod in FMethods do
364    begin
365      LArgs[0] := TValue.From<TObject>(LMethod.Data);
366      // workaround for incorrect type guess in Rtti.pas
367      TValueData(LArgs[0]).FTypeInfo := TypeInfo(TObject);
368      Rtti.Invoke(LMethod.Code, LArgs, FCallingConvention, nil);
369    end;
370  end;
371end;
372{$IFEND}
373
374procedure TEvent.InternalNotify(Sender: TObject; const Item: TMethod;
375  Action: TCollectionNotification);
376begin
377  if Assigned(Item.Data) and not IsValid(Item.Data) then
378  begin
379    case Action of
380      cnAdded: IInterface(Item.Data)._AddRef();
381      cnRemoved: IInterface(Item.Data)._Release();
382    end;
383  end;
384end;
385
386procedure TEvent.Invoke;
387asm
388{$IFDEF CPUX64}
389  MOV RAX,RCX
390  MOV RCX,[RAX].FInternalDispatcher.Data
391  JMP [RAX].FInternalDispatcher.Code
392{$ELSE}
393  MOV EBX,EAX
394  MOV EAX,[EBX].FInternalDispatcher.Data
395  JMP [EBX].FInternalDispatcher.Code
396{$ENDIF}
397end;
398
399procedure TEvent.Add(const AEvent: TMethod);
400begin
401  FMethods.Add(AEvent);
402  MethodAdded(AEvent);
403end;
404
405function TEvent.GetCount: Integer;
406begin
407  Result := FMethods.Count;
408end;
409
410function TEvent.GetEnabled: Boolean;
411begin
412  Result := FEnabled;
413end;
414
415function TEvent.IndexOf(const AEvent: TMethod): Integer;
416var
417  i: Integer;
418begin
419  Result := -1;
420  for i := 0 to Pred(FMethods.Count) do
421  begin
422    if (FMethods[i].Code = TMethod(AEvent).Code)
423      and (FMethods[i].Data = TMethod(AEvent).Data) then
424    begin
425      Result := i;
426      Break;
427    end;
428  end;
429end;
430
431function TEvent.IndexOfInstance(const AInstance: TObject): Integer;
432var
433  i: Integer;
434begin
435  Result := -1;
436  for i := 0 to Pred(FMethods.Count) do
437  begin
438    if TObject(FMethods[i].Data) = AInstance then
439    begin
440      Result := i;
441      Break;
442    end;
443  end;
444end;
445
446procedure TEvent.Remove(const AEvent: TMethod);
447var
448  i: Integer;
449begin
450  i := IndexOf(AEvent);
451  if i > -1 then
452  begin
453    FMethods.Delete(i);
454  end;
455  MethodRemoved(AEvent);
456end;
457
458procedure TEvent.RemoveInstanceReferences(const AInstance: TObject);
459var
460  i: Integer;
461begin
462  repeat
463    i := IndexOfInstance(AInstance);
464    if i > -1 then
465    begin
466      FMethods.Delete(i);
467    end;
468  until i = -1;
469end;
470
471procedure TEvent.SetDispatcher(out AMethod: TMethod; ATypeData: PTypeData);
472begin
473  if Assigned(FInternalDispatcher.Code)
474    and Assigned(FInternalDispatcher.Data) then
475  begin
476    ReleaseMethodPointer(FInternalDispatcher);
477  end;
478  FInternalDispatcher := CreateMethodPointer(InternalInvoke, ATypeData);
479  AMethod := FInternalDispatcher;
480end;
481
482procedure TEvent.SetEnabled(const AValue: Boolean);
483begin
484  FEnabled := AValue;
485end;
486
487{ TEventHandler<T> }
488
489constructor TEvent<T>.Create(AOwner: TComponent);
490var
491  MethInfo: PTypeInfo;
492  TypeData: PTypeData;
493  RttiType: TRttiType;
494  Methods: TArray<TRttiMethod>;
495begin
496  MethInfo := TypeInfo(T);
497  TypeData := GetTypeData(MethInfo);
498  inherited Create();
499  if MethInfo.Kind = tkInterface then
500  begin
501    RttiType := Context.GetType(MethInfo);
502    Methods := RttiType.GetMethods;
503    Assert(Length(Methods) > 0, string(MethInfo.Name) + ' must contain extended RTTI');
504    New(TypeData);
505    try
506      GetMethodTypeData(Methods[0], TypeData);
507      Assert(TypeData.MethodKind = mkProcedure, string(MethInfo.Name) + ' must not be a function');
508{$IF CompilerVersion > 22}
509      FCallingConvention := Methods[0].CallingConvention;
510      FParameters := Methods[0].GetParameters();
511{$IFEND}
512      SetEventDispatcher(FInvoke, TypeData);
513    finally
514      Dispose(TypeData);
515    end;
516  end
517  else
518  begin
519    Assert(MethInfo.Kind = tkMethod, string(MethInfo.Name) + ' must be a method pointer type');
520    Assert(TypeData.MethodKind = mkProcedure, string(MethInfo.Name) + ' must not be a function');
521{$IF CompilerVersion > 22}
522    RttiType := Context.GetType(MethInfo);
523    FCallingConvention := TRttiInvokableType(RttiType).CallingConvention;
524    FParameters := TRttiInvokableType(RttiType).GetParameters();
525{$IFEND}
526    SetEventDispatcher(FInvoke, TypeData);
527  end;
528  FNotificationHandler := TNotificationHandler<TEvent<T>>.Create(Self, Notification);
529  if Assigned(AOwner) then
530  begin
531    FOwner := AOwner;
532    FOwner.FreeNotification(FNotificationHandler);
533  end;
534end;
535
536constructor TEvent<T>.Create(AOwner: TComponent; AEvents: array of T);
537var
538  LEvent: T;
539begin
540  Create(AOwner);
541  for LEvent in AEvents do
542  begin
543    Add(LEvent);
544  end;
545end;
546
547{$IF CompilerVersion > 21}
548class function TEvent<T>.Create<TDelegate>(AOwner: TComponent;
549  ADelegates: array of TDelegate): TEvent<T>;
550var
551  LDelegate: TDelegate;
552begin
553  Result := Create(AOwner);
554  for LDelegate in ADelegates do
555  begin
556    Result.Add<TDelegate>(LDelegate);
557  end;
558end;
559{$IFEND}
560
561class function TEvent<T>.Create<TDelegate>(AOwner: TComponent;
562  ADelegates: TArray<TDelegate>): TEvent<T>;
563var
564  LDelegate: TDelegate;
565begin
566  Result := Create(AOwner);
567  for LDelegate in ADelegates do
568  begin
569    Result.Add<TDelegate>(LDelegate);
570  end;
571end;
572
573destructor TEvent<T>.Destroy;
574begin
575  FNotificationHandler.Free();
576  inherited;
577end;
578
579procedure TEvent<T>.Add(AEvent: T);
580begin
581  inherited Add(Cast(AEvent));
582end;
583
584procedure TEvent<T>.Add<TDelegate>(ADelegate: TDelegate);
585var
586  LEvent: T;
587  LTypeInfo: PTypeInfo;
588  LTypeData: PTypeData;
589{$IF CompilerVersion > 22}
590//  LMethod: TRttiMethod;
591//  LParams: TArray<TRttiParameter>;
592{$IFEND}
593begin
594  LTypeInfo := TypeInfo(TDelegate);
595  Assert(LTypeInfo.Kind = tkInterface, 'TDelegate must be a method reference');
596  LTypeInfo := TypeInfo(T);
597  LTypeData := GetTypeData(LTypeInfo);
598
599{$IF CompilerVersion > 22}
600//  Does not work right now because method references are missing RTTI
601//  LMethod := Context.GetType(TypeInfo(TDelegate)).GetMethod('Invoke');
602//  Assert(LMethod.MethodKind = LTypeData.MethodKind, 'MethodKind does not match');
603//  LParams := LMethod.GetParameters();
604//  Assert(Length(LParams) = LTypeData.ParamCount, 'ParamCount does not match');
605{$IFEND}
606  MethodReferenceToMethodPointer(ADelegate, LEvent);
607  Add(LEvent);
608end;
609
610function TEvent<T>.Cast(const Value: T): TMethod;
611begin
612  if PTypeInfo(TypeInfo(T)).Kind = tkInterface then
613  begin
614    MethodReferenceToMethodPointer(Value, Result);
615  end
616  else
617  begin
618    Result := TMethod(Pointer(@Value)^);
619  end;
620end;
621
622function TEvent<T>.GetInvoke: T;
623begin
624  Result := FInvoke;
625end;
626
627function TEvent<T>.GetInvokeBase: TMethod;
628begin
629  Result := TMethod(Pointer(@FInvoke)^);
630end;
631
632function TEvent<T>.GetOnChanged: TNotifyEvent;
633begin
634  Result := FOnChanged;
635end;
636
637function TEvent<T>.IndexOf(AEvent: T): Integer;
638begin
639  Result := inherited IndexOf(Cast(AEvent));
640end;
641
642procedure TEvent<T>.MethodAdded(const AMethod: TMethod);
643begin
644  inherited;
645  if IsValid(AMethod.Data) and (TObject(AMethod.Data) is TComponent) then
646  begin
647    FNotificationHandler.FreeNotification(TComponent(AMethod.Data));
648  end;
649end;
650
651procedure TEvent<T>.MethodRemoved(const AMethod: TMethod);
652begin
653  inherited;
654  if IsValid(AMethod.Data) and (TObject(AMethod.Data) is TComponent)
655    and (IndexOfInstance(TObject(AMethod.Data)) < 0) then
656  begin
657    FNotificationHandler.RemoveFreeNotification(TComponent(AMethod.Data));
658  end;
659end;
660
661procedure TEvent<T>.Notification(
662  AComponent: TComponent; Operation: TOperation);
663begin
664  inherited;
665  if Operation = opRemove then
666  begin
667    RemoveInstanceReferences(AComponent);
668    if (AComponent = FOwner) and (RefCount = 0) then
669    begin
670      Free();
671    end;
672  end;
673end;
674
675procedure TEvent<T>.Remove(AEvent: T);
676begin
677  inherited Remove(Cast(AEvent));
678end;
679
680procedure TEvent<T>.Remove<TDelegate>(ADelegate: TDelegate);
681var
682  LEvent: T;
683begin
684  MethodReferenceToMethodPointer(ADelegate, LEvent);
685  Remove(LEvent);
686end;
687
688procedure TEvent<T>.SetEventDispatcher(out ADispatcher: T; ATypeData: PTypeData);
689var
690  LMethod: TMethod;
691begin
692  inherited SetDispatcher(LMethod, ATypeData);
693  if PTypeInfo(TypeInfo(T)).Kind = tkInterface then
694  begin
695    PDelegate(@FInvoke)^ := Self;
696    Self._Release;
697  end
698  else
699  begin
700    TMethod(Pointer(@ADispatcher)^) := LMethod;
701  end;
702end;
703
704procedure TEvent<T>.SetOnChanged(const Value: TNotifyEvent);
705begin
706  FOnChanged := Value;
707end;
708
709{ TEvent<T> }
710
711constructor Event<T>.Create(AEventHandler: IEvent<T>);
712begin
713  FEventHandler := AEventHandler;
714  FInitialized := Assigned(FEventHandler);
715end;
716
717procedure Event<T>.Add(const AEvent: T);
718var
719  LEventHandler: IEvent<T>;
720begin
721  LEventHandler := EventHandler;
722  if Assigned(LEventHandler) then
723  begin
724    LEventHandler.Add(AEvent);
725  end;
726end;
727
728function Event<T>.GetCount: Integer;
729var
730  LEventHandler: IEvent<T>;
731begin
732  Result := 0;
733  LEventHandler := EventHandler;
734  if Assigned(LEventHandler) then
735  begin
736    Result := LEventHandler.Count;
737  end;
738end;
739
740function Event<T>.GetEnabled: Boolean;
741var
742  LEventHandler: IEvent<T>;
743begin
744  Result := False;
745  LEventHandler := EventHandler;
746  if Assigned(LEventHandler) then
747  begin
748    Result := LEventHandler.Enabled;
749  end;
750end;
751
752function Event<T>.GetEventHandler: IEvent<T>;
753begin
754  if not FInitialized then
755  begin
756    FEventHandler := TEvent<T>.Create(nil);
757    FInitialized := True;
758  end;
759  Result := FEventHandler;
760end;
761
762function Event<T>.GetInvoke: T;
763var
764  LEventHandler: IEvent<T>;
765begin
766  LEventHandler := EventHandler;
767  if Assigned(LEventHandler) then
768  begin
769    Result := LEventHandler.Invoke;
770  end;
771end;
772
773function Event<T>.GetOnChanged: TNotifyEvent;
774var
775  LEventHandler: IEvent<T>;
776begin
777  LEventHandler := EventHandler;
778  if Assigned(LEventHandler) then
779  begin
780    Result := LEventHandler.OnChanged;
781  end;
782end;
783
784procedure Event<T>.Remove(const AEvent: T);
785var
786  LEventHandler: IEvent<T>;
787begin
788  LEventHandler := EventHandler;
789  if Assigned(LEventHandler) then
790  begin
791    LEventHandler.Remove(AEvent);
792  end;
793end;
794
795procedure Event<T>.SetEnabled(const Value: Boolean);
796var
797  LEventHandler: IEvent<T>;
798begin
799  LEventHandler := EventHandler;
800  if Assigned(LEventHandler) then
801  begin
802    LEventHandler.Enabled := Value;
803  end;
804end;
805
806procedure Event<T>.SetOnChanged(const Value: TNotifyEvent);
807var
808  LEventHandler: IEvent<T>;
809begin
810  LEventHandler := EventHandler;
811  if Assigned(LEventHandler) then
812  begin
813    LEventHandler.OnChanged := Value;
814  end;
815end;
816
817class operator Event<T>.Implicit(const AValue: Event<T>): IEvent<T>;
818begin
819  Result := AValue.EventHandler;
820end;
821
822class operator Event<T>.Implicit(const AValue: Event<T>): T;
823begin
824  Result := AValue.EventHandler.Invoke;
825end;
826
827class operator Event<T>.Implicit(const AValue: IEvent<T>): Event<T>;
828begin
829  Result := Event<T>.Create(AValue);
830end;
831
832end.