Question

我如何实现一个返回我自己的自定义类型的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;

我也有以下接口实现类：

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 - 无效的类类型转换。

但是

如果我有以下界面：

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 Tokyo 10.2.2

非常感谢

Answer 1

我解决了问题，问题是结果类型，正确的是：

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;

如何实现返回自定义类型的TVirtualInterface？

1 个答案: