Невозможно вызвать метод declare в классе реализовать метод общего интерфейса

Question

Поддержка Delphi для IInterface. Я имею последующую конструкцию, используя общий IInterface:

type 
    IVisitor<T> = interface 
    ['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}'] 
    procedure Visit(o: T); 
    end; 

    TMyVisitor = class(TInterfacedObject, IVisitor<TButton>, IVisitor<TEdit>) 
    procedure Visit(o: TButton); overload; 
    procedure Visit(o: TEdit); overload; 
    end; 

implementation 

procedure TMyVisitor.Visit(o: TButton); 
begin 
    ShowMessage('Expected: TButton, Actual: ' + o.ClassName); 
end; 

procedure TMyVisitor.Visit(o: TEdit); 
begin 
    ShowMessage('Expected: TEdit, Actual: ' + o.ClassName); 
end; 

TMyVisitor класса реализовать два интерфейса: IVisitor<TButton> и IVisitor<TEdit>.

Я пытаюсь вызвать методы:

procedure TForm6.Button1Click(Sender: TObject); 
var V: IInterface; 
begin 
    V := TMyVisitor.Create; 
    (V as IVisitor<TButton>).Visit(Button1); 
    (V as IVisitor<TEdit>).Visit(Edit1); 
end; 

Выход у меня есть:

Expected: TEdit, Actual: TButton 
Expected: TEdit, Actual: TEdit 

Видимо, код не вызывает procedure TMyVisitor.Visit(o: TButton), когда выполнить (V as IVisitor<TButton>).Visit(Button1).

Это ошибка в Delphi или я должен избегать реализации нескольких общих IInterface? Все вышеуказанные коды имеют тест в Delphi XE6.

Answer 1

as Оператор требует интерфейса GUID, чтобы иметь возможность указать, с каким интерфейсом вы обращаетесь. Поскольку общие интерфейсы используют один и тот же GUID as, оператор не будет работать с ними. В принципе, компилятор не может отличить IVisitor <TButton> и IVisitor <TEdit> интерфейсов.

Однако, вы можете решить проблему с помощью расширенного RTTI:

type 
    TCustomVisitor = class(TObject) 
    public 
    procedure Visit(Instance: TObject); 
    end; 

    TVisitor = class(TCustomVisitor) 
    public 
    procedure VisitButton(Instance: TButton); overload; 
    procedure VisitEdit(Instance: TEdit); overload; 
    end; 

procedure TCustomVisitor.Visit(Instance: TObject); 
var 
    Context: TRttiContext; 
    CurrentClass: TClass; 
    Params: TArray<TRttiParameter>; 
    ParamType: TRttiType; 
    SelfMethod: TRttiMethod; 
    s: string; 
begin 
    Context := TRttiContext.Create; 
    CurrentClass := Instance.ClassType; 
    repeat 
    s := CurrentClass.ClassName; 
    Delete(s, 1, 1); // remove "T" 
    for SelfMethod in Context.GetType(Self.ClassType).GetMethods('Visit' + s) do 
     begin 
     Params := SelfMethod.GetParameters; 
     if (Length(Params) = 1) then 
      begin 
      ParamType := Params[0].ParamType; 
      if ParamType.IsInstance and (ParamType.AsInstance.MetaclassType = CurrentClass) then 
       begin 
       SelfMethod.Invoke(Self, [Instance]); 
       Exit; 
       end; 
      end; 
     end; 
    CurrentClass := CurrentClass.ClassParent; 
    until CurrentClass = nil; 
end; 

Если вам нужно иметь интерфейс для посетителей вы можете изменить декларации в

type 
    IVisitor = interface 
    ['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}'] 
    procedure Visit(Instance: TObject); 
    end; 

    TCustomVisitor = class(TInterfacedObject, IVisitor) 
    public 
    procedure Visit(Instance: TObject); 
    end; 

Вы можете использовать это в следующем образом, просто вызов «Посещение» и вызывается соответствующий метод «Посещения».

procedure TForm6.Button1Click(Sender: TObject); 
var V: IVisitor; 
begin 
    V := TMyVisitor.Create; 
    V.Visit(Button1); 
    V.Visit(Edit1); 
end; 

Приведенный выше код основан на коде Уве Раабе и вы можете прочитать больше http://www.uweraabe.de/Blog/?s=visitor

