行使RTTI达成Delphi的多播事件代理商量

2019-09-23 作者:yzc216.com官网   |   浏览(141)

我们知道Delphi的每个对象可以包含多个Property,Property中可以是方法,例如TButton.OnClick属性。Delphi提供的仅仅是

一对一的设置,无法直接让TButton.OnClick去调用多个方法,而Java中采用Listener模式有类似AddListener方法提供多播。

Delphi多播的思想源于Allen Bauer的Blog:

cnWizard的武稀松大侠在此思想基础上实现了Win32的Delphi多播机制见:;

开源项目DSharp实现了更加完整的多播机制,可提供基于接口的多播,见:

本人希望借鉴前人的基础上,实现一个对象的事件多播代理,即TEventAgent是一个TObject的事件多播代理器,将一个TObject传给TEventAgent后, TEventAgent扫描TObject所有事件,并为每个事件提供多播功能。

下面程序是一个简单示例,引用了 DSharp.Core.Events.pas单元,并在Delphi XE3 测试成功.

  1 unit utObjEventAgent;  2   3 interface  4   5 uses System.Generics.Collections, DSharp.Core.Events, System.TypInfo, Classes;  6   7 type  8   TEventLinker=class(DSharp.Core.Events.TEvent)     //单个事件的多播器  9   protected 10     FLinkedObject: TObject; 11     FLinkedProperty: PPropInfo; 12     FOriginal:TMethod; 13  14     FEventTypeData:PTypeData; 15     FEventName:String; 16     procedure MethodAdded(const Method: TMethod); override; 17     procedure MethodRemoved(const Method: TMethod); override; 18     procedure Notify(Sender: TObject; const Item: TMethod; 19       Action: System.Generics.Collections.TCollectionNotification); override; 20     property Owner; 21     property RefCount; 22   public 23     constructor Create(LinkedObj:TObject; LinkedPrpt:PPropInfo); 24     destructor Destroy; override; 25   end; 26  27   TEventAgent=class                 //对象的事件多播代理 28     protected 29       FOwner:TObject; 30       FPropList: PPropList; 31       FNameList:TDictionary<String, TEventLinker>; 32       procedure Prepare; virtual; 33       procedure Clear; 34     public 35       constructor Create(aOwner:TObject); virtual; 36       destructor Destroy;override; 37       function GetEventCount: Int32; 38       function GetEventName(Index: Int32): PWideChar; 39       procedure AddEventNotifier(EventName: String; const NotifierMethod: TMethod);overload;    // 添加事件处理函数 40       procedure RemoveEventNotifier(EventName: String; const NotifierMethod: TMethod);overload; // 移除时间处理函数 41   end; 42  43 implementation 44  45 uses System.Rtti; 46  47 { TEventLinker } 48  49 constructor TEventLinker.Create(LinkedObj:TObject; LinkedPrpt:PPropInfo); 50 begin 51   inherited Create(LinkedPrpt.PropType^, nil); 52   FLinkedObject:=LinkedObj; 53   FLinkedProperty:=LinkedPrpt; 54   FEventName:=FLinkedProperty^.Name; 55   FOriginal:=GetMethodProp(FLinkedObject, FLinkedProperty); 56   SetMethodProp(FLinkedObject, FLinkedProperty, Self.GetInvoke); 57   if Assigned(FOriginal.Data) and Assigned(FOriginal.Code) then Add(FOriginal);  //将原事件方法加入多播列表 58 end; 59  60 destructor TEventLinker.Destroy; 61 begin 62   SetMethodProp(FLinkedObject, FLinkedProperty, FOriginal); 63   inherited; 64 end; 65  66 procedure TEventLinker.MethodAdded(const Method: TMethod); 67 begin 68 end; 69  70 procedure TEventLinker.MethodRemoved(const Method: TMethod); 71 begin 72 end; 73  74 procedure TEventLinker.Notify(Sender: TObject; const Item: TMethod; 75   Action: System.Generics.Collections.TCollectionNotification); 76 begin 77 end; 78  79 { TEventAgent } 80  81 procedure TEventAgent.AddEventNotifier(EventName: String; 82   const NotifierMethod: TMethod); 83 var 84   V:TEventLinker; 85 begin 86   if FNameList.TryGetValue(EventName, V) then 87   begin 88     if V.IndexOf(NotifierMethod)<0 then 89       V.Add(NotifierMethod); 90   end; 91 end; 92  93 procedure TEventAgent.Clear; 94   var 95     Item: TPair<String, TEventLinker>; 96   begin 97     for Item in FNameList do 98       Item.Value.Free; 99     FNameList.Clear;100     if Assigned(FPropList) then FreeMem(FPropList);101   end;102 103 constructor TEventAgent.Create(aOwner:TObject);104 begin105   inherited Create;106   FNameList:=TDictionary<String, TEventLinker>.Create;107   FOwner:=aOwner;108   Prepare;109 end;110 111 destructor TEventAgent.Destroy;112 begin113   Clear;114   FNameList.Free;115   inherited;116 end;117 118 function TEventAgent.GetEventCount: Int32;119 begin120   Result:=FNameList.Count;121 end;122 123 function TEventAgent.GetEventName(Index: Int32): PWideChar;124 begin125   Result:=PWideChar(FNameList.Keys.ToArray[Index]);126 end;127 128 procedure TEventAgent.Prepare;129 var130   N, i:Integer;131   Linker:TEventLinker;132   Context: TRttiContext;133 begin134   Clear;135   N:=GetPropList(FOwner.ClassInfo, FPropList);136   for i := 0 to N-1 do137     if FPropList^[i].PropType^.Kind = tkMethod then138   begin139     if FPropList[i].GetProc=nil then Continue;140     Linker:=TEventLinker.Create(FOwner, FPropList[i]);141     Linker.FEventName:=FPropList[i].Name;142     FNameList.Add(Linker.FEventName, Linker);143   end;144 end;145 146 147 procedure TEventAgent.RemoveEventNotifier(EventName: String;148   const NotifierMethod: TMethod);149 var150   V:TEventLinker;151 begin152   if FNameList.TryGetValue(EventName, V) then153   begin154     V.Remove(NotifierMethod);155   end;156 end;157 158 end.

