在 Delphi 中实现 multi-delegate

不知从什么时候开始，如果在文章标题中只提及一个技术术语，一般就默认表示它是用在.net中的技术了。所以我不得不在标题上加一个 Delphi 字样。

先为用 Delphi 的朋友简单介绍下 delegate，如果你用过 c# 什么的，就可以跳过这部分了。delegate 就象个封装了函数指针的对象，用 delegate 对象“指向”一个函数，或事件句柄，然后在程序的其它地方调用它。虽然这种用法不很直观，也一时难以想到什么情况下需要这样干，但这种方法看起来很灵活。

更进一步，如果一个 delegate 对象能够“指向”多个函数，然后在调用时，可以一次性调用所有它所指向的函数，就可以更灵活了。

这有点类似于观察者模式，一个被观察者，可以被多个观察者收听，当被观察者需要告诉观察者一些事情时，所有的观察者都会收到。例如，在一个 model 和 view 分离的程序中，多个 view 或 controller 都可以收听 model 的同一个事件，这就是 multi-delegate 了。我的设计参考了国外的一个作品(http://www.codebot.org/delphi/?doc=9568，我已将翻译发布在http://bbs.cnpack.org/viewthread.php?tid=10272&extra=page%3D2 )，用法和他的一样。他实现的看起来有点复杂，我这里简化了很多，我主要的工作是增加了invoke()方法，这样就可以方便快速的调用了。它的用法是这样：

TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
  public
     { Public declarations }
     OnChange: TDelegate<TNotifyEvent>;
     procedure one(sender: TObject);
     procedure two(sender: TObject);
  end;
implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
　　OnChange.Add(one);
　　onchange.Add(two);
　　OnChange.invoke([sender]);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
　　fOnChange1: TDelegate<TProc<TObject>>;
begin
　　fOnChange1.add(procedure(obj: TObject)
   　　 begin
    　　showmessage(obj.ClassName);
　　    end);
　　fOnChange1.invoke<TObject>(Sender);
end;

procedure TForm1.one(sender: TObject);
begin
　　ShowMessage('one');
end;

procedure TForm1.two(sender: TObject);
begin
　　ShowMessage('two');
end;

 

下面的内容是关于 TDelegate<> 实现，首先是声明部分：

type
IContainer<T> =interface
    procedure add(const handler: T);
    procedure remove(const handler: T);
    function GetEnumerator: TEnumerator<T>;
end;

CContainer<T> =class(TInterfacedObject, IContainer<T>)
private
    flist: TList<T>;
    constructor create;
    destructor Destroy; override;
    procedure add(const handler: T);
    procedure remove(const handler: T);
    function GetEnumerator: TEnumerator<T>;
end;

TDelegate<T> = record
private
    fContainer: IContainer<T>;
public
    procedure add(const handler: T);
    procedure remove(const handler: T);
    procedure invoke(const Args: array of TValue); overload;
    procedure invoke<TArg1>(Arg: TArg1); overload; experimental;
    function GetEnumerator: TEnumerator<T>;
end;

因为必须把它设计成无需创建的，所以 TDelegate<> 必须是个结构类型。

TDelegate<> 拥有一个 IContainer<> 接口对象，对 TDelegate<> 的 add()，remove()，实际都是交由 CContainer<> 实现的，而在 CContainer<> 内部，则是交由 TList<> 实现的，当TDelegate<>的add()首次被调用时，它才创建 fContainer 实例。由于是个接口，所以不需担心它的释放问题。 

用户不应看到 IContainer<> 和 CContainer<>，它们只是为 TDelegate<> 服务的，按理说该把它定义为 TDelegate<> 的内部类，但这样编译时会产生一个莫明的内部错误，至少在 XE2 Update1 的中是这样。你也可能会想到 CContainer<> 可以用一个属性委托实现 IContainer<> 接口，我已经尝试过了，Delphi 崩溃了。

下面是 invoke() 的实现：

procedure TDelegate<T>.invoke(const Args: array of TValue);
var
    context: TRttiContext;
    method: TValue;
    methodType: TRttiInvokableType;
    p: TEnumerator<T>;
begin
p:=fContainer.GetEnumerator;
while p.MoveNext do begin
    method := context.GetType(p.ClassType).GetProperty('Current').GetValue(p);
    methodType := context.GetType(method.TypeInfo) as TRttiInvokableType;
    methodType.Invoke(method, Args);
    end;
p.Free;
end;

这里用到了 RTTI，但也只是勉强实现，比如，当 T 为 TMouseEvent 时就无能为力了，因为 TMouseEvent 事件的参数中有集合类型，所以就没法写类似于 fOnChange.invoke([Sender, [mbLeft]]); 这样的代码。

TDelegate<T> 中的 T，除了是事件类型外，还可以是 TProc<TArg1> 类型。这样用起来就更灵活，比如这样： 

procedure TForm1.Button2Click(Sender: TObject);

var 

OnChange: TDelegate<TProc<TObject>>; 

begin

onChange.add(procedure(obj: TObject)
    begin
    showmessage(obj.ClassName);
    end);

onChange.invoke<TObject>(Sender);

end;

比之前的用法稍麻烦的是，这里的 invoke() 需要用 <TArg1> 帮助指出参数的类型，目前我还没有什么办法解决这个问题，所以这个版本只做了带一个参数的 invoke<TArg1>(arg1: TArg1)

procedure TDelegate<T>.invoke<TArg1>(Arg: TArg1);
var
    context: TRttiContext;
    p: TEnumerator<T>;
    pt: Pointer;
    v: TValue;
    aProc: TProc<TArg1>;
begin
p:=fContainer.GetEnumerator;
while p.MoveNext do begin
    v := context.GetType(p.ClassType).GetProperty('Current').GetValue(p);
    v.ExtractRawDataNoCopy(@pt);
    aProc:=TProc<TArg1>(pt);
    aProc(arg);
    end;
p.Free;
end;

先是把 fList 的元素值转换为指针，然后又转成了 TProc<TArg1>，编译后这段代码没有打上绿色的小点，所以这段代码没法被断点调试，但它确实有效。你也可以用下面这段代码代替 onChange.invoke<TObject>(Sender);

var 
    p: TProc<TObject>; 
begin 
for p in fOnChange do 
    p(Sender); 
end;

以上全部代码在这里可以下载 https://files.cnblogs.com/zzzl/delegate.rar