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