[RTTI] RttiProperty aus Property von Instanz erzeugen

[s.h.a.r.k]

Ich habe nun eine Lösung, die über die Setter-Methode einer Property läuft. Diese Idee funktioniert allerdings nur unter der Voraussetzung, dass jede Property eine eindeutige und einzigartige Setter-Methode hat, denn wenn für mehrere Properties ein und die selbe Setter-Methode verwendet wird (was ja unter Umständen der Fall sein kann), so wäre dies keine eindeutige Abbildung und so käme auch keine korrekt Lösung heraus.

Delphi-Quellcode:

// Prozeduraler Typ für Parameter
TMyProc = procedure (const Value: Variant) of object;

// Test-Klasse ;)
TTestObject = class(TObject)
private
  FPropA : String;
  FPropB : String;
  function GetPropA(): String;
  procedure SetPropA(const Value: String);
  function GetPropB(): String;
  procedure SetPropB(const Value: String);
public
  property PropA : Stringread GetPropA write SetPropA;
  property PropB : Stringread GetPropB write SetPropB;
  function GetRttiPropertyBySetter(const AMethod: TMyProc): TRttiProperty;
end;

implementation

{ TTestObject }

function TTestObject.GetPropA(): String;
begin
  Result := FPropA;
end;

procedure TTestObject.SetPropA(const Value: String);
var
  pt : Pointer;
begin
  { ... }
end;

function TTestObject.GetPropB(): String;
begin
  Result := FPropA;
end;

procedure TTestObject.SetPropB(const Value: String);
begin
  { ... }
end;

function TTestObject.GetRttiPropertyBySetter(const AMethod: TMyProc): TRttiProperty;
var
  pt : Pointer;
  rContext : TRttiContext;
  rType : TRttiType;
  rProperty : TRttiProperty;
  rPropInfo : PPropInfo;
begin
  Result := nil;

  // Pointer auf Setter-Methode holen
  pt := @AMethod;

  rContext := TRttiContext.Create();
  try
    rType := rContext.GetType(Self.ClassType);

    // Property für Property durchgehen, bis eine gefunden wurde
    // die eine passende Setter-Methode (Erkennung via Pointer) hat.
    for rProperty in rType.GetDeclaredProperties do
    begin
      rPropInfo := TRttiInstanceProperty(rProperty).PropInfo;
      if (rPropInfo.SetProc = pt) then
      begin
        Result := rProperty;
        exit;
      end;
    end;
  finally
    rContext.Free();
  end;
end;

Vielleicht hilft das ja mal jemandem. Sinnvoll ist diese Methode im Moment nur, wenn diese intern (private) verwendet wird, oder man setzt die Setter-Methoden public, sodass man darauf auch von außen zugreifen kann.