Базовый интерфейс Delphi не работает полиморфно - PullRequest
Новая
       2

Базовый интерфейс Delphi не работает полиморфно

3 голосов
/ 29 июня 2011

Я создал несколько интерфейсов для описания коллекции и ее элементов: IetCollection и IetCollectionItem.И, конечно, у меня есть два класса, реализующих эти два интерфейса: TetCollection и TetCollectionItem (оба наследуются от TInterfacedObject.)

Затем у меня есть серия интерфейсов, где интерфейсы верхнего уровня наследуются от IetCollectionItem, а остальные от него (позволяютназовите их ISomeBasicType и ISomeSpecificType1 и ISomeSpecificType2.)

Класс TSomeBasicType наследуется от класса TetCollectionItem и также реализует ISomeBasicType.Другие классы в иерархии наследуются от TSomeBasicType и реализуют их соответствующие интерфейсы (т.е. ISomeSpecificType1 и ISomeSpecificType2.)

Когда я заполняю коллекцию, я использую фабричный метод, чтобы получить ссылку на ISomeBasicType.До этого момента все работало просто отлично.

Но когда я пытаюсь обойти коллекцию и спросить, поддерживает ли элемент коллекции либо ISomeSpecificType1, либо ISomeSpecificType2, я получаю ответ «нет».

Я былпытаясь решить эту проблему, и я ничего не добился, поэтому любая помощь будет принята с благодарностью.

Вот некоторый код: 

// This is the basic type
IetCollectionItem = interface
end;

// Implementation of the basic type
TetCollectionItem = class(TInterfacedObject, IetCollectionItem)
end; 

ISomeBasicType = interface(IetCollectionItem)
end; 

ISomeSpecificType1 = interface(ISomeBasicType)
end; 

// Implements ISomeBasicType, should inherit implementation of IetCollectionItem
// from TetCollectionItem
TSomeBasicType = class(TetCollectionItem, ISomeBasicType)
end; 

// Implements ISomeSpecificType1, should inherit implementation of ISomeBasicType
// from TSomeBasicType and implementation of IetCollectionItem from
// TetCollectionItem
TSomeSpecificType1 = class(TSomeBasicType, ISomeSpecificType1)
end;

Это код, который я использую для заполнения коллекции:

var
  aBaseType: ISomeBasicType;
  aSpecificType: ISomeSpecificType1;
begin
  aBaseType:= TheFactory(anID, aType);  // Returns a reference to ISomeBasicType

  if Supports(aBaseType, ISomeSpecificType1, aSpecificType) then
  begin
    // Do something to the specific type
    aTypeCollection.Add(aSpecificType);
  end
  else
    aTypeCollection.Add(aBaseType);

А вот код, который не работает: я перебираю коллекцию и проверяю, поддерживает ли какой-либо из ее элементов один из дочерних интерфейсов. 

var
  iCount: Integer;
  aBaseType: ISomeBasicType;
  aSpecificType: ISomeSpecificType1;
begin
  for iCount:= 0 to Pred(aTypeCollection.Count) do
  begin
    aBaseType:= aTypeCollection[iCount];

    // This is where Supports fails
    if Supports(aBaseType, ISomeSpecificType1, aSpecificType) then
    begin
    end;
  end;
end;

А вот код для TheFactory: 

function TheFactory(const anID: Integer; const aType: TetTypes): ISomeBasicType;
begin
  Result:= nil;

  case aType of
    ptType1 : Result:= TSomeSpecificType1.Create(anID, aType);
    ptType2 : Result:= TSomeSpecificType2.Create(anID, aType);
  end;

  Assert(Assigned(Result), rcUnknonwPhenomenonType);
end;  {TheFactory}

Ответы [ 3 ]

6 голосов
/ 29 июня 2011

