How to publish a subcomponent's property in a compound component? - delphi

Question

In a compound component derived from TPanel I'm trying to publish a property whose only pourpose is that to sets and gets a linkage property of a subcomponent. Each time I add my compound component to a form, an access violation is raised:
Access violation at address 12612D86 in module 'MyRuntimePackage.bpl'. Read of address 00000080.
I've prepared a simplified example using a TLabel and its PopupMenu property but I still have the same problem when placing the compound component on a form/frame.
Runtime package:
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;
Designtime package:
procedure Register;
begin
RegisterComponents('MyTestCompoundComponent', [TTestCompoundComponent]);
end;

Answer 1

#kobik's answer explains the root cause of the AV (accessing the FSubCmp.PopupMenu property before FSubCmp is created). However, your entire component code is overly complicated for what you are trying to achieve.
You should be setting your component as the TLabel's Owner, then you can remove your destructor completely. And you should also be calling FSubCmp.SetSubComponent(True) in your constructor (especially if you ever intend to expose the TLabel in the Object Inspector at a later time, so the user can customize its properties at design-time):
constructor TTestCompoundComponent.Create(AOwner : TComponent);
begin
inherited;
FSubCmp := TLabel.Create(Self);
FSubCmp.SetSubComponent(True);
FSubCmp.Parent := Self;
end;
Your Notification() method should be setting FSubCmp.PopupMenu := nil directly in response to opRemove, instead of calling SetLabelPopupMenu(nil). You already know the PopupMenu is assigned and that it is in progress of being destroyed, so the extra code to retrieve the PopupMenu (repeatedly), check it for nil, and call RemoveFreeNotification(), is all overkill for an opRemove operation:
procedure TTestCompoundComponent.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if (Operation = opRemove) and (AComponent = LabelPopupMenu) then
FSubCmp.PopupMenu := nil;
end;
And your SetLabelPopupMenu() method is just an eyesore in general, with all those redundant calls to GetLabelPopupMenu(). Call it only one time and store the returned object pointer to a local variable that you can then use as needed:
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;
However, your Notification() method is actually completely redundant and should be removed altogether. TLabel already calls FreeNotification() on its own PopupMenu property, and has its own Notification() implementation that will set the PopupMenu property to nil if the TPopupMenu object is freed. You don't need to handle this manually at all. And so, all of the extra code in SetLabelPopupMenu() is redundant and should be removed:
procedure TTestCompoundComponent.SetLabelPopupMenu(AValue: TPopupMenu);
begin
FSubCmp.PopupMenu := AValue;
end;
This also means the fix proposed by #kobik is redundant and can be removed as well 1:
function TTestCompoundComponent.GetLabelPopupMenu: TPopupMenu;
begin
Result := FSubCmp.PopupMenu;
end;
1: Unless you want to handle the case where a user decides to free your TLabel directly (which is foolish, and no one would ever really do that in practice, but it is still technically possible), then you would need Notification() to handle that situation (assigning your component as the TLabel's Owner will call FreeNotificatio() for you):
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;
That being said, here is a simplified version of your code:
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;
Or even just this:
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

In GetLabelPopupMenu(), FSubCmp is nil when Notification() receives an opInsert notification during construction before FSubCmp has been created. If FSubCmp is nil, referring to its PopupMenu property will cause the AV. So, you need to check for that in GetLabelPopupMenu(), eg:
if FSubCmp = nil then
Result := nil
else
Result := FSubCmp.PopupMenu;
Otherwise, change the order of the and logic in Notification() to this instead:
if (Operation = opRemove) and (AComponent = GetLabelPopupMenu())
If the condition (Operation = opRemove) is false, the right side condition will not be evaluated (short-circuit).