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

Question

我有一个具有一些事件属性的类，以及另一个包含事件处理程序的类。在编译时我不知道这两个类的结构，在运行时我只知道事件属性和事件处理程序之间的匹配使用它们的名称。使用 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;

Answer 1

一个 reference to procedure(...)是一种匿名方法类型。在底层，它被实现为一个接口(interface)对象(即，实现 IInterface 接口(interface)的类)，带有 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()直接到 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() 相同与 TMyClass.OnEvent .