财产二传手似乎永远不会在拉撒路开火？

Question

概述

我有一个TCustomControl 我正在拉撒路工作，在这个类之外我有一个单独的TPersistent 类，它将用于某些属性。

从TCustomControl 发布的TPersistent 类应该在对象检查器中显示为子属性，因为我不希望某些属性从顶层显示，基本上这是将一些属性放入它自己的TCustomControl 内的组。

这段代码的结构如下：

type
  TMyControlHeaderOptions = class(TPersistent)
  private
    FOnChange: TNotifyEvent;
    FHeight: Integer;
    FVisible: Boolean;
    procedure SetHeight(const Value: Integer);
    procedure SetVisible(const Value: Boolean);
  protected
    procedure Changed;
  public
    constructor Create(AOwner: TComponent); virtual;
    destructor Destroy; override;

    procedure Assign(Source: TPersistent); override;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  published
    property Height: Integer read FHeight write SetHeight default 20;
    property Visible: Boolean read FVisible write SetVisible default True;
  end;

  TMyControl = class(TCustomControl)
  private
    FHeaderOptions: TMyControlHeaderOptions;
    procedure SetHeaderOptions(const Value: TMyControlHeaderOptions);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Align;
    property BorderStyle default bsSingle;
    property HeaderOptions: TMyControlHeaderOptions read FHeaderOptions write SetHeaderOptions;
  end; 

这是TMyControlHeaderOptions的代码：

constructor TMyControlHeaderOptions.Create(AOwner: TComponent);
begin
  FHeight   := 20;
  FVisible  := True;
end;

destructor TMyControlHeaderOptions.Destroy;
begin
  inherited Destroy;
end;

// this method never fires (see TMyControl.SetHeaderOptions)
procedure TMyControlHeaderOptions.Assign(Source: TPersistent);
begin
  if (Source is TMyControlHeaderOptions) then
  begin
    FHeight   := (Source as TMyControlHeaderOptions).Height;
    FVisible  := (Source as TMyControlHeaderOptions).Visible;
  end
  else
    inherited Assign(Source);
end;

procedure TMyControlHeaderOptions.Changed;
begin
  if Assigned(FOnChange) then
  begin
    FOnChange(Self);
  end;
end;

procedure TMyControlHeaderOptions.SetHeight(const Value: Integer);
begin
  if Value <> FHeight then
  begin
    FHeight := Value;
    Changed;
  end;
end;

procedure TMyControlHeaderOptions.SetVisible(const Value: Boolean);
begin
  if Value <> FVisible then
  begin
    FVisible := Value;
    Changed;
  end;
end;

还有TCustomControl 代码：

constructor TMyControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FHeaderOptions    := TMyControlHeaderOptions.Create(Self);
  Self.ControlStyle := Self.ControlStyle + [csAcceptsControls];
  Self.BorderStyle  := bsSingle;
  Self.Height       := 200;
  Self.Width        := 250;
end;

destructor TMyControl.Destroy;
begin
  FHeaderOptions.Free;
  inherited Destroy;
end;

// this method never fires which is why TMyControlHeaderOptions.Assign
// never fires either. So the task is understanding and solving why this
// procedure never gets fired? 
procedure TMyControl.SetHeaderOptions(const Value: TMyControlHeaderOptions);
begin
  FHeaderOptions.Assign(Value);
end;

问题

HeaderOptions 属性永远不会在设计时或运行时触发或被触发，我无法理解或理解为什么不呢？从上面代码中包含的 cmets SetHeaderOptions 可以看出，它似乎根本没有做任何事情，它从不响应在设计时或运行时所做的更改。

我没有安装 Delphi 来进行比较或测试，但代码取自我之前一直在使用的自定义控件，我非常确定它应该可以工作，我似乎没有遗漏任何内容我可以看到。在这一点上我唯一的假设是 Lazarus 和 Delphi 的差异，所以问题可能出在 Lazarus 内部？

问题

所以我的问题是为什么属性设置器 HeaderOptions 永远不会被解雇，可以做些什么来确保它成功？

我感觉到一些简单或明显的东西，但我无法弄清楚它是什么。

Answer 1

当您更改此 TPersistent 中的属性时，它会触发该特定属性的属性设置器。它不应该调用 TPersistent 本身的设置器。这只发生在两种情况下：a) 当 DFM 在创建时流式传输时，或 b) 当您手动为实际 TPersistent 分配新值时。如果您想在任何属性更改时捕获，您需要单独捕获每个属性，可能会触发反馈给其所有者的OnChange 通知事件。这实际上就是 TFont 或 TStrings 之类的工作方式。

查看一些内置类，例如 TFont 和 TStrings - 它们使用名为 OnChange 的 TNotifyEvent 来处理此类更改。

Answer 2

我仍然对为什么这在 Lazarus 中不起作用感到困惑，因为我几乎可以肯定它在 Delphi 中起作用。

与此同时，我设法想出了一个解决方法：

TMyControl = class(TCustomControl)
  private
    FHeaderOptions: TMyControlHeaderOptions;
    procedure HeaderOptionsChanged(Sender: TObject); // added this line
    procedure SetHeaderOptions(const Value: TMyControlHeaderOptions); // removed this procedure
  published
    property Align;
    property BorderStyle default bsSingle;
    property HeaderOptions: TMyControlHeaderOptions read FHeaderOptions write FHeaderOptions; // changed this 
  end;

然后在构造函数中添加这个：

constructor TMyControl.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FHeaderOptions          := TMyControlHeaderOptions.Create(Self);
  FHeaderOptions.OnChange := @HeaderOptionsChanged; // added this line

  Self.ControlStyle := Self.ControlStyle + [csAcceptsControls];
  Self.BorderStyle  := bsSingle;
  Self.Height       := 200;
  Self.Width        := 250;
end;

新的HeaderOptionsChanged 过程的代码：

procedure TMyControl.HeaderOptionsChanged(Sender: TObject);
begin
  // header options changed
  Invalidate;
end;