so_26991022

program so_26991022;

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

uses
  System.SysUtils;

type
  IParent = interface
    ['{B2BEC2DA-79CA-4A2A-952C-8A68D85F62EF}']
    procedure Foo;
  end;

  IChild = interface( IParent )
    ['{47F088C9-5606-4E53-841A-6C632B5424F2}']
    procedure Bar;
  end;

  TImplementer = class( TInterfacedObject, IParent, IChild )
  private
{$REGION 'IParent'}
    procedure Parent_Foo;
{$REGION 'IParent method routing'}
    procedure IParent.Foo = Parent_Foo;
{$ENDREGION}
{$ENDREGION}
{$REGION 'IChild'}
    procedure Child_Foo;
    procedure Child_Bar;
{$REGION 'ICHild method routing'}
    procedure IChild.Foo = Child_Foo;
    procedure IChild.Bar = Child_Bar;
{$ENDREGION}
{$ENDREGION}
  end;

  { TImplementer }

procedure TImplementer.Child_Bar;
begin
  WriteLn( 'Child Bar' );
end;

procedure TImplementer.Child_Foo;
begin
  WriteLn( 'Child Foo' );
end;

procedure TImplementer.Parent_Foo;
begin
  WriteLn( 'Parent Foo' );
end;

procedure WorkWithParent( AParent: IParent );
begin
  WriteLn( 'Call WorkWithParent:' );
  AParent.Foo;
end;

procedure WorkWithChild( AChild: IChild );
begin
  WriteLn( 'Call WorkWithClient:' );
  AChild.Foo;
  AChild.Bar;
end;

procedure Test;
var
  LInstance: IInterface;
  LParent: IParent;
  LChild: IChild;
begin
  LInstance := TImplementer.Create;

  if Supports( LInstance, IParent, LParent )
  then
    // Call WorkWithParent:
    // Parent Foo
    WorkWithParent( LParent );

  if Supports( LInstance, IChild, LChild )
  then
    begin
      // Call WorkWithClient:
      // Child Foo
      // Child Bar
      WorkWithChild( LChild );
      // Call WorkWithParent:
      // Child Foo
      WorkWithParent( AChild );
    end;
end;

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

end.