Frage

I am working on a component that is derived from a commercial component suite, and have run into a challenge, which I've never considered before. Consider the following code snippet:

TMyClass = class
protected
  procedure SomeMethod; virtual;
end;

TMyClass1 = class(TMyClass)
protected
  procedure SomeMethod; override;
end;

TMyMode = (mmOne, mmTwo);
TMyClass2 = class(TMyClass1)
private
  FMode: TMyMode;
protected
  procedure SomeMethod; override;
public
  property Mode: TMyMode read FMode write FMode;
end;

...

procedure TMyClass2.SomeMethod;
begin
  if FMode = mmOne then inherited SomeMethod
                   else inherited TMyClass.SomeMethod;
end;

So if Mode = mmOne then I inherit as normal, but if it is mmTwo, I still want to inherit the code from my ancestor's ancestor, but not what was introduced in the ancestor. I've tried the above, with no success, and since I've never encountered this before, I gather it's not possible. Any takers?

War es hilfreich?

Lösung

You can do this with class helpers:

type
  TA = class
  public
    procedure X; virtual;
  end;

  TB = class(TA)
  public
    procedure X; override;
  end;

  TA_Helper = class helper for TA
    procedure A_X;
  end;

  TC = class(TB)
  public
    procedure X; override;
  end;

procedure TA.X;
begin
  // ...
end;

procedure TB.X;
begin
  // ...
end;

procedure TA_Helper.A_X;
begin
  inherited X; // TA.X
end;

procedure TC.X;
begin
  A_X;
  inherited X; // TB.X
end;

I think class helpers exist in D2006, but if they don't, you can also use a hack to the same effect:

// ...
  TA_Helper = class(TA)
    procedure A_X;
  end;
// ...
procedure TC.X;
begin
  TA_Helper(Self).A_X;
  inherited X; // TB.X
end;

Andere Tipps

there is another solution of this task without class-helpers or additional methods (as in @hvd answer). you can get base class methods code address and invoke it with self Data-pointer:
updated code, without rtti

unit Unit4;

interface
type
    TA = class(TObject)
      protected
        procedure Test(); virtual;
    end;

    TB = class(TA)
      protected
        procedure Test(); override;
    end;

    TC = class(TB)
      public
        procedure Test(); override;
    end;

implementation

procedure TA.Test;
begin
    writeln('TA.Test()');
end;

procedure TB.Test;
begin
    writeln('TB.Test');
end;

procedure TC.Test;
var TATest : procedure of object;
begin
    writeln('TC.Test();');
    writeln('call inherited TB: ');
    inherited Test();


    writeln('call inherited TA:');
    TMethod(TATest).Data := self;
    TMethod(TATest).Code := @TA.Test;
    TATest();
end;
end.
Lizenziert unter: CC-BY-SA mit Zuschreibung
Nicht verbunden mit StackOverflow
scroll top