А вот расширенный интерфейс для посетителей и класс, который может работать на типы неклассовых. Я реализовал только вызовы для строки, но реализация для других типов состоит только из кода копирования-вставки с различным типом.

IVisitor = interface 
    ['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}'] 
    procedure Visit(const Instance; InstanceType: PTypeInfo); 
    procedure VisitObject(Instance: TObject); 
    end; 

    TCustomVisitor = class(TInterfacedObject, IVisitor) 
    public 
    procedure Visit(const Instance; InstanceType: PTypeInfo); 
    procedure VisitObject(Instance: TObject); 
    end; 

procedure TCustomVisitor.Visit(const Instance; InstanceType: PTypeInfo); 
var 
    Context: TRttiContext; 
    Params: TArray<TRttiParameter>; 
    ParamType: TRttiType; 
    SelfMethod: TRttiMethod; 
begin 
    Context := TRttiContext.Create; 
    case InstanceType.Kind of 
    tkClass : VisitObject(TObject(Instance)); 
    // template how to implement calls for non-class types 
    tkUString : 
     begin 
     for SelfMethod in Context.GetType(Self.ClassType).GetMethods('VisitString') do 
      begin 
      Params := SelfMethod.GetParameters; 
      if (Length(Params) = 1) then 
       begin 
       ParamType := Params[0].ParamType; 
       if ParamType.TypeKind = tkUString then 
        begin 
        SelfMethod.Invoke(Self, [string(Instance)]); 
        Exit; 
        end; 
       end; 
      end; 
     end; 
    end; 
end; 

procedure TCustomVisitor.VisitObject(Instance: TObject); 
var 
    Context: TRttiContext; 
    CurrentClass: TClass; 
    Params: TArray<TRttiParameter>; 
    ParamType: TRttiType; 
    SelfMethod: TRttiMethod; 
    s: string; 
begin 
    Context := TRttiContext.Create; 
    CurrentClass := Instance.ClassType; 
    repeat 
    s := CurrentClass.ClassName; 
    Delete(s, 1, 1); // remove "T" 
    for SelfMethod in Context.GetType(Self.ClassType).GetMethods('Visit' + s) do 
     begin 
     Params := SelfMethod.GetParameters; 
     if (Length(Params) = 1) then 
      begin 
      ParamType := Params[0].ParamType; 
      if ParamType.IsInstance and (ParamType.AsInstance.MetaclassType = CurrentClass) then 
       begin 
       SelfMethod.Invoke(Self, [Instance]); 
       Exit; 
       end; 
      end; 
     end; 
    CurrentClass := CurrentClass.ClassParent; 
    until CurrentClass = nil; 
end; 

Enhanced посетителей можно использовать так:

TVisitor = class(TCustomVisitor) 
    public 
    procedure VisitButton(Instance: TButton); overload; 
    procedure VisitEdit(Instance: TEdit); overload; 
    procedure VisitString(Instance: string); overload; 
    end; 


var 
    v: IVisitor; 
    s: string; 
begin 
    s := 'this is string'; 
    v := TVisitor.Create; 

    // class instances can be visited directly via VisitObject 
    v.VisitObject(Button1); 

    v.Visit(Edit1, TypeInfo(TEdit)); 
    v.Visit(s, TypeInfo(string)); 
end; 

Answer 2

Это хорошо известная проблема с общими интерфейсами. Вот твое:

type 
    IVisitor<T> = interface 
    ['{9C353AD4-6A3A-44FD-B924-39B86A4CB14D}'] 
    procedure Visit(o: T); 
    end; 

Теперь оператор as реализован на вершине GUID, заданный для интерфейса. Когда вы пишете:

(V as IVisitor<TButton>).Visit(Button1); 
(V as IVisitor<TEdit>).Visit(Edit1); 

как оператор as может различать IVisitor<TButton> и IVisitor<TEdit>? Вы указали только один идентификатор GUID. Фактически, когда это происходит, все созданные экземпляры на основе этого общего интерфейса имеют один и тот же идентификатор GUID. И поэтому, пока оператор as компилируется, а код выполняется, поведение во время выполнения не определено. Фактически вы определяете несколько интерфейсов и даете им все тот же идентификатор GUID.

Итак, основная проблема заключается в том, что оператор as несовместим с общими интерфейсами. Вам нужно будет найти другой способ реализовать это. Вы можете подумать о проекте Spring4D для вдохновения.