Search code examples
delphidelphi-10.2-tokyo

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


How i implements a TVirtualInterface that's return my own custom type?

I have the follow 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;

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;

And the follow Interface:

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

I have too the follow Interface Implementation Class:

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

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

If i run the follow code, this works great:

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

However, if i run the follow code, i got the follow exception:

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;

Exception: EInvalidCast - Invalid class typecast.

But

If i have the follow Interface:

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

And the follow code:

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;

That's works great.

What's missing in the code to work?

Here is the complete code:

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.

I'm using Delphi Tokyo 10.2.2

Thank you very much


Solution

  • I solved the problem, the problem is the result type, the correct is:

    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;