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

Question

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

Access violation at address 12612D86 in module 'MyRuntimePackage.bpl'. Read of address 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，而不是调用设置标签弹出菜单(无)。您已经知道 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;