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

Question

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

模块"MyRuntimePackage.bpl"中地址为12612D86的访问冲突.读取地址00000080.

我已经准备了一个使用a 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.PopupMenu在FSubCmp创建之前访问该属性).但是,您的整个组件代码对于您要实现的目标而言过于复杂.

您应该将组件设置为TLabels Owner,然后可以完全删除析构函数.您还应该FSubCmp.SetSubComponent(True)在构造函数中调用(特别是如果您打算TLabel稍后在Object Inspector中公开它,那么用户可以在设计时自定义其属性):

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已经调用FreeNotification()了自己的PopupMenu属性,并且有自己的Notification()实现,如果释放了对象,则会将PopupMenu属性设置为.您根本不需要手动处理.因此,所有额外的代码都是多余的,应该删除:nilTPopupMenuSetLabelPopupMenu()

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(),FSubCmp是nil当Notification()接收到一个opInsert前施工期间通知FSubCmp已创建.如果FSubCmp是nil,指其PopupMenu属性将导致AV.所以,你需要检查一下GetLabelPopupMenu(),例如:

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

否则,将and逻辑顺序Notification()改为:

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

如果条件(Operation = opRemove)为假,则不评估右侧条件(短路).