分配给 TGetStrProc 事件的常规过程接收空字符串参数

Question

我试图从正常过程中创建一个事件处理程序，就像我一直为 TNotifyEvent 所做的那样，但这似乎不适用于 TGetStrProc。处理程序收到一个空字符串参数。

program ProcAsTGetStrProc;

uses
  System.Classes, Winapi.Windows, System.SysUtils;

type
  TMyObject = class
  strict private
    _onLog: TGetStrProc;
    procedure _log(const msg: string);
  public
    procedure DoTheWork();
    property OnLog: TGetStrProc read _onLog write _onLog;
  end;

procedure mbox(msg: string);
begin
  MessageBox(0, PWideChar(msg), 'Test', 0);
end;

procedure TMyObject.DoTheWork();
begin
  _log('Doing the work');
end;

procedure TMyObject._log(const msg: string);
begin
  mbox(Format('TMyObject._log: "%s"', [msg]));
  if Assigned(_onLog) then _onLog(msg);
end;

procedure ProcLogging(const msg: string);
begin
  mbox(Format('ProcLogging: "%s"', [msg]));
end;

function MakeMethod(Data, Code: Pointer): TMethod;
begin
  Result.Data := Data;
  Result.Code := Code;
end;

var
  obj: TMyObject;

begin
  obj := TMyObject.Create();
  try
    obj.OnLog := TGetStrProc(MakeMethod(nil, @ProcLogging));
    obj.DoTheWork();
  finally
    obj.Free();
  end;
end.

预期输出

TMyObject._log: "Doing the work"

ProcLogging: "Doing the work"

实际输出

TMyObject._log: "Doing the work"

ProcLogging: ""

这里可能有什么问题？

Answer 1

您的独立 ProcLogging() 程序的签名是错误的。

TGetStrProc 声明如下：

TGetStrProc = procedure(const S: string) of object;

of object 引用需要一个非静态 class 方法分配给它，这意味着涉及一个隐式 Self 参数。但是您的 ProcLogging() 过程中没有 Self 参数。

在幕后，of object 是使用 TMethod 记录实现的，其中 TMethod.Code 是指向方法实现代码开始的指针，而 TMethod.Data是方法的 Self 参数的值。

声明

if Assigned(_onLog) then _onLog(msg);

大致相当于：

if _onLog.Code <> nil then _onLog.Code(_onLog.Data, msg);

因此，当您直接使用TMethod调用独立过程时，您必须显式声明Self参数才能正确接收TMethod.Data值和后续参数，例如：

procedure ProcLogging(Self: Pointer; const msg: string);
begin
  mbox(Format('ProcLogging: "%s"', [msg]));
end;

您分配给 TMethod.Data 字段的任何内容都将按原样传递给 Self 参数。在此上下文中指定 nil（如您所愿）是有效的，只要独立过程不将其用于任何用途即可。

或者，您可以使用非实例 class 方法而不是独立过程。 class 方法也有一个隐含的 Self 参数（接收指向 class 类型的指针而不是指向对象实例的指针），因此与 of object 兼容。但是，class 方法可以按原样分配给 of object 引用，因此您不必直接使用 TMethod 来解决问题，例如：

type
  TLog = class
  public
    class procedure ProcLogging(const msg: string);
  end;

class procedure TLog.ProcLogging(const msg: string);
begin
  mbox(Format('ProcLogging: "%s"', [msg]));
end;

...
obj.OnLog := TLog.ProcLogging;
...

分配给 TGetStrProc 事件的常规过程接收空字符串参数

A regular procedure assigned to TGetStrProc event receives an empty string parameter

delphi

event-handling

delphi-xe5