鸭子在Delphi 2007中打字(续)?

问题描述

这是此帖子的后续内容.

我根据在此处发布的接受的答案完善了我的要求.

I refined my requirement based on the accepted answer posted here.

我的* .dpr文件:

program DuckD11;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  uDuckTyping in 'uDuckTyping.pas',
  uBirds in 'uBirds.pas';

procedure DoSomething(AObject: TObject);
begin
  Duck(AObject).Quack;
end;

var
  Bird: TBird;
  Ganagana: TGanagana;
  Canard: TCanard;
begin
  Writeln('Duck typing :');
  Writeln;

  Bird := TBird.Create('Bird');
  try
    DoSomething(Bird);
  finally
    Bird.Free;
  end;

  Ganagana := TGanagana.Create;
  try
    DoSomething(Ganagana);
  finally
    Ganagana.Free;
  end;

  Canard := TCanard.Create;
  try
    DoSomething(Canard);
  finally
    Canard.Free;
  end;

  Readln;
end.

uBirds.pas列表:

unit uBirds;

interface

uses
  SysUtils;

type
  {$METHODINFO ON}
  TBird = class
  private
    FName: string;
  public
    constructor Create(AName: string);
    procedure Quack;
  end;

  TGanagana = class
  private
    const cName = 'Ganagana';
  public
    procedure Quack;
  end;

  TCanard = class
  private
    const cName = 'Canard';
  public
    procedure Quack;
  end;

  {$METHODINFO OFF}

implementation

{ TBird }

constructor TBird.Create(AName: string);
begin
  FName := AName;
end;

procedure TBird.Quack;
begin
  Writeln(Format('  %s->Quack',[Self.FName]));
end;

{ TGanagana }

procedure TGanagana.Quack;
begin
  Writeln(Format('  %s=>Quack',[Self.cName]));
end;

{ TCanard }

procedure TCanard.Quack;
begin
  Writeln(Format('  %s::Quack',[Self.cName]));
end;

end.

我尝试编码uDuckTyping.pas:

unit uDuckTyping;

interface

type
  IDuck = interface
    ['{41780389-7158-49F7-AAA5-A4ED5AE2699E}']
    procedure Quack;
  end;

function Duck(AObject: TObject): IDuck;

implementation

uses
  ObjAuto;

type
  TDuckObject = class(TInterfacedObject, IDuck)
  private
    FObj: TObject;

    // ???

  protected
      procedure Quack;
  public
    constructor Create(AObject: TObject);
  end;

function Duck(AObject: TObject): IDuck;
begin
  Result := TDuckObject.Create(AObject);
end;

{ TDuckObject }

constructor TDuckObject.Create(AObject: TObject);
begin
  FObj := AObject;

  // ???
end;

procedure TDuckObject.Quack;
begin
  // ???
end;

end.

我的问题:

我要使用

• ObjAuto.GetMethodInfo 确定包装的Quack方法的存在.
• ObjAuto.ObjectInvoke 调用包装的Quack方法.

• ObjAuto.GetMethodInfo to ascertain the existence of the wrapped Quack method.
• ObjAuto.ObjectInvoke to invoke the wrapped Quack method.

如何完成代码?

推荐答案

经过多次试用，我最终使它开始工作:

I end up getting it to work after many trial:

uDucktyping.pas单元中的修改:

在 TDuckObject 类定义中作为私有添加的字段

Fields added as private in TDuckObject class definition

FQuackPMethodInfo: PMethodeInfoHeader;
FParamIndexes: array of Integer;
FParams: array of Variant;

---

TDuckObject.Create 实现中的FQuackPMethodInfo的初始化

---

Initialization of FQuackPMethodInfo in TDuckObject.Create implementation

FQuackPMethodInfo := GetMethodInfo(AObject, ShortString('Quack'));

在 FObj 初始化语句之后追加.

To append just after FObj initialization statement.

在 TDuckObject.Quack 实现中的"Quack" 调用

if Assigned(FQuackPMethodInfo) then
  ObjectInvoke(FObj, FQuackPMethodInfo, FParamIndexes, FParams);

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