灯火互联
管理员
管理员
  • 注册日期2011-07-27
  • 发帖数41778
  • QQ
  • 火币41290枚
  • 粉丝1086
  • 关注100
  • 终身成就奖
  • 最爱沙发
  • 忠实会员
  • 灌水天才奖
  • 贴图大师奖
  • 原创先锋奖
  • 特殊贡献奖
  • 宣传大使奖
  • 优秀斑竹奖
  • 社区明星
阅读:3597回复:0

在Delphi中实现multi-delegate

楼主#
更多 发布于:2012-09-08 13:04

不知从什么时候开始,如果在文章标题中只提及一个技术术语,一般就默认表示它是用在.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;


喜欢0 评分0
游客

返回顶部