Svartedauen icon

Interface delegation test 1

Svartedauen | PRO | 03/22/18 07:00:09 PM UTC | 0 ⭐ | 10116 👁️ | Never ⏰ | []
Delphi |

2.89 KB

|

None

|

0 👍

/

0 👎

unit Snippets.Interfaces.Delegation;
 
interface
 
uses System.SysUtils;
 
type
  IA = interface(IInterface)
    ['{F73B998B-18DA-4170-A933-92C310758818}']
    function DoA: String;
  end;
 
  IB = interface(IInterface)
   ['{87AD034F-6348-4E8E-A2AB-1AAF0BD14601}']
   function DoB: String;
  end;
 
  TA = class(TInterfacedObject, IA)
    function DoA: String;
  end;
 
  TB = class(TInterfacedObject, IB)
   function DoB: String;
  end;
 
  TAggregatedA = class(TAggregatedObject, IA)
    function DoA: String;
  end;
 
  TAggregatedB = class(TAggregatedObject, IB)
   function DoB: String;
  end;
 
  TAggSimple = class(TInterfacedObject, IA, IB)
  private
    FA: IA;
    FB: IB;
  protected
    property A: IA read FA implements IA;
    property B: IB read FB implements IB;
  public
    constructor Create;
  end;
 
  TAggV2 = class(TInterfacedObject, IA, IB)
  private
    FA: IA;
    FB: IB;
  protected
    property A: IA read FA implements IA;
    property B: IB read FB implements IB;
  public
    constructor Create;
  end;
 
  TPlain = class(TInterfacedObject, IA, IB)
  public
    function DoA: String;
    function DoB: String;
  end;
 
function RunTest1: String;
 
implementation
 
function RunTest1: String;
var
  A: IA;
  B: IB;
begin
  Result := '';
  A := TAggSimple.Create;
  //A.QueryInterface(IB, B);
  if not Supports(A, IB, B) then
    Result := 'Supports on simple aggregate (interfaced fields) failed' + #$D#$A;
  Result := Result + 'TAggSimple: ' + A.DoA + #$D#$A;
  if Assigned(B) then
    Result := Result + 'TAggSimple: ' + B.DoB + #$D#$A;
 
  A := TPlain.Create;
  if not Supports(A, IB, B) then
    Result := 'Supports on plain failed' + #$D#$A;
  Result := Result + 'TPlain: ' + A.DoA + #$D#$A;
  if Assigned(B) then
    Result := Result + 'TPlain: ' + B.DoB + #$D#$A;
 
  A := TAggV2.Create;
  if not Supports(A, IB, B) then
    Result := 'Supports on aggV2 failed' + #$D#$A;
  Result := Result + 'TAggV2: ' + A.DoA + #$D#$A;
  if Assigned(B) then
    Result := Result + 'TAggV2: ' + B.DoB + #$D#$A;
end;
 
{ TAggSimple }
 
constructor TAggSimple.Create;
begin
  inherited;
  FA := TA.Create;
  FB := TB.Create;
end;
 
{ TA }
 
function TA.DoA: String;
begin
  Result := Self.ClassName + '.DoA';
end;
 
{ TB }
 
function TB.DoB: String;
begin
  Result := Self.ClassName + '.DoB';
end;
 
{ TPlain }
 
function TPlain.DoA: String;
begin
  Result := Self.ClassName + '.DoA';
end;
 
function TPlain.DoB: String;
begin
  Result := Self.ClassName + '.DoB';
end;
 
{ TAggregatedA }
 
function TAggregatedA.DoA: String;
begin
  Result := Self.ClassName + '.DoA';
end;
 
{ TAggregatedB }
 
function TAggregatedB.DoB: String;
begin
  Result := Self.ClassName + '.DoB';
end;
 
{ TAggV2 }
 
constructor TAggV2.Create;
begin
  inherited;
  FA := TAggregatedA.Create(Self);
  FB := TAggregatedB.Create(Self);
end;
 
end.

Comments

  •  icon
    01/01/70 12:00:00 AM UTC
    Plain Text |

    0 B

    |

    👍

    /

    👎

    
        
  •  icon
    01/01/70 12:00:00 AM UTC
    Plain Text |

    0 B

    |

    👍

    /

    👎