如何使用 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
相同。
我有一个 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
相同。