Как сделать в Object Pascal тип «класс интерфейса» (или «интерфейс интерфейса»)

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 и использовать его childs, но мне это не нужно.Я хочу использовать другие классы с их собственной иерархией, просто добавив в них реализацию 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 до be a 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;

Если вы действительно заботитесь о параметре метакласса, вы также можете добавить к нему некоторое принудительное применение. Вы можете проверить, реализует ли данный класс ваш интерфейс, и проверить, является ли объект в gHardCodedPointer экземпляром этого класса:

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

Но обратите внимание, что вам не нужно проверять ни один из этих результатов, чтобы иметь возможность звонить SomeMethod на gHardCodedPointer. Они на самом деле не имеют значения.

Кстати, единственное жестко закодированное значение указателя, которое вы можете надеяться получить в Delphi, это nil. Все остальные значения указателя являются адресами, которые очень трудно предсказать во время компиляции, потому что компилятор, компоновщик и загрузчик все определяют, где все в действительности идет в памяти. Я предлагаю вам придумать какое-то другое имя для этой переменной, которое более точно описывает, что она на самом деле содержит.

Answer 3

Кажется, я вижу, что ты хочешь сделать. Вам просто нужно использовать то, что MS и партнеры реализовали в ядре интерфейсов, использовать руководства. Ниже приведен пример, но вы обязательно должны использовать свой собственный guid с CTRL + SHIFT + G в IDE

  ...

  type
    ITestInterface = interface
     ['{2EA2580F-E5E5-4F3D-AF90-2BBCD65B917B}']
      procedure DoSomething;
    end;

    TTestObject = class(TInterfacedObject, ITestInterface)
      procedure DoSomething;
    end;

    TTestObject2 = class(TInterfacedObject, ITestInterface)
      procedure DoSomething;
    end;

  ...

  procedure TestMethod(Obj: TInterfacedObject);
  var
    Intf: ITestInterface;
  begin
    if (Obj as IUnknown).QueryInterface(ITestInterface, Intf) = S_OK then
      Intf.DoSomething;
  end;

  { TTestObject }

  procedure TTestObject.DoSomething;
  begin
    MessageDlg('This is TTestObject showing something', mtInformation, [mbOk], 0)
  end;

  { TTestObject2 }

  procedure TTestObject2.DoSomething;
  begin
    MessageDlg('This is TTestObject2 showing something', mtInformation, [mbOk], 0)
  end;

  procedure TForm2.Button1Click(Sender: TObject);
  var
    Obj1, Obj2: TInterfacedObject;
  begin
    Obj1:=TTestObject.Create;
    Obj2:=TTestObject2.Create;

    TestMethod(Obj1);
    TestMethod(Obj2);
  end;

Answer 4

Почему вы не можете использовать ссылку на интерфейс?Но, если на то есть веская причина, это может помочь.

Как вы узнали, вы не можете сделать class of на интерфейсе.

Что еще вы можете сделать?t использовать значение переменной для приведения чего-либо к чему-либо еще.Приведение является жестким сообщением компилятору, что вы знаете, что ссылка, которую вы приводите, имеет определенный тип.Попытка сделать это с помощью переменной var, такой как ваш ASomeClassToWorkWith, приведет к ошибкам, поскольку это противоречит самой природе приведения.

Код ниже не рекомендуется, но он компилируется, и ядумаю, что делает то, что вы хотите.Он использует «фиктивного» предка и использует полиморфизм, чтобы заставить компилятор вызывать метод правильного типа.Если вы не пометите SomeMethod как виртуальный, вы получите сообщение о фиктивном предке при каждом нажатии кнопки.

Функция Instance в интерфейсе предназначена для того, чтобы показать вам способ добраться до реализующего экземпляра интерфейса безиспользуя 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;

Answer 5

Разница при вызове кода через интерфейсную переменную или через переменную, указывающую на экземпляр класса, который реализует методы одного и того же интерфейса, заключается в том, что используются разные таблицы виртуальных методов (VMT), т. Е. В VMT интерфейса будут только методы интерфейса (плюс, конечно, AddRef, Release и QI), в VMT класса будут все виртуальные методы этого класса. Это означает, что ваш код

ASomeClassToWorkWith(gHardCodedPointer).SomeMethod;

будет скомпилировано для непосредственного вызова TSomeClassWhichImplementsSomeInterface.SomeMethod вместо виртуального метода в VMT объекта ISomeInterface через указатель интерфейса.

Более того, поскольку интерфейсы не могут объявлять методы класса и атрибуты класса, тип интерфейса не является объектом (тогда как класс является объектом), поэтому «класс интерфейса» не имеет никакого смысла.

Вы можете добавить промежуточный абстрактный класс и объявить вас "классом интерфейса" как классом промежуточного класса:

type
  TInterfacedObjectWithISomeInterface = class(TInterfacedObject, ISomeInterface)
    procedure SomeMethod; virtual; abstract;
  end;

  TSomeClassWhichImplementsSomeInterface = class of TInterfacedObjectWithISomeInterface;

procedure Dummy(ASomeClassToWorkWith: TSomeClassWhichImplementsSomeInterface);

...

type

  TMyClass = class(TInterfacedObjectWithISomeInterface)
    procedure SomeMethod; override;
  end;

Answer 6

Даже если бы вы могли, вы все равно не могли бы настроить интерфейс с помощью интерфейса-var.

Так же, как и с классами, когда вы вводите указатель на метакласс, вы получите нечто типа метакласс (class of), а не что-то типа того, что находится в метаклассе.

С помощью классов вы решаете это путем приведения типа к низшему общему классу в иерархии.Вы можете сделать то же самое с интерфейсами.... Если они наследуют друг от друга.

Answer 7

Я думаю, что вы должны использовать интерфейс, а не класс:

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

Вы просто должны думать о подсчете ссылок

Если вы действительно хотите экземпляр объекта, вы можете изменить интерфейс следующим образом:

type 
  ISomeInterface = interface 
    procedure SomeMethod; 
    function ImplementedInObject: TObject; 
  end; 


procedure Dummy(ASomeInterfaceToWorkWith: ISomeInterface);
var
  ASomeObjectToWorkWith: TObject;
begin 
  ASomeInterfaceToWorkWith.SomeMethod; 
  ASomeObjectToWorkWith := ASomeInterfaceToWorkWith.ImplementedInObject;
  // Do what is needed with object
end; 

... 

type 
  TMyClass = class(TInterfacedObject, ISomeInterface) 
    function ImplementedInObject: TObject; 
  end; 

function TMyClass.ImplementedInObject: TObject;
begin
  Result := Self;
end;