如何在Object Pascal中创建"class of interface“(或"interface of interface")类型

Question

请看下面的示例：

//----------------------------------------------------------------------------
type

  ISomeInterface = interface
    procedure SomeMethod;
  end;

  // this is wrong, but illustrates that, what i need:
  TSomeClassWhichImplementsSomeInterface = class of ISomeInterface;

var
  gHardCodedPointer: Pointer; // no matter

procedure Dummy(ASomeClassToWorkWith: TSomeClassWhichImplementsSomeInterface);
begin
  // actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
  // must implement SomeMethod, so i can make something like this:
  ASomeClassToWorkWith(gHardCodedPointer).SomeMethod;
end;

...

type

  TMyClass = class(TInterfacedObject, ISomeInterface)
  end;

...

// TMyClass implements ISomeInterface, so i can pass it into Dummy:
Dummy(TMyClass);
//----------------------------------------------------------------------------

当然，我可以继承TMyClass并使用它，但我不需要这个。我想使用另一个具有自己的层次结构的类，只是添加了ISomeInterface的实现(因为在Object Pascal中没有像C++那样的多重继承)。我知道这可能看起来很疯狂，不要问我为什么需要这个，只要说-它可能实现或不实现。非常感谢!

Answer 1

我想你要找的是：

procedure Dummy; 
var Intf : ISomeInterface;
begin
  if Assigned(gHardCodedPointer) and Supports(gHardCodedPointer,ISomeInterface,Intf) then
    Intf.SomeMethod
end;

如果不是，我不知道你在那里想要达到什么目的。

Answer 2

您可以声明元类，但不能根据基类实现的接口来定义它们。只能在运行时检查接口实现。

您可以将Dummy函数传递给元类，但不能使用该元类将普通指针类型转换为更具体的类型。类型转换是一个编译时操作，但是元类参数的实际值直到运行时才知道。您能做的最好的事情就是将其类型转换为元类的基类。然后，您可以调用该基类中定义的所有方法。

但是看起来您实际上并不关心基类是什么，只要这个类实现了您的接口。在这种情况下，您可以忽略元类参数。将指针类型转换为TObject (或者，最好先将gHardCodedPointer声明为TObject )，然后使用Supports函数获取接口引用。

var
  SupportsInterface: Boolean;
  Some: ISomeInterface;
begin
  SupportsInterface := Supports(TObject(gHardCodedPointer), ISomeInterface, Some);
  Assert(SupportsInterface, 'Programmer stored bad class instance in gHardCodedPointer');
  Some.SomeMethod;
end;

如果你真的关心metaclass参数，你也可以为它添加一些强制。您可以检查给定的类是否实现了您的接口，还可以检查gHardCodedPointer中的对象是否为该类的实例：

Assert(ASomeClassToWorkWith.GetInterfaceEntry(ISomeInterface) <> nil);
Assert(TObject(gHardCodedPointer).InheritsFrom(ASomeClassToWorkWith));

但请注意，您不需要检查这两个结果中的任何一个，就可以在gHardCodedPointer上调用SomeMethod。它们其实并不重要。

顺便说一句，在Delphi中，您唯一希望拥有的硬编码指针值是nil。所有其他指针值都是在编译时很难预测的地址，因为编译器、链接器和加载器都决定了所有内容在内存中的实际位置。我建议您为这个变量想出一些其他的名称，以便更准确地描述它真正包含的内容。

Answer 3

为什么不能使用接口引用呢？但是，假设有一个很好的理由，这可能会有所帮助。

正如您已经发现的，您不能在接口上执行class of。

更重要的是，您不能使用变量值将任何内容转换为其他任何内容。强制转换是硬连接的，它会告诉编译器您知道正在强制转换的引用是特定类型的。尝试使用诸如ASomeClassToWorkWith参数之类的变量来执行此操作将产生错误，因为这与强制转换的本质背道而驰。

下面的代码不是我推荐的，但是它可以编译，而且我认为它能做你想要的事情。它所做的就是使用一个“虚拟”祖先，并使用多态来让编译器在正确的类型上调用该方法。如果不将SomeMethod标记为虚拟，则在两次单击按钮时都会得到虚拟祖先的消息。

接口中的实例函数向您展示了一种无需使用RTTI即可访问接口的实现实例的方法。在使用接口委托时，只需注意这一点:您可能得不到期望的实例。

type
  TForm1 = class(TForm)
    TSomethingBtn: TButton;
    TMyClassBtn: TButton;
    procedure FormCreate(Sender: TObject);
    procedure TSomethingBtnClick(Sender: TObject);
    procedure TMyClassBtnClick(Sender: TObject);
  private
    { Private declarations }
    FSomething: TObject;
    FMyClass: TObject;
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

type
  TSomething = class; // forward;
  TSomethingClass = class of TSomething;

  ISomeInterface = interface
    procedure SomeMethod;
    function Instance: TSomething;
  end;

  TSomething = class(TInterfacedObject, ISomeInterface)
    procedure SomeMethod; virtual;
    function Instance: TSomething;
  end;

var
  gHardCodedPointer: Pointer; // no matter

procedure Dummy(aSomething: TSomething);
begin
  // actually, type of ASomeClassToWorkWith is unknown (at least TObject), but it
  // must implement SomeMethod, so i can make something like this:
  aSomething.SomeMethod;
end;

type
  TMyClass = class(TInterfacedObject, ISomeInterface)
    procedure SomeMethod; virtual;
    function Instance: TSomething;
  end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  FSomething := TSomething.Create;
  FMyClass := TMyClass.Create;
end;

{ TMyClass }

function TMyClass.Instance: TSomething;
begin
  Result := TSomething(Self);
end;

procedure TMyClass.SomeMethod;
begin
  ShowMessage('This comes from TMyClass');
end;

{ TSomething }

function TSomething.Instance: TSomething;
begin
  Result := Self;
end;

procedure TSomething.SomeMethod;
begin
  ShowMessage('This comes from the "dummy" ancestor TSomething');
end;

procedure TForm1.TMyClassBtnClick(Sender: TObject);
begin
  // Presume this has been set elsewhere
  gHardCodedPointer := FMyClass;
  Dummy(TSomething(gHardCodedPointer));
end;

procedure TForm1.TSomethingBtnClick(Sender: TObject);
begin
  // Presume this has been set elsewhere
  gHardCodedPointer := FSomething;
  Dummy(TSomething(gHardCodedPointer));
end;