FormularArray den richtigen Create aufrufen! Wie?

[himitsu]

Auf den Namen solltest du besser nicht prüfen, sondern besser auf den Klassentyp. (Namen sind nicht eindeutig)

Aber damit prüfst du nur, ob die Methode in dieser Klasse implementiert wurde, was aber auch auf die abstrakte Methode zutreffen würde, wenn sie direkt in dieser Klasse drin steht.

[himitsu]

Es scheint in der RTTI keine Markierung/Info für "abstract" zu geben.

Delphi-Quellcode:

function MethodIsImplemented_Mavarik(const AClass: TClass; const MethodName: string): Boolean;
var
  M: TRttiMethod;
begin
  M := TRttiContext.Create.GetType(AClass.ClassInfo).GetMethod(MethodName);
  //Result := Assigned(M) and SameText(AClass.ClassName, M.Parent.Name);
  Result := Assigned(M) and (AClass.ClassInfo = M.Parent.Handle);
end;

var
  AbstractAddress: Pointer;  // global, da einmal Suchen ja ausreichend ist

function MethodIsImplemented(const AClass: TClass; const MethodName: string): Boolean; overload;
type
  TVtable = array[0..MaxInt div 4 - 1] of Pointer;
  PVtable = ^TVtable;
var
  M: TRttiMethod;
begin
  if not Assigned(AbstractAddress) then
    //AbstractAddress := TRttiContext.Create.GetType(TStream.ClassInfo).GetMethod('Read').CodeAddress;
    AbstractAddress := PVtable(TStream)^[TRttiContext.Create.GetType(TStream.ClassInfo).GetMethod('Read').VirtualIndex];

  M := TRttiContext.Create.GetType(AClass.ClassInfo).GetMethod(MethodName);
  //Result := Assigned(M) and ((M.DispatchKind <> dkVtable) or (M.CodeAddress <> AbstractAddress));
  Result := Assigned(M) and ((M.DispatchKind <> dkVtable) or (PVtable(AClass)^[M.VirtualIndex] <> AbstractAddress));
end;

function MethodIsImplemented(const AObject: TObject; const MethodName: string): Boolean; overload;
begin
  Result := Assigned(AObject) and MethodIsImplemented(AObject.ClassType, MethodName);
end;

type
  TStringTest = class(TStringList)
  end;

procedure Test;
begin
  if MethodIsImplemented(TStringList, 'Free') then
    Beep;
  if MethodIsImplemented_Mavarik(TStringList, 'Free') then
    Beep;  // Falsch - ist schon komplett in TObject implementiert

  if MethodIsImplemented(TStringList, 'Clear') then
    Beep;
  if MethodIsImplemented_Mavarik(TStringList, 'Clear') then
    Beep;

  if MethodIsImplemented(TStrings, 'Clear') then
    Beep;
  if MethodIsImplemented_Mavarik(TStrings, 'Clear') then
    Beep;  // Falsch - ja, Clear ist genau hier implementiert, aber das ist leider die abstrakte Methode

  if MethodIsImplemented(TStringTest, 'Clear') then
    Beep;
  if MethodIsImplemented_Mavarik(TStringTest, 'Clear') then
    Beep;  // Falsch - siehe "Free", denn auch hier ist es schon TStringList implementiert und korrect überschrieben
end;

als class function IsMethodImplemented(const MethodName: string): Boolean; läßt sich das bestimmt auch schön in einem Klass-Helper unterbringen.