【问题标题】:Multiple Interface inherited Delphi多接口继承Delphi
【发布时间】:2020-12-27 21:23:46
【问题描述】:

我有下面的代码。 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.

【问题讨论】:

  • 解决方案是类型转换:i := TAnimalFactory.GetAnimal(atCat) as ICat;
  • 感谢您的回复,我会尝试使用类型转换。结果的错误我在 Stackoverflow 中编码:-)
  • 你还应该声明实现对象实现了 IAnimal

标签: delphi inheritance interface


【解决方案1】:

在现代 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;

【讨论】:

    【解决方案2】:

    我创建了我认为您会喜欢的代码。这就是你所做的,在 cmets 中使用了 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, IAnimal, 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.
    

    【讨论】:

      猜你喜欢
      • 1970-01-01
      • 1970-01-01
      • 2022-01-10
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 1970-01-01
      • 2017-09-11
      • 2017-03-24
      相关资源
      最近更新 更多