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;

Возможный?

Ответы

Ответ 1

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

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

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

Edit:

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

Ответ 2

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

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;

Ответ 3

Я помню, что мне приходилось делать что-то вроде этого несколько лет назад, работая над некоторым ограничением дизайна иерархии 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;

Не ухо-элегантное, но все-таки решение:)

Ответ 4

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

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