Halb-virtuelle Methoden

[Sir Rufo]

Ich habe das Beispiel mal erweitert, damit man die ganzen Spielarten sieht

Delphi-Quellcode:

program dp_183307;

{$APPTYPE CONSOLE}
{$R *.res}

uses
  System.SysUtils;

type
  IMyInterface = interface
    procedure interfaceProc1( );
    procedure interfaceProc2( );
  end;

  TMyBase = class( TInterfacedObject, IMyInterface )
    procedure interfaceProc1( ); // virtual;
    procedure interfaceProc2( ); virtual;
  end;

  TMyChild = class( TMyBase, IMyInterface )
    procedure interfaceProc1( ); // override;
    procedure interfaceProc2( ); override;
  end;

procedure TMyBase.interfaceProc1( );
begin
  WriteLn( 'TMyBase.interfaceProc1' );
end;

procedure TMyBase.interfaceProc2;
begin
  WriteLn( 'TMyBase.interfaceProc2' );
end;

procedure TMyChild.interfaceProc1( );
begin
  inherited;
  WriteLn( 'TMyChild.interfaceProc1' );
end;

procedure TMyChild.interfaceProc2;
begin
  inherited;
  WriteLn( 'TMyChild.interfaceProc2' );
end;

procedure Test1;
var
  LIntf: IMyInterface;
  LInst: TMyBase;
begin
  WriteLn( 'LInst[TMyBase] := TMyBase.Create' );
  LInst := TMyBase.Create;
  LInst.interfaceProc1;
  LInst.interfaceProc2;
  WriteLn( 'LIntf <- LInst' );
  LIntf := LInst;
  LIntf.interfaceProc1;
  LIntf.interfaceProc2;
end;

procedure Test2;
var
  LIntf: IMyInterface;
  LInst: TMyBase;
begin
  WriteLn( 'LInst[TMyBase] := TMyChild.Create' );
  LInst := TMyChild.Create;
  LInst.interfaceProc1;
  LInst.interfaceProc2;
  WriteLn( 'LIntf <- LInst' );
  LIntf := LInst;
  LIntf.interfaceProc1;
  LIntf.interfaceProc2;
end;

procedure Test3;
var
  LIntf: IMyInterface;
  LInst: TMyChild;
begin
  WriteLn( 'LInst[TMyChild] := TMyChild.Create' );
  LInst := TMyChild.Create;
  LInst.interfaceProc1;
  LInst.interfaceProc2;
  WriteLn( 'LIntf <- LInst' );
  LIntf := LInst;
  LIntf.interfaceProc1;
  LIntf.interfaceProc2;
end;

begin
  try
    WriteLn('Test1');
    Test1;
    WriteLn;
    WriteLn('Test2');
    Test2;
    WriteLn;
    WriteLn('Test3');
    Test3;
  except
    on E: Exception do
      WriteLn( E.ClassName, ': ', E.Message );
  end;
  ReadLn;

end.

Damit erhalten wir folgende Ausgabe

Code:

Test1
LInst[TMyBase] := TMyBase.Create
TMyBase.interfaceProc1
TMyBase.interfaceProc2
LIntf <- LInst
TMyBase.interfaceProc1
TMyBase.interfaceProc2

Test2
LInst[TMyBase] := TMyChild.Create
TMyBase.interfaceProc1
TMyBase.interfaceProc2
TMyChild.interfaceProc2
LIntf <- LInst
TMyBase.interfaceProc1
TMyBase.interfaceProc2
TMyChild.interfaceProc2

Test3
LInst[TMyChild] := TMyChild.Create
TMyBase.interfaceProc1
TMyChild.interfaceProc1
TMyBase.interfaceProc2
TMyChild.interfaceProc2
LIntf <- LInst
TMyBase.interfaceProc1
TMyChild.interfaceProc1
TMyBase.interfaceProc2
TMyChild.interfaceProc2

Jetzt kommt das Schmankerl ... und nehmen bei TMyChild das Interface weg TMyChild = class( TMyBase{, IMyInterface} ) .

Jetzt erhalten wir diese Ausgabe

Code:

Test1
LInst[TMyBase] := TMyBase.Create
TMyBase.interfaceProc1
TMyBase.interfaceProc2
LIntf <- LInst
TMyBase.interfaceProc1
TMyBase.interfaceProc2

Test2
LInst[TMyBase] := TMyChild.Create
TMyBase.interfaceProc1
TMyBase.interfaceProc2
TMyChild.interfaceProc2
LIntf <- LInst
TMyBase.interfaceProc1
TMyBase.interfaceProc2
TMyChild.interfaceProc2

Test3
LInst[TMyChild] := TMyChild.Create
TMyBase.interfaceProc1
TMyChild.interfaceProc1
TMyBase.interfaceProc2
TMyChild.interfaceProc2
LIntf <- LInst
TMyBase.interfaceProc1
TMyBase.interfaceProc2
TMyChild.interfaceProc2

Lustig, gell?