鸭子打字在Delphi 2007？ [英] Duck typing in Delphi 2007?

问题描述

问题：

有没有办法用Delphi 2007进行鸭式打字（即没有泛型和高级Rtti功能）？ p>

---

鸭子打字Delphi 2010以前的资源：

• Duck Duck Delphi 在google项目中由< a href =http://arcana.sivv.com/duckduckdelphi =nofollow noreferrer> ARCANA 。


• 在Delphi中打鸭子 by Daniele Teti 。


• 通过 Stefan在Delphi中进行AOP和鸭式打字Glienke 。

上次修改：

我已经深入到上面列出的资源中，并在此研究了每个发布的答案。

I最终完善我的要求，为此提出了一个后续发布。 / p>

解决方案

在ObjAuto.pas和可调用变体类型的帮助下，应该是可能的（用XE编写，但也应该运行在Delphi 7或更低）：

  unit DuckTyping; 
 
接口
 
函数Duck（Instance：TObject）：Variant; 
 
实现
 
使用
 ObjAuto，
 SysUtils，
 TypInfo，
变体; 
 
 type 
 TDuckVarData =打包记录
 VType：TVarType; 
保留1，保留2，保留3：字; 
 VDuck：TObject; 
 Reserved4：LongWord; 
结束
 
 TDuckVariantType = class（TPublishableVariantType）
 protected 
 function GetInstance（const V：TVarData）：TObject;覆盖
 public 
程序清除（var V：TVarData）;覆盖
程序复制（var Dest：TVarData; const Source：TVarData; 
 const Indirect：Boolean）;覆盖
函数DoFunction（var Dest：TVarData; const V：TVarData; 
 const名称：string; const参数：TVarDataArray）：Boolean;覆盖
结束
 
 $ var 
 DuckVariantType：TDuckVariantType; 
 
 {TDuckVariantType} 
 
程序TDuckVariantType.Clear（var V：TVarData）; 
 begin 
 V.VType：= varEmpty; 
 TDuckVarData（V）.VDuck：= nil; 
结束
 
程序TDuckVariantType.Copy（var Dest：TVarData; const Source：TVarData; 
 const Indirect：Boolean）; 
 begin 
如果间接和VarDataIsByRef（Source）然后
 VarDataCopyNoInd（Dest，Source）
 else 
 begin 
 with TDuckVarData（Dest）do 
 begin 
 VType：= VarType; 
 VDuck：= TDuckVarData（Source）.VDuck; 
结束
结束
结束
 
函数TDuckVariantType.DoFunction（var Dest：TVarData; const V：TVarData; 
 const名称：string; const参数：TVarDataArray）：Boolean; 
 var 
 instance：TObject; 
 methodInfo：PMethodInfoHeader; 
 paramIndexes：Integer数组; 
 params：Variant数组; 
 i：整数; 
 ReturnValue：Variant; 
 begin 
 instance：= GetInstance（V）; 
 methodInfo：= GetMethodInfo（instance，ShortString（Name））; 
结果：=已分配（methodInfo）; 
 if Result then 
 begin 
 SetLength（paramIndexes，Length（Arguments））; 
 SetLength（params，Length（Arguments））; 
 for i：= Low（Arguments）to High（Arguments）do 
 begin 
 paramIndexes [i]：= i + 1; 
 params [i]：= Variant（Arguments [i]）; 
结束
 
 ReturnValue：= ObjectInvoke（instance，methodInfo，paramIndexes，params）; 
如果不是VarIsEmpty（ReturnValue）然后
 VarCopy（Variant（Dest），ReturnValue）; 
 end 
 else 
 begin 
 VarClear（Variant（Dest））; 
结束
结束
 
函数TDuckVariantType.GetInstance（const V：TVarData）：TObject; 
 begin 
结果：= TDuckVarData（V）.VDuck; 
结束
 
函数Duck（Instance：TObject）：Variant; 
 begin 
 TDuckVarData（Result）.VType：= DuckVariantType.VarType; 
 TDuckVarData（Result）.VDuck：= Instance; 
结束
 
初始化
 DuckVariantType：= TDuckVariantType.Create; 
 
 finalization 
 FreeAndNil（DuckVariantType）; 
 
结束。 
  

您可以直接使用它：

  type 
 {$ METHODINFO ON} 
 TDuck = class 
 public //在XE中工作，不知道是否需要在旧版本中发布
程序Quack; 
结束
 
程序TDuck.Quack; 
 begin 
 ShowMessage（'Quack'）; 
