一个灵巧的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.