Хотя ваш код вызывает у меня головокружение, только из-за названия вашего вопроса я чувствую, что знаю, в чем ваша проблема.К сожалению, полиморфизм интерфейса Delphi не ведет себя как полиморфизм класса Delphi (я где-то читал, что это было связано с некоторой совместимостью интерфейса COM).Дело в том, что если вы запрашиваете экземпляр класса для определенного интерфейса, Delphi находит только те интерфейсы, которые непосредственно перечислены в объявлении класса, хотя другой интерфейс в объявлении класса мог быть унаследован от того, к которому вы обращаетесь.Посмотрите на этот простой пример, чтобы понять, что я имею в виду.И извините, если мой ответ полностью пропустил вашу проблему.

type
  TForm61 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  IBase = interface
  ['{AE81FB3C-9159-45B0-A863-70FD1365C113}']
  end;

  IChild = interface(IBase)
  ['{515771E7-44F6-4819-9B3A-F2A2AFF74543}']
  end;

  TBase = class(TInterfacedObject, IBase)

  end;

  TChild = class(TInterfacedObject, IChild)

  end;

  TChildThatSupportsIbase = class(TChild, IBase)

  end;

var
  Form61: TForm61;

implementation

{$R *.dfm}

procedure TForm61.Button1Click(Sender: TObject);
var
  Child: IChild;
  ChildThatSupportsIbase: IChild;
begin
  Child := TChild.Create;
  ChildThatSupportsIbase:= TChildThatSupportsIbase.Create;
  if Supports(Child, IBase) then
    ShowMessage('TChild supports IBase')
  else
    ShowMessage('TChild doesn''t supports IBase');
  if Supports(ChildThatSupportsIbase, IBase) then
    ShowMessage('TChildThatSupportsIbase supports IBase')
  else
    ShowMessage('TChildThatSupportsIbase doesn''t supports IBase');
end;
2 голосов
/ 29 июня 2011

Пример кода, отредактированного для использования вашей иерархии классов.Оба Supports вызова возвращают True.Я только добавил GUID для ваших интерфейсов.

Если мой хрустальный шар находится в рабочем состоянии, вы забыли указать GUID для ваших интерфейсов.

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

program Project29;

{$APPTYPE CONSOLE}

uses
  SysUtils;

type

  // This is the basic type
  IetCollectionItem = interface
  end;

  // Implementation of the basic type
  TetCollectionItem = class(TInterfacedObject, IetCollectionItem)
  end;

  ISomeBasicType = interface(IetCollectionItem)
  ['{F082CD83-5030-42EE-A1A8-FF91769F986F}']
  end;

  ISomeSpecificType1 = interface(ISomeBasicType)
  ['{8789FD5A-FC94-4F19-B28B-8ABA67D66DAE}']
  end;

  // Implements ISomeBasicType, should inherit implementation of IetCollectionItem
  // from TetCollectionItem
  TSomeBasicType = class(TetCollectionItem, ISomeBasicType)
  end;

  // Implements ISomeSpecificType1, should inherit implementation of ISomeBasicType
  // from TSomeBasicType and implementation of IetCollectionItem from
  // TetCollectionItem
  TSomeSpecificType1 = class(TSomeBasicType, ISomeSpecificType1)
  end;

var iBase: IetCollectionItem;

begin
  iBase := TSomeSpecificType1.Create;

  if Supports(iBase, iSomeBasicType) then
    WriteLn('iBase supports iSomeBasicType')
  else
    WriteLn('iBase does not support iSomeBasicType');

  if Supports(iBase, ISomeSpecificType1) then
    WriteLn('iBase supports ISomeSpecificType1')
  else
    WriteLn('iBase does not support ISomeSpecificType1');

  WriteLn('Press ENTER'); Readln;
end.
0 голосов
/ 29 июня 2011

Сначала вы помещаете в список то, что явно НЕ поддерживает ISomeSpecificType1: 

 if Supports(aBaseType, ISomeSpecificType1, aSpecificType) then
  begin
    // Do something to the specific type
    aTypeCollection.Add(aSpecificType);
  end
  else
    aTypeCollection.Add(aBaseType); //<------- this

Тогда вы удивляетесь, почему он не поддерживает ISomeSpecificType1.

В чем проблема? Как вы думаете, почему все или даже ЛЮБЫЕ предметы из коллекции должны поддерживать ISomeSpecificType1?

Возможно, каждый добавленный вами элемент не поддерживает его.

...