delphi - 无法调用类中声明的方法实现通用接口(interface)方法

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类实现两个接口(interface):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 运算符需要接口(interface) GUID 才能知道您引用的是哪个接口(interface)。由于通用接口(interface)共享相同的 GUID as 运算符将无法使用它们。基本上，编译器无法区分 IVisitor 和 IVisitor 接口(interface)之间的区别。

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

这里是扩展的访问者接口(interface)和类，可以对非类类型进行操作。我只实现了对字符串的调用，但其他类型的实现仅包含具有不同类型转换的复制粘贴代码。

  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;