Question

概述

我有一个TCustomControl我在Lazarus工作，在本课程之外我有一个单独的TPersistent类，将用于某些属性。

从TPersistent发布的TCustomControl类应该在Object Inspector中显示为子属性，因为我不希望从顶层显示某些属性，基本上这是将一些属性放入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在设计时或运行时永远不会触发或被触发，我无法理解或看到原因？从上面代码SetHeaderOptions中包含的注释中可以看出，它似乎根本没有做任何事情，它从不响应在设计时或运行时所做的更改。

我没有安装Delphi来进行比较或测试，但是代码是从我之前使用过的自定义控件中获取的，而且我非常肯定它应该可以工作，我似乎没有错过了我能看到的一切。我在这一点上唯一的假设是拉撒路和德尔斐的差异，所以问题可能在拉撒路内部？

问题

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

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

Answer 1

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

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

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;

物业制定者似乎永远不会在拉撒路中解雇？

2 个答案: