一个灵巧的Delphi多播实事件现方案.

一个灵巧的Delphi多播实现方案.必须是支持泛型的Delphi版本.也就是Delphi2009以后.强烈建议用DelphiXE.



 



用法就是例如写一个Class指定一个Event,触发的时候会通知多个Method.和.NET的多播事件机制是一样的.



 



用法例如:



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;

   //这样调用可以通知多个事件

  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 := '试试多播';

   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;



在按钮上点一下,直接会触发TestA,和TestB.



 



这个做法主要是省了写一个事件容器,然后循环调用的麻烦.



 



下面是方案的代码:



{

一个多播方法的实现.

和一位同事(一位Delphi牛人)一起讨论了一下Delphi下多播事件的实现.

他提供了一个易博龙技术牛人的多播事件方案.这个方案非常牛,但是依赖Delphi的

 编译器特性太多,只能用在开启优化的代码.而DelphiXE默认Debug是关闭优化的.



重写了一个TMulticastEvent.这个不依赖Delphi的编译器产生的代码特性.

其中InternalInvoke基本上是那位易博龙大牛的代码.加了详细的注释



wr960204. 2011.5.28

 }

 unit MultiCastEventUtils;



 interface

 uses

   Generics.collections, TypInfo, ObjAuto, SysUtils;



 type

   //

   TMulticastEvent = class

   private

     FMethods : TList<TMethod>;

     FInternalDispatcher: TMethod;

     //悲催的是泛型类的方法不能内嵌汇编,只能通过一个非泛型的父类来实现

    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 only 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

     //如果用到了栈(也就是Register约定参数大于2或者stdcall,cdecl约定)就把栈内所有数据都拷贝参数栈里面

    if StackSize > 0 then

       asm

         MOV ECX,StackSize     //Move的第三个参数,同时为下一步Sub ESP做准备

        SUB ESP,ECX           //把栈顶 - StackSize(栈是负向的)

         MOV EDX,ESP           //Move的第二个参数

        MOV EAX,Params

         LEA EAX,[EAX].TParameters.Stack[8] //Move的第一个参数

        CALL System.Move

       end;

     //Register协议填写三个寄存器,EAX肯定是Self,如果是其他协议寄存器被填写也没啥影响

    asm

       MOV EAX,Params         //把Params读到EAX

       MOV EDX,[EAX].TParameters.Registers.DWORD[0] //EDX

       MOV ECX,[EAX].TParameters.Registers.DWORD[4] //EAX



      MOV EAX,LMethod.Data//把Method.Data给到EAX,如果是Register约定就是Self.否则也没影响

      CALL LMethod.Code//调用Method.Data

     end;

   end;

 end;



 end.