Delphi: Как вызвать унаследованного наследуемого предка в виртуальном методе?

Я переопределяю виртуальный метод, и я хочу, чтобы унаследовал. Но я не хочу называть непосредственного предка, я хочу позвонить тому, кто был раньше.

TObject
   TDatabaseObject
      TADODatabaseObject <---call this guy
         TCustomer        <---skip this guy
            TVIP           <---from this guy

я пытался кастоватьself как предок, и вызовите метод для этого, но это привело к рекурсивному переполнению стека:

procedure TVip.SetProperties(doc: IXMLDOMDocument);
begin
   TADODatabaseObject(Self).SetProperties(doc); //skip over TCustomer ancestor
   ...
end;

я попытался добавить inherited ключевое слово, но это не компилируется:

procedure TVip.SetProperties(doc: IXMLDOMDocument);
begin
   inherited TADODatabaseObject(Self).SetProperties(doc); //skip over TCustomer ancestor
   ...
end;

Возможный?

Источник

4 ответа

Решение

Вы не можете обычным языком, так как это нарушит объектно-ориентированные аспекты языка.

Вы можете возиться с указателями и умными приведениями, чтобы сделать это, но прежде чем даже начать отвечать на этот вопрос: действительно ли это то, что вы хотите?

Как уже упоминалось: ваша потребность звучит как серьезный "запах дизайна" (который похож на запах кода, но более серьезен.

Редактировать:

Спуск по указателю может спасти вашу работу в краткосрочной перспективе и стоить вам недель работы в долгосрочной перспективе.
Это делает для хорошего чтения на этом: решения по добыче, расходы по переработке.

Источник

Вы можете сделать это, используя способ получения статического адреса виртуального метода:

type
  TBase = class
    procedure Foo; virtual;
  end;

  TAnsestor = class(TBase)
    procedure Foo; override;
  end;

  TChild = class(TAnsestor)
    procedure Foo; override;
    procedure BaseFoo;
  end;

procedure TBase.Foo;
begin
  ShowMessage('TBase');
end;

procedure TAnsestor.Foo;
begin
  ShowMessage('TAnsestor');
end;

procedure TChild.Foo;
begin
  ShowMessage('TChild');
end;

type
  TFoo = procedure of object;

procedure TChild.BaseFoo;
var
  Proc: TFoo;

begin
  TMethod(Proc).Code := @TBase.Foo; // Static address
  TMethod(Proc).Data := Self;
  Proc();
end;

procedure TForm4.Button1Click(Sender: TObject);
var
  Obj: TChild;
  Proc: TFoo;

begin
  Obj:= TChild.Create;
  Obj.BaseFoo;
// or else
  TMethod(Proc).Code := @TBase.Foo; // Static address
  TMethod(Proc).Data := Obj;
  Proc();

  Obj.Free;
end;
Источник

Я помню, что несколько лет назад мне приходилось делать что-то подобное, обходя некоторые конструктивные ограничения иерархии VCL.

Так что, похоже, что-то вроде этого:

type
  TGrandParent = class(TObject)
  public
    procedure Show;virtual;
  end;

  TParent = class(TGrandParent)
  public
    procedure Show;override;
  end;

  THackParent = class(TGrandParent)
  private
    procedure CallInheritedShow;
  end;

  TMyObject = class(TParent)
  public
    procedure Show;override;
  end;


{ TGrandParent }

procedure TGrandParent.Show;
begin
  MessageDlg('I''m the grandparent', mtInformation, [mbOk], 0);
end;

{ TParent }

procedure TParent.Show;
begin
  inherited;
  MessageDlg('I''m the parent', mtInformation, [mbOk], 0);
end;

{ THackParent }

procedure THackParent.CallInheritedShow;
begin
  inherited Show;
end;

{ TVIP }

procedure TMyObject.Show;
begin
  THackParent(Self).CallInheritedShow;
end;

procedure TForm6.Button6Click(Sender: TObject);
var
  VIP: TMyObject;
begin
  VIP:=TMyObject.Create;
  try
    VIP.Show;
  finally
    VIP.Free;
  end;
end;

Не ужин-элегантный, но все же решение:)

Источник

Если вы действительно хотите это сделать, вы должны извлечь в отдельный защищенный метод ту часть иерархии наследования, на которую вы хотите иметь возможность ссылаться напрямую. Это позволит вам вызывать его из любой точки мира, не отправляя виртуальный метод, побеждающий вас.

Однако, как я уже говорил, похоже, что-то не так с вашим классом дизайна.

Источник
Другие вопросы по тегам