一个灵巧的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基本上是那位易博龙大牛的代码.加了详细的注释 } 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.

转自：http://www.cnblogs.com/key-ok/p/3506483.html