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

这是通用接口的众所周知的问题。这是你的：

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项目的灵感。

Answer 2

as运算符需要接口GUID才能告诉您引用的接口。由于通用接口共享相同的GUID as运算符将无法使用它们。基本上，编译器无法区分IVisitor＆lt; TButton＆gt;和IVisitor＆lt; TEdit＆gt;接口

但是，您可以使用增强型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;

然后您可以按照以下方式使用它，只需调用Visit，就会调用相应的Visit方法。

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

以上代码基于Uwe Raabe的代码，您可以阅读更多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;

增强型访问者可以像这样使用：

  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;

无法在类实现泛型接口方法中调用方法声明

2 个答案: