如何在复合组件中发布子组件的属性？

Question

在从TPanel 派生的复合组件中，我试图发布一个属性，其唯一目的是设置和获取子组件的链接属性。每次我将复合组件添加到表单时，都会引发访问冲突：

模块“MyRuntimePackage.bpl”中地址 12612D86 的访问冲突。读取地址 00000080。

我已经准备了一个使用TLabel 及其PopupMenu 属性的简化示例，但是在将复合组件放置在表单/框架上时仍然遇到同样的问题。

运行时包：

uses
  StdCtrls, Menus, ExtCtrls, Classes;

type
  TTestCompoundComponent = class(TPanel)
  private
    FSubCmp : TLabel;
    function    GetLabelPopupMenu() : TPopupMenu;
    procedure   SetLabelPopupMenu(AValue : TPopupMenu);
  protected
    procedure   Notification(AComponent: TComponent; Operation: TOperation); override;
  public
    constructor Create(AOwner : TComponent); override;
    destructor  Destroy(); override;
  published
    property    LabelPopupMenu : TPopupMenu read GetLabelPopupMenu write SetLabelPopupMenu;
  end;

...

function    TTestCompoundComponent.GetLabelPopupMenu() : TPopupMenu;
begin
  Result := FSubCmp.PopupMenu;
end;

procedure   TTestCompoundComponent.SetLabelPopupMenu(AValue : TPopupMenu);
begin
  if(GetLabelPopupMenu() <> AValue) then
  begin
    if(GetLabelPopupMenu() <> nil)
    then GetLabelPopupMenu().RemoveFreeNotification(Self);

    FSubCmp.PopupMenu := AValue;

    if(GetLabelPopupMenu() <> nil)
    then GetLabelPopupMenu().FreeNotification(Self);
  end;
end;

procedure   TTestCompoundComponent.Notification(AComponent: TComponent; Operation: TOperation);
begin      
  inherited;
  if((AComponent = GetLabelPopupMenu()) AND (Operation = opRemove))
  then SetLabelPopupMenu(nil);
end;

constructor TTestCompoundComponent.Create(AOwner : TComponent);
begin
  inherited;
  FSubCmp := TLabel.Create(nil);
  FSubCmp.Parent := Self;
end;

destructor TTestCompoundComponent.Destroy();
begin
  FSubCmp.Free;
  inherited;
end;

设计时包：

procedure Register;
begin
  RegisterComponents('MyTestCompoundComponent', [TTestCompoundComponent]);
end;

Answer 1

@kobik 的回答解释了 AV 的根本原因（在创建 FSubCmp 之前访问 FSubCmp.PopupMenu 属性）。但是，对于您要实现的目标，您的整个组件代码过于复杂。

您应该将您的组件设置为TLabel 的Owner，然后您可以完全删除您的析构函数。您还应该在构造函数中调用FSubCmp.SetSubComponent(True)（特别是如果您打算稍后在对象检查器中公开TLabel，以便用户可以在设计时自定义其属性）：

constructor TTestCompoundComponent.Create(AOwner : TComponent);
begin
  inherited;
  FSubCmp := TLabel.Create(Self);
  FSubCmp.SetSubComponent(True);
  FSubCmp.Parent := Self;
end;

您的Notification() 方法应该直接设置FSubCmp.PopupMenu := nil 以响应opRemove，而不是调用SetLabelPopupMenu(nil)。您已经知道分配了PopupMenu，并且它正在被销毁，因此检索PopupMenu（重复）的额外代码，检查nil，并调用RemoveFreeNotification()，对于opRemove 操作：

procedure TTestCompoundComponent.Notification(AComponent: TComponent; Operation: TOperation);
begin      
  inherited;
  if (Operation = opRemove) and (AComponent = LabelPopupMenu) then
    FSubCmp.PopupMenu := nil;
end;

而您的 SetLabelPopupMenu() 方法通常只是一个令人眼花缭乱的方法，所有这些对 GetLabelPopupMenu() 的冗余调用。只调用一次并将返回的对象指针存储到一个局部变量中，然后您可以根据需要使用它：

