Question

我有一个TChildClass派生的子类TBaseClass。 TBaseClass具有function foo: string;必须始终实现的方法TChildClass！

IMyInterface = Interface(IInterface)
    function foo: string;
end;

TBaseClass = class(TInterfacedObject, IMyInterface)
  public
    function foo: string;
end;

TChildClass = class(TBaseClass , IMyInterface)
  public
    function foo: string;
end;

我希望TChildClass始终实现function foo并调用从TBaseClass继承的呼叫：

function TBaseClass.foo: string
begin
    Result := 'Hello';
end;

function TChildClass.foo: string
begin
    Result := inherited;

    Result := Result + ' world!';
end;

如何制作？

Answer 1

您不能强制在编译时要求覆盖。

为了使TChildClass覆盖foo()，需要在foo()中将virtual声明为TBaseClass（但不能abstract声明为{因为您希望TBaseClass.foo()具有默认实现，否则编译器会抱怨！）。而且，与C ++不同，Delphi不会要求被覆盖的抽象方法，并且它允许代码在运行时创建抽象类的实例（即使调用具有未被覆盖会导致运行时错误。

但是，您可以在运行时验证，TBaseClass.foo()是否已在子孙中被覆盖，例如：

type
  IMyInterface = Interface(IInterface)
    function foo: string;
  end;

  TBaseClass = class(TInterfacedObject, IMyInterface)
  public
    function foo: string; virtual;
  end;

  TChildClass = class(TBaseClass, IMyInterface)
  public
    function foo: string; override;
  end;

function TBaseClass.foo: string;
type
  TFoo = function: string of object;
var
  Impl, Base: TFoo;
  ClassTBase: TClass;
begin
  Impl := foo;
  ClassTBase := TBaseClass;
  Base := TBaseClass(@ClassTBase).foo;
  if TMethod(Impl).Code = TMethod(Base).Code then
    raise Exception.CreateFmt('foo() not implemented in class ''%s''', [ClassName]);
  Result := 'Hello';
end;

function TChildClass.foo: string;
begin
  Result := inherited foo;
  Result := Result + ' world!';
end;

但是，您无法执行强制 TChildClass.foo()呼叫inherited，这完全取决于TChildClass自行决定。< / p>

Answer 2

您本身不能。但是，您可以通过稍微不同的方式实现您想要的。

type
IMyInterface = Interface(IInterface)
    function foo: string;
end;

TBaseClass = class(TInterfacedObject, IMyInterface)
  protected
    function fooForced : string; virtual; abstract;
  public
    function foo: string;
end;

TChildClass = class(TBaseClass , IMyInterface)
  protected
    function fooForced: string; override;
end;

function TBaseClass.foo: string;
begin
    Result := 'Hello' + FooForced;
end;

function TChildClass.fooForced: string;
begin
    Result := ' world!';
end;

注意-您必须注意“正在创建抽象类”警告！

Answer 3

我认为以一种或另一种方式使用abstract方法可能是最干净的方法。就像已经提到的Dsm一样，您无法完全获得，因为抽象方法没有实现，因此您不能在基类中调用该方法。

这个替代方案非常接近，但是它需要深入研究RTTI。对于您而言，是否值得取决于您。基本上可以做什么：深入研究类的方法列表。对于具有给定名称的方法，请检查其实现者的类名是什么。如果是TBaseClass，则抛出异常，否则继续。

我非常确定，如果您实现方法foo的重载，他将失败，因此它不是防水的。也许有一些方法可以检查找到的方法是否确实是替代方法，但是TRttiMethod似乎并没有提供任何可用的方法。

该代码示例的灵感来自RRUZ's answer, here。

TBaseClass = class(TInterfacedObject, IMyInterface)
  private
    procedure ValidateDescendantImplements(MethodName: string);
  public
    function foo: string;
end;

function TBaseClass.foo: string;
begin
    ValidateDescendantImplements('foo');

    Result := 'Hello';
end;

procedure TBaseClass.ValidateDescendantImplements(MethodName: string);
var
  m: TRttiMethod;
begin
  for m in TRttiContext.Create.GetType(Self.ClassType).GetDeclaredMethods do
  begin
   if SameText(m.Name, MethodName) then
     if m.Parent.Name <> TBaseClass.ClassName then
       Exit
  end;
  raise Exception.CreateFmt('%s needs to be overridden', [MethodName]);
end;

用法：

TChildClass.Create.foo; // Works
TBaseClass.Create.foo; // Throws exception

Delphi OOP强制从继承的类重新实现方法

3 个答案: