在Delphi中实现multi-delegate
不知从什么时候开始，如果在文章标题中只提及一个技术术语，一般就默认表示它是用在.net中的技术了。所以我不得不在标题上加一个Delphi 字样。
先为用Delphi 的朋友简单介绍下delegate，如果你用过c# 什么的，就可以跳过这部分了。delegate 就象个封装了函数指针的对象，用delegate 对象“指向”一个函数，或事件句柄，然后在程序的其它地方调用它。虽然这种用法不很直观，也一时难以想到什么情况下需要这样干，但这种方法看起来很灵活。
更进一步，如果一个delegate 对象能够“指向”多个函数，然后在调用时，可以一次性调用所有它所指向的函数，就可以更灵活了。
这有点类似于观察者模式，一个被观察者，可以被多个观察者收听，当被观察者需要告诉观察者一些事情时，所有的观察者都会收到。例如，在一个model 和view 分离的程序中，多个view 或controller 都可以收听model 的同一个事件，这就是multi-delegate 了
我主要的工作是增加了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;
以上全部代码在这里可以下载
/2
补充：软件开发 , Delphi ,