结束
 
程序DoSomething（D：Variant）; 
 begin 
 D.Quack; 
结束
 
 var 
 d：TDuck; 
 begin 
 d：= TDuck.Create; 
 try 
 DoSomething（Duck（d））; 
 finally 
 d.Free; 
结束
结束
  

Question:

Is there a way to do duck typing with Delphi 2007 (i.e. without generics and advanced Rtti features)?

---

Duck typing Resources for Delphi 2010 onward:

• Duck Duck Delphi in google project by ARCANA.
• Duck Typing in Delphi by Daniele Teti.
• AOP and duck typing in Delphi by Stefan Glienke.

Last Edit:

I've delved more into the resouces listed above and studied every posted answers here.

I end up refining my requirement a made a follow up post to this question.

解决方案

With the help of the ObjAuto.pas and invokable variant types it should be possible (written in XE but should also run in Delphi 7 or lower):

unit DuckTyping;

interface

function Duck(Instance: TObject): Variant;

implementation

uses
  ObjAuto,
  SysUtils,
  TypInfo,
  Variants;

type
  TDuckVarData = packed record
    VType: TVarType;
    Reserved1, Reserved2, Reserved3: Word;
    VDuck: TObject;
    Reserved4: LongWord;
  end;

  TDuckVariantType = class(TPublishableVariantType)
  protected
    function GetInstance(const V: TVarData): TObject; override;
  public
    procedure Clear(var V: TVarData); override;
    procedure Copy(var Dest: TVarData; const Source: TVarData;
      const Indirect: Boolean); override;
    function DoFunction(var Dest: TVarData; const V: TVarData;
      const Name: string; const Arguments: TVarDataArray): Boolean; override;
  end;

var
  DuckVariantType: TDuckVariantType;

{ TDuckVariantType }

procedure TDuckVariantType.Clear(var V: TVarData);
begin
  V.VType := varEmpty;
  TDuckVarData(V).VDuck := nil;
end;

procedure TDuckVariantType.Copy(var Dest: TVarData; const Source: TVarData;
  const Indirect: Boolean);
begin
  if Indirect and VarDataIsByRef(Source) then
    VarDataCopyNoInd(Dest, Source)
  else
  begin
    with TDuckVarData(Dest) do
    begin
      VType := VarType;
      VDuck := TDuckVarData(Source).VDuck;
    end;
  end;
end;

function TDuckVariantType.DoFunction(var Dest: TVarData; const V: TVarData;
  const Name: string; const Arguments: TVarDataArray): Boolean;
var
  instance: TObject;
  methodInfo: PMethodInfoHeader;
  paramIndexes: array of Integer;
  params: array of Variant;
  i: Integer;
  ReturnValue: Variant;
begin
  instance := GetInstance(V);
  methodInfo := GetMethodInfo(instance, ShortString(Name));
  Result := Assigned(methodInfo);
  if Result then
  begin
    SetLength(paramIndexes, Length(Arguments));
    SetLength(params, Length(Arguments));
    for i := Low(Arguments) to High(Arguments) do
    begin
      paramIndexes[i] := i + 1;
      params[i] := Variant(Arguments[i]);
    end;

    ReturnValue := ObjectInvoke(instance, methodInfo, paramIndexes, params);
    if not VarIsEmpty(ReturnValue) then
      VarCopy(Variant(Dest), ReturnValue);
  end
  else
  begin
    VarClear(Variant(Dest));
  end;
end;

function TDuckVariantType.GetInstance(const V: TVarData): TObject;
begin
  Result := TDuckVarData(V).VDuck;
end;

function Duck(Instance: TObject): Variant;
begin
  TDuckVarData(Result).VType := DuckVariantType.VarType;
  TDuckVarData(Result).VDuck := Instance;
end;

initialization
  DuckVariantType := TDuckVariantType.Create;

finalization
  FreeAndNil(DuckVariantType);

end.

You can simply use it like this:

type
  {$METHODINFO ON}
  TDuck = class
  public // works in XE, not sure if it needs to be published in older versions
    procedure Quack;
  end;

procedure TDuck.Quack;
begin
  ShowMessage('Quack');
end;

procedure DoSomething(D: Variant);
begin
  D.Quack;
end;

var
  d: TDuck;
begin
  d := TDuck.Create;
  try
    DoSomething(Duck(d));
  finally
    d.Free;
  end;
end;

这篇关于鸭子打字在Delphi 2007？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！