代码之家 › 专栏 › 技术社区 › ar099968

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

delphi

ar099968 · 技术社区 · 7 年前

我有一个儿童班 TChildClass 从 TBaseClass . t基础等级 有一个方法 function foo: string; 那个 t儿童分类 必须始终执行!

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;

我想要 t儿童分类 始终执行 function foo 和从继承的调用 t基础等级 :

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

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

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

怎么做到的?

3 回复 | 直到 7 年前

Remy Lebeau 7 年前

你不能力编译器在编译时需要重写。

为了 TChildClass 覆盖 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 ,严格按照 t儿童分类 自己决定。

Dsm 7 年前

你自己不能。然而,你可以用一种稍微不同的方式实现你想要的。

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;

注意-必须注意“创建抽象类”警告!

GolezTrol 7 年前

我想用一个 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