多接口继承了Delphi

如何解决多接口继承了Delphi

我有下面的代码。 IAnimal是我的应用程序中所有动物的基本接口。

为什么我不能用想要的类型声明var，获得一个实现基本接口IAnimal的对象并调用方法？

type
  IAnimal = interface
  end;

  ICat = interface(IAnimal)
    procedure Hunt;
  end;

  IBird = interface(IAnimal)
    procedure Fly;
  end;

  TCat = class(TInterfacedObject,ICat)
    procedure Hunt;
  end;

  TBird = class(TInterfacedObject,IBird)
    procedure Fly;
  end;

  TAnimalType = (atCat,atBird);

  TAnimalFactory = class
    class function GetAnimal(aType: TAnimalType): IAnimal;
  end;

procedure TCat.Hunt;
begin
  Writeln('I hunt');
end;

procedure TBird.Fly;
begin
  Writeln('I fly');
end;
        
class function TAnimalFactory.GetAnimal(aType: TAnimalType): IAnimal;
begin
  case aType of
    atCat: Result := TCat.Create;
    atBird: Result := TBird.Create;
  end;
end;

var
  i: ICat;
begin
    i := TAnimalFactory.GetAnimal(atCat);
    // [dcc32 Error] Project1.dpr(63): E2010 Incompatible types: 'ICat' and 'IAnimal'

    i.Hunt;
end.

解决方法

在现代Delphi版本中，您可以使用泛型，例如：

interface
uses
  System.Classes,System.Generics.Collections;

  ICat = interface(IAnimal)
    ['{15E79A9B-CF33-4672-8892-FCBC7A778C57}']  // Ctrl+Shift+G to generate GUID
    procedure Hunt;
  end;

  IBird = interface(IAnimal)
    ['{C9318161-2827-4D8C-AE0F-4D7B9A686F60}']
    procedure Fly;
  end;

  TAnimalFactory = class
    class function GetAnimal<Intf: IAnimal>: Intf;
  end;

implementation
uses
  System.SysUtils,System.TypInfo;
  { TAnimalFactory }

class function TAnimalFactory.GetAnimal<Intf>: Intf;
var
  G: TGUID;
  tmp: IInterface;
begin
  G := GetTypeData(TypeInfo(Intf))^.Guid;

  if G = ICat then
    tmp:=TCat.Create;
  if G = IBird then
    tmp:=TBird.Create;

  if not Supports(tmp,G,Result) then
    Result:=nil;
end;

var
  i: ICat;
begin
  i := TAnimalFactory.GetAnimal<ICat>;
  if Assigned(i) then  // if you not sure about interface support
    i.Hunt;
end;

,

我创建了您认为会喜欢的代码。这就是您所做的，同时Zed和Bosshoss在评论中建议了修复方案。我制作了一个VCL应用程序，还在基本接口中添加了一个方法。

unit Unit7;

interface

uses
  System.SysUtils,System.Classes,Vcl.Graphics,Vcl.Controls,Vcl.Forms,Vcl.Dialogs,Vcl.StdCtrls;

type
  IAnimal = interface
    procedure WhatILike;
  end;

  ICat = interface(IAnimal)
    procedure Hunt;
  end;

  IBird = interface(IAnimal)
    procedure Fly;
  end;

  TCat = class(TInterfacedObject,IAnimal,ICat)
    procedure WhatILike;
    procedure Hunt;
  end;

  TBird = class(TInterfacedObject,IBird)
    procedure WhatILike;
    procedure Fly;
  end;

  TAnimalType = (atCat,atBird);

  TAnimalFactory = class
    class function GetAnimal(aType: TAnimalType): IAnimal;
  end;

  TForm7 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  end;

var
  Form7: TForm7;

implementation

{$R *.dfm}

procedure TCat.Hunt;
begin
  ShowMessage('I hunt');
end;

procedure TBird.Fly;
begin
  ShowMessage('I fly');
end;

class function TAnimalFactory.GetAnimal(aType: TAnimalType): IAnimal;
begin
  case aType of
    atCat  : Result := IAnimal(TCat.Create);
    atBird : Result := IAnimal(TBird.Create);
    else     Result := nil;
  end;
end;

procedure TForm7.Button1Click(Sender: TObject);
var
    ABird : IBird;
    ACat  : ICat;
begin
    ACat  := ICat(TAnimalFactory.GetAnimal(atCat));
    ABird := IBird(TAnimalFactory.GetAnimal(atBird));

    ACat.Hunt;
    ABird.Fly;
    ACat.WhatILike;
    ABird.WhatILike;
end;


procedure TCat.WhatILike;
begin
    ShowMessage('I like to hunt');
end;

procedure TBird.WhatILike;
begin
    ShowMessage('I like to fly');
end;

end.