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

How to assign event handler to event property using RTTI?

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

问得好!

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

为了说明它,创建一个新的 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;

一个reference to procedure(...)是一个匿名方法类型。在引擎盖下,它被实现为一个接口对象(即实现 IInterface 接口的 class),具有与 procedure 的参数匹配的 Invoke() 方法。

因此,不能将 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 相同。