procedure TTestCompoundComponent.SetLabelPopupMenu(AValue: TPopupMenu);
var
  PM: TPopupMenu;
begin
  PM := LabelPopupMenu;

  if (PM <> AValue) then
  begin
    if (PM <> nil) then
      PM.RemoveFreeNotification(Self);

    FSubCmp.PopupMenu := AValue;

    if (AValue <> nil) then
      AValue.FreeNotification(Self);
  end;
end;

但是，您的 Notification() 方法实际上是完全多余的，应该完全删除。 TLabel 已经在它自己的 PopupMenu 属性上调用了 FreeNotification()，并且有它自己的 Notification() 实现，如果 TPopupMenu 对象被释放，它会将 PopupMenu 属性设置为 nil。您根本不需要手动处理。因此，SetLabelPopupMenu() 中的所有额外代码都是多余的，应该删除：

procedure TTestCompoundComponent.SetLabelPopupMenu(AValue: TPopupMenu);
begin
  FSubCmp.PopupMenu := AValue;
end;

这也意味着@kobik 提出的修复是多余的，也可以删除¹：

function TTestCompoundComponent.GetLabelPopupMenu: TPopupMenu;
begin
  Result := FSubCmp.PopupMenu;
end;

¹：除非您想处理用户决定直接释放您的TLabel 的情况（这是愚蠢的，实际上没有人会真正这样做，但它仍然是技术上可行），那么您将需要Notification() 来处理这种情况（将您的组件分配为TLabel 的Owner 将为您调用FreeNotificatio()）：

function TTestCompoundComponent.Notification(AComponent: TComponent; Opration: TOperation);
begin
  inherited;
  if (Operation = opRemove) and (AComponent = FSubCmp) then
    FSubCmp := nil;
end;

function TTestCompoundComponent.GetLabelPopupMenu: TPopupMenu;
begin
  if FSubCmp <> nil then
    Result := FSubCmp.PopupMenu
  else
    Result := nil;
end;

话虽如此，这里是您的代码的简化版本：

uses
  StdCtrls, Menus, ExtCtrls, Classes;

type
  TTestCompoundComponent = class(TPanel)
  private
    FSubCmp: TLabel;
    function GetLabelPopupMenu: TPopupMenu;
    procedure SetLabelPopupMenu(AValue: TPopupMenu);
  public
    constructor Create(AOwner: TComponent); override;
  published
    property LabelPopupMenu: TPopupMenu read GetLabelPopupMenu write SetLabelPopupMenu;
  end;

...

constructor TTestCompoundComponent.Create(AOwner : TComponent);
begin
  inherited;
  FSubCmp := TLabel.Create(Self);
  FSubCmp.SetSubComponent(True);
  FSubCmp.Parent := Self;
end;

function TTestCompoundComponent.GetLabelPopupMenu: TPopupMenu;
begin
  Result := FSubCmp.PopupMenu;
end;

procedure TTestCompoundComponent.SetLabelPopupMenu(AValue: TPopupMenu);
begin
  FSubCmp.PopupMenu := AValue;
end;

甚至只是这样：

uses
  StdCtrls, Menus, ExtCtrls, Classes;

type
  TTestCompoundComponent = class(TPanel)
  private
    FSubCmp: TLabel;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property SubLabel: TLabel read FSubCmp;
  end;

...

constructor TTestCompoundComponent.Create(AOwner : TComponent);
begin
  inherited;
  FSubCmp := TLabel.Create(Self);
  FSubCmp.SetSubComponent(True);
  FSubCmp.Parent := Self;
end;

Answer 2

在GetLabelPopupMenu() 中，当Notification() 在FSubCmp 创建之前在构造期间收到opInsert 通知时，FSubCmp 是nil。如果FSubCmp 是nil，则引用其PopupMenu 属性将导致AV。所以，你需要在GetLabelPopupMenu() 中检查，例如：

if FSubCmp = nil then 
  Result := nil
else 
  Result := FSubCmp.PopupMenu;

否则，将Notification() 中and 逻辑的顺序改为：

if (Operation = opRemove) and (AComponent = GetLabelPopupMenu())

如果条件(Operation = opRemove) 为假，则不会评估右侧条件（短路）。