如何实现 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;
我如何实现 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;