测试程序演示一个TButton被事件多播代理,其OnClick,OnMouseDown均有3个多播方法。
测试程序:

 1 unit Unit1; 2  3 interface 4  5 uses 6   Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, 7   Vcl.Controls, Vcl.Forms, Vcl.Dialogs, utObjEventAgent, DSharp.Core.Events, ObjAuto, 8   Vcl.StdCtrls; 9 10 type11   TForm1 = class12     Button1: TButton;13     Memo1: TMemo;14     procedure FormCreate(Sender: TObject);15     procedure Button1Click(Sender: TObject);16     procedure Button1MouseDown(Sender: TObject; Button: TMouseButton;17       Shift: TShiftState; X, Y: Integer);18   private19     { Private declarations }20     procedure OnClick1(Sender:TObject);21     procedure OnClick2(Sender:TObject);22     procedure Button1MouseDown1(Sender: TObject; Button: TMouseButton;23       Shift: TShiftState; X, Y: Integer);24     procedure Button1MouseDown2(Sender: TObject; Button: TMouseButton;25       Shift: TShiftState; X, Y: Integer);26   public27     { Public declarations }28     FAgent:TEventAgent;29   end;30 31 var32   Form1: TForm1;33 34 implementation35 36 uses System.Rtti;37 38 {$R *.dfm}39 40 procedure TForm1.Button1Click(Sender: TObject);41 begin42   Memo1.Lines.Add('Button1Click');43 end;44 45 procedure TForm1.Button1MouseDown(Sender: TObject; Button: TMouseButton;46   Shift: TShiftState; X, Y: Integer);47 begin48   Memo1.Lines.Add(Format('Clicked at ', [X, Y]));49 end;50 51 procedure TForm1.Button1MouseDown1(Sender: TObject; Button: TMouseButton;52   Shift: TShiftState; X, Y: Integer);53 begin54   Memo1.Lines.Add('Button1MouseDown1')55 end;56 57 procedure TForm1.Button1MouseDown2(Sender: TObject; Button: TMouseButton;58   Shift: TShiftState; X, Y: Integer);59 begin60   Memo1.Lines.Add('Button1MouseDown2')61 end;62 63 procedure TForm1.FormCreate(Sender: TObject);64 var65   V:TNotifyEvent;66   M:TMouseEvent;67 begin68   FAgent:=TEventAgent.Create;69   V:= Self.OnClick1;70   FAgent.AddEventNotifier('OnClick', TMethod;71   V:= Self.OnClick2;72   FAgent.AddEventNotifier('OnClick', TMethod;73   M:= Self.Button1MouseDown1;74   FAgent.AddEventNotifier('OnMouseDown', TMethod;75   M:= Self.Button1MouseDown2;76   FAgent.AddEventNotifier('OnMouseDown', TMethod;77 end;78 79 procedure TForm1.OnClick1(Sender: TObject);80 begin81   Memo1.Lines.Add('OnClick1');82 end;83 84 procedure TForm1.OnClick2(Sender: TObject);85 begin86   Memo1.Lines.Add('OnClick2');87 end;88 89 end.

测试程序dfm文件

 1 object Form1: TForm1 2   Left = 0 3   Top = 0 4   Caption = 'Form1' 5   ClientHeight = 311 6   ClientWidth = 643 7   OnCreate = FormCreate 8   object Button1: TButton 9     Left = 8810     Top = 5611     Width = 7512     Height = 2513     Caption = 'Button1'14     OnClick = Button1Click15     OnMouseDown = Button1MouseDown16   end17   object Memo1: TMemo18     Left = 26419     Top = 3220     Width = 32921     Height = 22522     Lines.Strings = (23       'Memo1')24   end25 end

我的多播代理机制原理是,将所代理对象的所有事件指向代理器对应的函数,由此函数再以此调用多个回调函数。
1.当所代理事件没有任何事件回调时,多播代理不会修改事件函数指针,原对象此事件回调仍然为nil,
2.当所代理事件已经有事件回调函数指针,多播代理会将自己替换原函数指针,并且将原函数指针加入多播列表中.

我的多播机制有如下特点:
1.兼容Delphi的事件回调机制,因此对于老的程序,不用怎么修改,就能被回调多个函数,实现多播。
2.此多播机制不限于界面对象,可代理任何对象,只要此对象有放入public或published的事件property属性,均被自动代理,无所谓其传入的参数是什么类型及有多少个。
3.用户的对象如果需要多播功能,仅需要按照单个事件模式设计即可,多播代理自动帮他实现多播。

再举例1:
比如我们网络通讯假设用的是TTcpClient,从服务器接收数据。接收来的数据进行处理,处理过程有很多,比如有的模块需要存盘到文件,有的处理模块进行数据转发,有的模块需要进行解码分析。
如果使用多播,则可以简单的方法实现。

假如原来的网络程序仅实现了数据存储功能,需要增加解码处理功能,我们不需要修改原来的程序,增加解码模块即可:

1.新建一个DataModule, 放上一个TTcpClient,设置要连接的服务器端口地址

unit Unit2;interfaceuses  System.SysUtils, System.Classes, Web.Win.Sockets, utObjEventAgent;type  TDataModule2 = class(TDataModule)    TcpClient1: TTcpClient;    procedure DataModuleCreate(Sender: TObject);       procedure DataModuleDestroy(Sender: TObject);   private    { Private declarations }  public    { Public declarations }    FLink:TEventAgent;  end;var  DataModule2: TDataModule2;implementation{%CLASSGROUP 'Vcl.Controls.TControl'}{$R *.dfm}procedure TDataModule2.DataModuleCreate(Sender: TObject);begin  FLink:=TEventAgent.Create(TcpClient1);  TcpClient1.Active:=True;end;procedure TDataModule2.DataModuleDestroy(Sender: TObject);begin    FLink.Free;end;end.

  

2.接着,只需在不同的模块去接收你的数据,例如数据存储模块:

unit Unit3;interfaceuses utObjEventAgent, Unit2, Classes, Web.Win.Sockets;type  TPersistModule=class  protected    FStream:TFileStream;  private    procedure OnDataReceive(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);  public    constructor Create;    destructor Destroy;override;  end;implementation{ TPersistModule }constructor TPersistModule.Create;var   V:TSocketDataEvent;begin  inherited Create;  FStream:=TFileStream.Create('C:test.dat', fmCreate);  V:= Self.OnDataReceive;  DataModule2.FLink.AddEventNotifier('OnReceive', TMethod;end;destructor TPersistModule.Destroy;var   V:TSocketDataEvent;begin  V:= Self.OnDataReceive;  DataModule2.FLink.RemoveEventNotifier('OnReceive', TMethod;  FStream.Free;  inherited;end;procedure TPersistModule.OnDataReceive(Sender: TObject; Buf: PAnsiChar;  var DataLen: Integer);begin  FStream.Write(Buf^, DataLen);end;end.

  

3.数据解码模块

unit Unit4;interfaceuses utObjEventAgent, Unit2, Classes, Web.Win.Sockets, utDecoder;type  TDecodeModule=class  protected    FDecoder:TDecoder;  private    procedure OnData(Sender: TObject; Buf: PAnsiChar; var DataLen: Integer);  public    constructor Create;    destructor Destroy;override;  end;implementation{ TDecodeModule }constructor TDecodeModule.Create;var  V:TSocketDataEvent;begin  inherited Create;  FDecoder:=TDecoder.Create  V:= Self.OnData;  DataModule2.FLink.AddEventNotifier('OnReceive', TMethod;end;destructor TDecodeModule.Destroy;var  V:TSocketDataEvent;begin  V:= Self.OnData;  DataModule2.FLink.RemoveEventNotifier('OnReceive', TMethod;  Fdecoder.Free;  inherited;end;procedure TDecodeModule.OnData(Sender: TObject; Buf: PAnsiChar;  var DataLen: Integer);begin  FDecoder.Decode(Pointer, DataLen);end;end.

  

再举例2:

借用 “Delphi 实现事件侦听与触发”的例子:

const  evtDataChanged = 'evtDataChanged';  //数据处理类, 用于提供数据  TOnData=procedure( Name, City, CellPhone:String; Age: Integer ) of Object;  TNwDataClass = class  private   FOnData:TOnData;  public    Link:TEventAgent;    constructor Create;    destructor Destroy;override;    procedure AddData( Name, City, CellPhone:String; Age: Integer );   property OnData:TOnData read FOnData write FOnData;  end;  //界面显示类  TNwInterface = class    procedure FormCreate( Sender: TObject );          procedure FormDestroy( Sender: TObject );    protected    procedure OnEvent( Name, City, CellPhone:String; Age: Integer );    procedure OnEvent2( Name, City, CellPhone:String; Age: Integer );  public    procedure AddDataToList(  Name, City, CellPhone:String; Age: Integer);    procedure AddDataToFile( Name, City, CellPhone:String; Age: Integer );  end;  // TNwDataClass 应该有一个全局的实例, 用于提供数据. 在下面的代码中, 就以  // instanceDataClass 为这个实例implementation  { TNwDataClass  }constructor TNwDataClass.Create;begin inherited Create;  Link:=TEventAgent.Create;end;destructor TNwDataClass.Destroy;begin  Link.Free;  inherited;end; procedure TNwDataClass.AddData( Name, City, CellPhone:String; Age: Integer ); begin   //数据处理代码,忽视Link的存在  if Assigned then FOnData(Name, City, CellPhone, Age); end;  { TNwInterface }  procedure TNwInterface.FormCreate( Sender: TObject );  var  V:TOnData;  begin    V:= Self.OnEvent;    instanceDataClass.Link.AddEventNotifier('OnData', TMethod;   V:= Self.OnEvent2;    instanceDataClass.Link.AddEventNotifier('OnData', TMethod;   end;    procedure TNwInterface.FormDestroy( Sender: TObject );    var  V:TOnData;    begin        V:= Self.OnEvent;        instanceDataClass.Link.RemoveEventNotifier('OnData', TMethod;       V:= Self.OnEvent2;        instanceDataClass.Link.RemoveEventNotifier('OnData', TMethod;     end;    procedure TNwInterface.OnEvent( Name, City, CellPhone:String; Age: Integer );  begin    AddDataToList( Name, City, CellPhone, Age);  end;  procedure TNwInterface.OnEvent2( Name, City, CellPhone:String; Age: Integer );  begin    AddDataToFile( Name, City, CellPhone, Age);  end;  procedure TNwInterface.AddDataToList( Name, City, CellPhone:String; Age: Integer );  begin    //用于处理显示数据的代码.  end;  procedure TNwInterface.AddDataToFile( Name, City, CellPhone:String; Age: Integer );  begin    //用于保存数据的代码.  end;

  

本文由yzc216亚洲城发布于yzc216.com官网,转载请注明出处:行使RTTI达成Delphi的多播事件代理商量

关键词: yzc216亚洲城 yzc216.com官网