如何实现 returns 自定义类型的 TVirtualInterface?

How to implement a TVirtualInterface that's returns a custom type?

我如何实现 return 我自己的自定义类型的 TVirtualInterface?

我有以下类型:

TMyType<T> = record
  private
    FValue: TValue;
  public
    class operator Implicit(A: string): TMyType<T>;
    class operator Implicit(A: TMyType<T>): string;
  public
    property Value: TValue read FValue;
  end;

class operator TMyType<T>.Implicit(A: string): TMyType<T>;
begin
  Result.FValue := A;
end;

class operator TMyType<T>.Implicit(A: TMyType<T>): string;
begin
  Result := A.FValue.AsString;
end;

以及以下接口:

IMyInterface = interface(IInvokable)
    ['{97D1F4B8-F448-424B-9BF6-C0E9D037F2D5}']
    function GetName(): TMyType<String>;
  end;

我也有以下接口实现Class:

TMyInterfaceImpl = class(TInterfacedObject, IMyInterface)
  public
    function GetName: TMyType<string>;
  end;

function TMyInterfaceImpl.GetName: TMyType<string>;
begin
  Result := 'function TMyInterfaceImpl.GetName: TMyType<string>';
end;

如果我 运行 下面的代码,效果很好:

procedure TForm1.btnTeste1Click(Sender: TObject);
var
  myIntf: IMyInterface;
begin
  myIntf := TMyInterfaceImpl.Create as IMyInterface;
  ShowMessage(myIntf.GetName);
end;

但是,如果我 运行 以下代码,我得到以下异常:

procedure TForm1.btnTeste2Click(Sender: TObject);
var
  myIntf: IMyInterface;
begin
  myIntf := TVirtualInterface.Create(TypeInfo(IMyInterface),
    procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)
    begin
      Result := 'TVirtualInterface.Create(TypeInfo(IMyInterface), procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)';
    end) as IMyInterface;

  ShowMessage(myIntf.GetName);
end;

异常:EInvalidCast - 无效 class 类型转换。

但是

如果我有以下界面:

IMyInterface2 = interface(IInvokable)
    ['{97D1F4B8-F448-424B-9BF6-C0E9D037F2D5}']
    function GetName(): string;
  end;

以及以下代码:

procedure TForm1.btnTeste3Click(Sender: TObject);
var
  myIntf: IMyInterface2;
begin
  myIntf := TVirtualInterface.Create(TypeInfo(IMyInterface2),
    procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)
    begin
      Result := 'TVirtualInterface.Create(TypeInfo(IMyInterface2), procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)';
    end) as IMyInterface2;

  ShowMessage(myIntf.GetName);
end;

效果很好。

工作代码中缺少什么?

完整代码如下:

unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, System.Rtti;

type
  TForm1 = class(TForm)
    btnTeste1: TButton;
    btnTeste2: TButton;
    btnTeste3: TButton;
    procedure btnTeste1Click(Sender: TObject);
    procedure btnTeste2Click(Sender: TObject);
    procedure btnTeste3Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

type
  TMyType<T> = record
  private
    FValue: TValue;
  public
    class operator Implicit(A: string): TMyType<T>;
    class operator Implicit(A: TMyType<T>): string;
  public
    property Value: TValue read FValue;
  end;

  IMyInterface = interface(IInvokable)
    ['{97D1F4B8-F448-424B-9BF6-C0E9D037F2D5}']
    function GetName(): TMyType<String>;
  end;

  TMyInterfaceImpl = class(TInterfacedObject, IMyInterface)
  public
    function GetName: TMyType<string>;
  end;

  IMyInterface2 = interface(IInvokable)
    ['{97D1F4B8-F448-424B-9BF6-C0E9D037F2D5}']
    function GetName(): string;
  end;

implementation

{$R *.dfm}
{ TMyInterfaceImpl }

function TMyInterfaceImpl.GetName: TMyType<string>;
begin
  Result := 'function TMyInterfaceImpl.GetName: TMyType<string>';
end;

{ TMyType<T> }

class operator TMyType<T>.Implicit(A: string): TMyType<T>;
begin
  Result.FValue := A;
end;

class operator TMyType<T>.Implicit(A: TMyType<T>): string;
begin
  Result := A.FValue.AsString;
end;

procedure TForm1.btnTeste1Click(Sender: TObject);
var
  myIntf: IMyInterface;
begin
  myIntf := TMyInterfaceImpl.Create as IMyInterface;
  ShowMessage(myIntf.GetName);
end;

procedure TForm1.btnTeste2Click(Sender: TObject);
var
  myIntf: IMyInterface;
begin
  myIntf := TVirtualInterface.Create(TypeInfo(IMyInterface),
    procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)
    begin
      Result := 'TVirtualInterface.Create(TypeInfo(IMyInterface), procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)';
    end) as IMyInterface;

  ShowMessage(myIntf.GetName);
end;

procedure TForm1.btnTeste3Click(Sender: TObject);
var
  myIntf: IMyInterface2;
begin
  myIntf := TVirtualInterface.Create(TypeInfo(IMyInterface2),
    procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)
    begin
      Result := 'TVirtualInterface.Create(TypeInfo(IMyInterface2), procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)';
    end) as IMyInterface2;

  ShowMessage(myIntf.GetName);
end;

end.

我正在使用 Delphi 东京 10.2.2

非常感谢

问题我解决了,问题是结果类型,正确的是:

procedure TForm1.btnTeste2Click(Sender: TObject);
var
  myIntf: IMyInterface;
begin
  myIntf := TVirtualInterface.Create(TypeInfo(IMyInterface),
    procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)
    var
      myReturn: TMyType<string>;
    begin
      myReturn.FValue := 'TVirtualInterface.Create(TypeInfo(IMyInterface), procedure(Method: TRttiMethod; const Args: TArray<TValue>; out Result: TValue)';
      Result := TValue.From<TMyType<string>>(myReturn);
    end) as IMyInterface;

  ShowMessage(myIntf.GetName);
end;