一個(gè)靈巧的Delphi多播實(shí)事件現(xiàn)方案.

2012/4/20 18:30:18  出處：本站原創(chuàng)   人氣：330次    字號：小  中  大

一個(gè)靈巧的Delphi多播實(shí)現(xiàn)方案.必須是支持泛型的Delphi版本.也就是Delphi2009以后.強(qiáng)烈建議用DelphiXE.

用法就是例如寫一個(gè)Class指定一個(gè)Event,觸發(fā)的時(shí)候會通知多個(gè)Method.和.NET的多播事件機(jī)制是一樣的.

用法例如:

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;
  //這樣調(diào)用可以通知多個(gè)事件
  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;

在按鈕上點(diǎn)一下,直接會觸發(fā)TestA,和TestB.

這個(gè)做法主要是省了寫一個(gè)事件容器,然后循環(huán)調(diào)用的麻煩.

下面是方案的代碼:

{
一個(gè)多播方法的實(shí)現(xiàn).
和一位同事(一位Delphi牛人)一起討論了一下Delphi下多播事件的實(shí)現(xiàn).
他提供了一個(gè)易博龍技術(shù)牛人的多播事件方案.這個(gè)方案非常牛,但是依賴Delphi的
編譯器特性太多,只能用在開啟優(yōu)化的代碼.而DelphiXE默認(rèn)Debug是關(guān)閉優(yōu)化的.

重寫了一個(gè)TMulticastEvent.這個(gè)不依賴Delphi的編譯器產(chǎn)生的代碼特性.
其中InternalInvoke基本上是那位易博龍大牛的代碼.加了詳細(xì)的注釋

wr960204. 2011.5.28
}
unit MultiCastEventUtils;

interface
uses
  Generics.collections, TypInfo, ObjAuto, SysUtils;

type
  //
  TMulticastEvent = class
  private
    FMethods : TList<TMethod>;
    FInternalDispatcher: TMethod;
    //悲催的是泛型類的方法不能內(nèi)嵌匯編,只能通過一個(gè)非泛型的父類來實(shí)現(xiàn)
    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約定參數(shù)大于2或者stdcall,cdecl約定)就把棧內(nèi)所有數(shù)據(jù)都拷貝參數(shù)棧里面
    if StackSize > 0 then
      asm
        MOV ECX,StackSize     //Move的第三個(gè)參數(shù),同時(shí)為下一步Sub ESP做準(zhǔn)備
        SUB ESP,ECX           //把棧頂 - StackSize(棧是負(fù)向的)
        MOV EDX,ESP           //Move的第二個(gè)參數(shù)
        MOV EAX,Params
        LEA EAX,[EAX].TParameters.Stack[8] //Move的第一個(gè)參數(shù)
        CALL System.Move
      end;
    //Register協(xié)議填寫三個(gè)寄存器,EAX肯定是Self,如果是其他協(xié)議寄存器被填寫也沒啥影響
    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//調(diào)用Method.Data
    end;
  end;
end;

end.