A smart Delphi Multicast real-event scenario

A smart Delphi multicast implementation. Must be a Delphi version that supports generics. That is, after Delphi2009. It is strongly recommended to use Delphixe.

The usage is such as writing a class to specify an event, which notifies multiple method when triggered. The same as the. NET multicast event mechanism.

Usage Example:
Type
Tfakebutton = Class (TButton)
Private
fmulticast_onclik:tmulticastevent<tnotifyevent>;
Public
Constructor Create (aownder:tcomponent); override;
destructor Destroy; Override
Procedure Click; Override
Property multicast_onclik:tmulticastevent<tnotifyevent> read Fmulticast_onclik;
End
{TTest}
Procedure Tfakebutton.click;
Begin
inherited;
Such calls can notify multiple events
Fmulticast_onclik.invok (self);
End
Constructor Tfakebutton.create (aownder:tcomponent);
Begin
Inherited Create (Aownder);
Fmulticast_onclik: = Tmulticastevent<tnotifyevent>. Create;
End
destructor Tfakebutton.destroy;
Begin
Fmulticast_onclik.free;
Inherited Destroy;
End
//
Procedure Tform2.button1click (Sender:tobject);
Var
Test:tfakebutton;
Begin
Test: = Tfakebutton.create (self);
TEST.MULTICAST_ONCLIK.ADD (TestA);
TEST.MULTICAST_ONCLIK.ADD (TESTB);
Test.setbounds (0,0,100,100);
Test. Caption: = ' try Multicast ';
Test.parent: = self;
End

Procedure Tform2.testa (Sender:tobject);
Begin
ShowMessage (Caption);
End
Procedure Tform2.testb (Sender:tobject);
Begin
ShowMessage (FormatDateTime (' Yyyy-mm-dd hh:nn:ss ', now));
End
Click on the button to directly trigger Testa, and TESTB.

This approach is mainly to save the trouble of writing an event container and then looping the call.

Here's the code for the scenario:
{
The implementation of a multicast method.
and a colleague (a Delphi bull) discussed the implementation of the multicast event in Delphi.
He provides an easy-to-bo long technology for cattle People's multicast event scenario. The scheme is very bull, but it relies on Delphi's
There are too many compiler features that can only be used to turn on optimized code. And Delphixe default debug is off optimized.
Rewrite a tmulticastevent. This compiler generates code attributes that do not rely on Delphi.
Where Internalinvoke is basically the code of the easy-Bo Dragon Daniel. Added detailed comments
wr960204. 2011.5.28
}
Unit multicasteventutils;
Interface
Uses
Generics.collections, Typinfo, Objauto, sysutils;
Type
//
Tmulticastevent = Class
Private
fmethods:tlist<tmethod>;
Finternaldispatcher:tmethod;
It is tragic that the methods of a generic class cannot be compiled inline, but only through a non-generic parent class.
Procedure Internalinvoke (params:pparameters; Stacksize:integer);
Public
Constructor Create;
destructor Destroy; Override
End
Tmulticastevent<t > = Class (Tmulticastevent)
Private
Fentry:t;
function Converttomethod (var Value): TMethod;
Procedure Setentry (var aentry);
Public
Constructor Create;
destructor Destroy; Override
Procedure Add (amethod:t);
Procedure Remove (amethod:t);
function IndexOf (amethod:t): Integer;
Property Invok:t read Fentry;
End
Implementation
{tmulticastevent<t>}
Procedure Tmulticastevent<t>. ADD (amethod:t);
Var
M:tmethod;
Begin
M: = Converttomethod (Amethod);
If Fmethods.indexof (m) < 0 Then
Fmethods.add (m);
End
function Tmulticastevent<t>. Converttomethod (Var Value): TMethod;
Begin
Result: = TMethod (Value);
End
Constructor Tmulticastevent<t>. Create ();
Var
Methinfo:ptypeinfo;
Typedata:ptypedata;
Begin
Methinfo: = TypeInfo (T);
If methinfo^. Kind <> Tkmethod Then
Begin
Raise Exception.create (' T is Method (Member function)! ');
End
Typedata: = Gettypedata (Methinfo);
inherited;
Finternaldispatcher: = Createmethodpointer (Internalinvoke, typedata);
Setentry (Fentry);
End
destructor Tmulticastevent<t>. Destroy;
Begin
Releasemethodpointer (Finternaldispatcher);
Inherited Destroy;
End
function Tmulticastevent<t>. IndexOf (amethod:t): Integer;
Begin
Result: = Fmethods.indexof (Converttomethod (Amethod));
End
Procedure Tmulticastevent<t>. Remove (amethod:t);
Begin
Fmethods.remove (Converttomethod (Amethod));
End
Procedure Tmulticastevent<t>. Setentry (var aentry);
Begin
TMethod (aentry): = Finternaldispatcher;
End
{Tmulticastevent}
Constructor Tmulticastevent.create;
Begin
Fmethods: = Tlist<tmethod>. Create;
End
destructor Tmulticastevent.destroy;
Begin
Fmethods.free;
Inherited Destroy;
End
Procedure Tmulticastevent.internalinvoke (params:pparameters; Stacksize:integer);
Var
Lmethod:tmethod;
Begin
For Lmethod in Fmethods do
Begin
If a 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
End.

A smart Delphi Multicast real-event scenario