The failed Daniel event delegate, with my delegate

Read the online Daniel's Delphi event commissioned, the actual use of a bug. The code is as follows:

Unit fadelegate;

Interface

uses
Generics.collections, Typinfo, Objauto, Sysutils;
type
Event = Class
private
Fmethods:tlist<tmethod>;
Finternaldispatcher:tmethod;
//the method of a generic class is not inline-assembled and can only be implemented by a non-generic parent class
Procedure Internalinvoke (params:pparameters; Stacksize:integer);
public
constructor Create;
destructor Destroy; override;
end;

Event<t> = Class (Event)
Private
Fobj:tobject;
fproname:string;

Fentry:t;
function Converttomethod (var Value): TMethod;
Procedure Setentry (var aentry);
Public
Constructor Create (Obj:tobject; proname:string);
destructor Destroy; Override
Procedure Add (amethod:t);
Procedure Remove (amethod:t);
function IndexOf (amethod:t): Integer;

Property Invok:t read Fentry;
End

Implementation

{event<t>}

Procedure Event<t>. ADD (amethod:t);
Var
M:tmethod;
Begin
M: = Converttomethod (Amethod);
if ((M.code<>nil) and (Fmethods.indexof (m) < 0) Then
Fmethods.add (m);
End

function Event<t>. Converttomethod (Var Value): TMethod;
Begin
Result: = TMethod (Value);
End

Constructor Event<t>. Create (Obj:tobject; proname:string);
Var
Methinfo:ptypeinfo;
Typedata:ptypedata;
M:tmethod;
P:pointer;
Begin
Methinfo: = TypeInfo (T);
If methinfo^. Kind <> Tkmethod then//detection T type
Raise Exception.create (' T is Method (Member function)! ');

Typedata: = Gettypedata (Methinfo);

Inherited Create ();
Finternaldispatcher: = Createmethodpointer (Internalinvoke, typedata); Convert the Internalinvoke function address to TMethod
Setentry (Fentry); Fentry is the entry address, set to Finternaldispatcher

Fobj:=obj;
Fproname:=proname;

M:=getmethodprop (Fobj,fproname);
P:[email protected];
ADD (T (p^)); Add the original method of the object first
Setmethodprop (Fobj,fproname,finternaldispatcher); Set the entry of the object
End

destructor Event<t>. Destroy;
Begin
Releasemethodpointer (Finternaldispatcher); And Createmethodpointer is a pair, just the opposite.

Inherited Destroy;
End

function Event<t>. IndexOf (amethod:t): Integer;
Begin
Result: = Fmethods.indexof (Converttomethod (Amethod));
End

Procedure Event<t>. Remove (amethod:t);
Begin
Fmethods.remove (Converttomethod (Amethod));
End

Procedure Event<t>. Setentry (var aentry);
Begin
TMethod (aentry): = Finternaldispatcher;
End

{Event}

Constructor Event.create;
Begin
Fmethods: = Tlist<tmethod>. Create;
End

destructor Event.destroy;
Begin
Fmethods.free;
Inherited Destroy;
End

procedure Event.internalinvoke (params:pparameters; Stacksize:integer);
var
Lmethod:tmethod;
begin
For Lmethod in Fmethods do
begin
//If the stack is used (that is, the Register convention parameter is greater than 2 or the STDCALL,CDECL Convention), all the data in the stack is copied into the parameter stack
if StackSize > 0 Then
ASM
MOV ecx,stacksize The third parameter of//move and prepares for the next sub ESP
SUB esp,ecx//Stack top-StackSize (stack is negative)
MOV Edx,esp//move the second parameter
MOV Eax,params
LEA Eax,[eax]. TPARAMETERS.STACK[8]//move the first parameter
Call System.move
end;
//register agreement to fill in three registers, eax must be self, if the other protocol register is not affected by the completion of
ASM
MOV eax,params//The Params read to EAX
MOV Edx,[eax]. Tparameters.registers.dword[0]//edx
MOV Ecx,[eax]. TPARAMETERS.REGISTERS.DWORD[4]//eax

MOV eax,lmethod.data//put Method.data to EAX, if it is the Register convention is self. otherwise it doesn't.
Call lmethod.code//calls Method.data
End
End
End

Bug experience assigning a value to the value parameter can be an error when delegating to the event Onupdatedata of a column in Tdbgrideh! Dizzy, do not know how to do well! So have to use their own method to solve!

My event delegate:

Delegate<t>=class
Private
I:integer;
Fentrance:tmethod;
Protected
Delegates:array of TMethod;
Procedure Addmethod (M:tmethod);
function getruneof (): Boolean;
function Getrun (): T;
Public
Constructor Create (C:tobject; proname:string); virtual;
destructor Destroy; Override
Procedure Add (delegate:t);

End

Denotify=class (delegate<tnotifyevent>)
Published
Procedure Dorun (Sender:tobject);
End

Implementation

Procedure Delegate<t>. ADD (delegate:t);
var M:tmethod;
P:pointer;
Begin
P:[email protected];
M:=tmethod (p^);
Addmethod (TMethod (p^));
End

Procedure Delegate<t>. Addmethod (M:tmethod);
Begin
if ((M.code=nil) or (M.data=nil)) then exit;
if (M.code<>fentrance.code) THEN BEGIN
SetLength (Delegates,high (Delegates) +2);
Delegates[high (Delegates)]:=m;
End
End

Constructor Delegate<t>. Create (C:tobject; proname:string);
Begin
fentrance.data:=self;
Fentrance.code:=methodaddress (' Dorun ');

Addmethod (Getmethodprop (c,proname));
Setmethodprop (c,proname,fentrance);
i:=0;

If Assigned (lstdelegates) =false then BEGIN
Lstdelegates:=tlist.create;
Lstdelegates.add (self);
End
End

destructor Delegate<t>. Destroy;
Begin
Dec (itotal);
If Lstdelegates.count=0 Then
Lstdelegates.free
Else
Lstdelegates.delete (Lstdelegates.indexof (self));

inherited;
End

function Delegate<t>. Getrun:t;
var M:tmethod;
P:pointer;
Begin
M:=DELEGATES[I-1];
P:[email protected];
Result:=t (p^);
End

function Delegate<t>. Getruneof:boolean;
Begin
Result:=not (I<=high (delegates));
If Result=false Then
INC (i)
Else
i:=0;
End

Procedure Denotify.dorun (Sender:tobject);
Begin
While not getruneof () does
Getrun () (Sender);
End

This method has a great disadvantage, that is, an event type to derive a class! But really, there's no problem.

It seems that things have two sides, concentrated very large code, it is very skilled, very difficult, and will be more error-prone.

If you concentrate small code, the skills required are not much, easy to understand, but more redundant. Upset.

However, in any case, the right is the first. It's not good to be any more skillful. The first method seems very powerful, but there are bugs, do not know how to change, because too advanced ....

The failed Daniel event delegate, with my delegate