如何使用RTTI将事件处理程序分配给事件属性？

问题描述

我有一个包含一些事件属性的类，另一个包含事件处理程序的类。在编译时，我不知道任何一个类的结构，在运行时，我仅使用它们的名称来了解事件属性和事件处理程序之间的匹配。我想使用RTTI将事件处理程序分配给相应的事件属性，该怎么办？

我目前有这样的东西：

type
  TMyEvent = reference to procedure(const AInput: TArray<string>; out AOutput: TArray<string>);
  TMyBeforeEvent = reference to procedure(const AInput: TArray<string>; out AOutput: TArray<string>; out ACanContinue: boolean);

  TMyClass = class
  private
    FOnBeforeEvent: TMyBeforeEvent;
    FOnEvent: TMyEvent;
  public
    property OnBeforeEvent: TMyBeforeEvent read FOnBeforeEvent write FOnBeforeEvent;
    property OnEvent: TMyEvent read FOnEvent write FOnEvent;
  end;

  TMyEventHandler = class
  public
    procedure dobeforeEvent(const AInput: TArray<string>; out AOutput: TArray<string>; out ACanContinue: boolean);
    procedure DoEvent(const AInput: TArray<string>; out AOutput: TArray<string>);
  end;

  procedure AssignEvent;

implementation

uses
  Vcl.Dialogs,System.RTTI;

{ TMyEventHandler }

procedure TMyEventHandler.dobeforeEvent(const AInput: TArray<string>;
  out AOutput: TArray<string>; out ACanContinue: boolean);
begin
  // do something...
end;

procedure TMyEventHandler.DoEvent(const AInput: TArray<string>;
  out AOutput: TArray<string>);
begin
  // do something...
end;

procedure AssignEvent;
var
  LObj: TMyClass;
  LEventHandlerObj: TMyEventHandler;
  LContextObj,LContextHandler: TRttiContext;
  LTypeObj,LTypeHandler: TRttiType;
  LEventProp: TRttiProperty;
  LMethod: TRttiMethod;
  LNewEvent: TValue;
begin
  LObj := TMyClass.Create;
  LEventHandlerObj := TMyEventHandler.Create;

  LContextObj := TRttiContext.Create;
  LTypeObj := LContextObj.GetType(LObj.Classtype);
  LEventProp := LTypeObj.GetProperty('OnBeforeEvent');

  LContextHandler := TRttiContext.Create;
  LTypeHandler := LContextHandler.GetType(LEventHandlerObj.Classtype);
  LMethod := LTypeHandler.getmethod('dobeforeEvent');

  LEventProp.SetValue(LObj,LNewEvent {--> what value should LNewEvent have?});
end;

解决方法

reference to procedure(...)是匿名方法类型。在幕后，它通过与IInterface的参数匹配的Invoke()方法实现为接口对象（即实现procedure接口的类）。

例如，由于TMyEventHandler.DoBeforeEvent()与该条件不匹配，因此不能将TMyClass.OnBeforeEvent 直接与TMyEventHandler一起使用。但是，您可以将对DoBeforeEvent()的调用包装在实际的匿名过程中，例如：

procedure AssignEvent;
var
  LObj: TMyClass;
  LEventHandlerObj: TMyEventHandler;
  LEventHandler: TMyBeforeEvent;
  LContextObj: TRttiContext;
  LMethod: TRttiMethod;
  LEventProp: TRttiProperty;
begin
  LObj := TMyClass.Create;
  LEventHandlerObj := TMyEventHandler.Create;

  LContextObj := TRttiContext.Create;
  LMethod := LContextObj.GetType(LEventHandlerObj.ClassType).GetMethod('DoBeforeEvent');

  LEventHandler := procedure(const AInput: TArray<string>; out AOutput: TArray<string>; out ACanContinue: boolean);
  begin
    // Note: I don't know if/how TRttiMethod.Invoke() can handle
    // 'out' parameters,so this MAY require further tweaking...
    LMethod.Invoke(LEventHandlerObj,[AInput,AOutput,ACanContinue]);
  end;

  LEventProp := LContextObj.GetType(LObj.ClassType).GetProperty('OnBeforeEvent');
  LEventProp.SetValue(LObj,TValue.From(LEventHandler));
end;

与将TMyEventHandler.DoEvent()与TMyClass.OnEvent一起使用。

---

或者，如果将reference to procedure(...)更改为procedure(...) of object，则可以使用TMethod记录将TMyEventHandler.DoBeforeEvent() 直接分配给{ {1}}，例如：

TMyClass.OnBeforeEvent

与将procedure AssignEvent; var LObj: TMyClass; LEventHandlerObj: TMyEventHandler; LEventHandler: TMyBeforeEvent; LContextObj: TRttiContext; LEventProp: TRttiProperty; LMethod: TRttiMethod; begin LObj := TMyClass.Create; LEventHandlerObj := TMyEventHandler.Create; LContextObj := TRttiContext.Create; LEventProp := LContextObj.GetType(LObj.ClassType).GetProperty('OnBeforeEvent'); LMethod := LContextObj.GetType(LEventHandlerObj.ClassType).GetMethod('DoBeforeEvent'); with TMethod(LEventHandler) do begin Code := LMethod.CodeAddress; Data := LEventHandlerObj; end; LEventProp.SetValue(LObj,TValue.From(LEventHandler)); end; 与TMyEventHandler.DoEvent()一起使用。

,

好问题！

我相信我找到了一种合理的方法。

为说明起见，请创建一个新的VCL应用程序，该应用程序具有一个窗体（Form1）和一个按钮（Button1）。给表单一个OnClick处理程序：

procedure TForm1.FormClick(Sender: TObject);
begin
  ShowMessage(Self.Caption);
end;

我们将尝试仅使用RTTI以及属性和方法名称（作为字符串）将此处理程序分配给按钮的OnClick属性。

要记住的关键是方法指针是一对（代码指针，对象指针），特别是TMethod记录：

procedure TForm1.FormCreate(Sender: TObject);
var
  C: TRttiContext;
  b,f: TRttiType;
  m: TRttiMethod;
  bp: TRttiProperty;
  handler: TMethod;
begin

  C := TRttiContext.Create;

  f := C.GetType(TForm1);
  m := f.GetMethod('FormClick');

  b := C.GetType(TButton);
  bp := b.GetProperty('OnClick');

  handler.Code := m.CodeAddress;
  handler.Data := Form1;

  bp.SetValue(Button1,TValue.From<TNotifyEvent>(TNotifyEvent(handler)));

end;