This approach works theoretically, and good changes will work in practice there, but there are a few things that may prevent you from getting TRttiMethod .
- The
TMethod says Data: Pointer , not TObject . This means that it may be possible to have something else, and then TObject as Data ! This is a serious problem because if Data not a TObject , then trying to extract RTTI from it will result in runtime errors. - Not all methods have RTTI. By default, methods in the private area do not have RTTI, and you can use
{$RTTI} to stop generating RTTI for public or published members.
These two questions will not be a problem for the usual type of event implementations that we have in Delphi (double-click the event name in the Object Inspector and fill in the code), but again I don’t think you are talking about the implementation of “vanilla”. Not many people decorate default event handlers with attributes!
Code demonstrating all of the above:
program Project15; {$APPTYPE CONSOLE} uses SysUtils, RTTI; type // Closure/Event type TEventType = procedure of object; // An object that has a method compatible with the declaration above TImplementation = class private procedure PrivateImplementation; public procedure HasRtti; procedure GetPrivateImpEvent(out Ev:TEventType); end; TRecord = record procedure RecordProc; end; // an object that has a compatible method but provides no RTTI {$RTTI EXPLICIT METHODS([])} TNoRttiImplementation = class public procedure NoRttiAvailable; end; procedure TImplementation.GetPrivateImpEvent(out Ev:TEventType); begin Ev := PrivateImplementation; end; procedure TImplementation.HasRtti; begin WriteLn('HasRtti'); end; procedure TNoRttiImplementation.NoRttiAvailable; begin WriteLn('No RTTI Available'); end; procedure TRecord.RecordProc; begin WriteLn('This is written from TRecord.RecordProc'); end; procedure TImplementation.PrivateImplementation; begin WriteLn('PrivateImplementation'); end; procedure TotalyFakeImplementation(Instance:Pointer); begin WriteLn('Totaly fake implementation, TMethod.Data is nil'); end; procedure SomethingAboutMethod(X: TEventType); var Ctx: TRttiContext; Typ: TRttiType; Method: TRttiMethod; Found: Boolean; begin WriteLn('Invoke the method to prove it works:'); X; // Try extract information about the event Ctx := TRttiContext.Create; try Typ := Ctx.GetType(TObject(TMethod(X).Data).ClassType); Found := False; for Method in Typ.GetMethods do if Method.CodeAddress = TMethod(X).Code then begin // Got the Method! WriteLn('Found method: ' + Typ.Name + '.' + Method.Name); Found := True; end; if not Found then WriteLn('Method not found.'); finally Ctx.Free; end; end; var Ev: TEventType; R: TRecord; begin try try WriteLn('First test, using a method that has RTTI available:'); SomethingAboutMethod(TImplementation.Create.HasRtti); WriteLn; WriteLn('Second test, using a method that has NO rtti available:'); SomethingAboutMethod(TNoRttiImplementation.Create.NoRttiAvailable); WriteLn; WriteLn('Third test, private method, default settings:'); TImplementation.Create.GetPrivateImpEvent(Ev); SomethingAboutMethod(Ev); WriteLn; WriteLn('Assign event handler using handler from a record'); try SomethingAboutMethod(R.RecordProc); except on E:Exception do WriteLn(E.Message); end; WriteLn; WriteLn('Assign event handler using static procedure'); try TMethod(Ev).Data := nil; TMethod(Ev).Code := @TotalyFakeImplementation; SomethingAboutMethod(Ev); except on E:Exception do WriteLn(E.Message); end; WriteLn; except on E: Exception do Writeln(E.ClassName, ': ', E.Message); end; finally ReadLn; end; end.