如何使用 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(...)是一种匿名方法类型。 在后台，它被实现为一个接口对象(即，实现IInterface接口的类)，具有与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一起使用相同。

Answer 2

好问题！

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

为了说明这一点，创建一个新的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;