0

我正在尝试扩展 TObjectDispatch 的受保护虚拟方法。但是这个方法永远不会被调用。

[编辑以重现问题]。

当我覆盖 GetPropInfo 并在 TMyDispatch 中使用它时，它按预期工作。被覆盖的方法被调用。但是，当由 TMyDispatch（模拟我的真实世界示例）创建时，不会调用 TMyDispatchItem 上的覆盖方法。

{$METHODINFO ON}

  TExtDispatch = class(TObjectDispatch)
  protected
    function GetPropInfo(const AName: string; var AInstance: TObject;
      var CompIndex: Integer): PPropInfo; override;
  public
    constructor Create;
  end;

  TMyDispatchItem = class(TExtDispatch)
  private
    FItemValue: string;
  public
    procedure ShowItemValue;
  published
    property ItemValue: string read FItemValue write FItemValue;
  end;

  TMyDispatch = class(TExtDispatch)
  public
    function GetItem: TMyDispatchItem;
  private
    FValue: string;
  public
    procedure ShowValue;
  published
    property Value: string read FValue write FValue;
  end;

  {$METHODINFO OFF}

  TTestForm = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  TestForm: TTestForm;

implementation

{$R *.dfm}

procedure TTestForm.Button1Click(Sender: TObject);
var
  V: Variant;
  VI: Variant;
begin
  V := IDispatch(TMyDispatch.Create);
  V.Value := 100; //this calls inherited getpropinfo
  V.ShowValue;

  VI := V.GetItem;
  VI.ItemValue := 5; //this doesn't
  VI.ShowItemValue;
end;

{ TExtDispatch }

constructor TExtDispatch.Create;
begin
  inherited Create(Self, False);
end;

function TExtDispatch.GetPropInfo(const AName: string; var AInstance: TObject;
  var CompIndex: Integer): PPropInfo;
begin
  Result := inherited GetPropInfo(AName, AInstance, CompIndex);
  ShowMessage('GetPropInfo: ' + AName);
end;

{ TMyDispatch }

function TMyDispatch.GetItem: TMyDispatchItem;
begin
  Result := TMyDispatchItem.Create;
end;

procedure TMyDispatch.ShowValue;
begin
  ShowMessage('My dispatch: ' + Value);
end;

{ TMyDispatchItem }

procedure TMyDispatchItem.ShowItemValue;
begin
  ShowMessage('My item value: ' + FItemValue);
end;

end.

实际上，我已经找到了一种解决此问题的方法，方法是将 的数据类型更改TMyDispatch.GetItem为以 Variant 形式返回。像这样：

function TMyDispatch.GetItem: Variant;
begin
   Result := IDispatch(TMyDispatchItem.Create);
end;

现在突然调用了被覆盖的方法。我真的很想了解这里发生了什么。

还有更多的想法或解释吗？

4

1 回答 1

3

众所周知，Delphi 中的虚拟方法分派可以工作。所以，如果TExtDispatch.GetPropInfo没有被执行，那么这些是可能的原因：

  1. 该GetPropInfo方法根本没有被调用。
  2. 被调用的实际实例GetPropInfo不是TExtDispatch.

如果你展示了其余的代码，那么我们可以更确定，但上述选项应该足以让你解决它。

唯一打电话的地方GetPropInfo是GetIDsOfNames。如果您的覆盖GetIDsOfNames没有调用GetPropInfo，那么其他任何东西都不会。

考虑到您更新的代码，我在调试器下运行它。单击按钮时，TObjectDispatch.GetPropInfo会调用两次。第一次调用它是调用inherited GetPropInfo()in 的结果TExtDispatch.GetPropInfo。第二次调用它时，您可以检查ClassName以找出类Self是什么。当你这样做时，你会发现ClassName计算结果为'TObjectDispatch'。在这种情况下，我列表中的第 2 项就是解释。

我真的不明白你想在这里做什么。但是，我怀疑您的问题源于GetItem实施方式。我怀疑它应该是这样的：

function TMyDispatch.GetItem: IDispatch;
begin
  Result := TMyDispatchItem.Create;
end;

TInterfacedObject当您将构造函数的返回值分配给对象引用时，应该已经敲响了警钟。这总是一个错误。您必须将其分配给接口引用。

我希望发生的事情是调度代码IDispatch如果遇到一个，它将使用一个，但如果它找到一个类的实例，而不是创建一个新IDispatch的来完成这项工作。这是第三个实例TObjectDispatch。

于 2013-03-06T14:17:13.873 回答