Question

我正在尝试扩展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;

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

还有更多想法或解释吗？

Answer 1

Delphi中的虚方法调度已知有效。因此，如果TExtDispatch.GetPropInfo没有被执行，那么这些可能是原因：

根本没有调用GetPropInfo方法。
调用GetPropInfo的实际实例不是TExtDispatch的实例。

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

调用GetPropInfo的唯一地方是GetIDsOfNames。如果被覆盖的GetIDsOfNames未调用GetPropInfo，那么其他任何内容都不会。

考虑到您更新的代码，我在调试器下运行它。单击该按钮时，将调用TObjectDispatch.GetPropInfo两次。第一次在inherited GetPropInfo()中调用TExtDispatch.GetPropInfo时调用它。第二次调用它时，您可以检查ClassName以找出类Self。执行此操作后，您会发现ClassName的评估结果为'TObjectDispatch'。在这种情况下，我的清单中的第2项是解释。

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

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

当您将TInterfacedObject构造函数的返回值分配给对象引用时，应该会发出警报响铃。这总是一个错误。您必须将其分配给接口引用。

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

永远不会在TObjectDispatch上调用受保护方法的覆盖

1 个答案: