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

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通知时，FSubCmpnil。 如果FSubCmpnil，引用其PopupMenu属性将导致AV。 因此，您需要在GetLabelPopupMenu()中检查这一点，例如：

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

否则，请将Notification()中and逻辑的顺序更改为以下内容：

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

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