CODEWITHSUNDEEP
delphicomponents
Fabrizio
Fabrizio

Reputation: 8043

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

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;

Upvotes: 2

Views: 781

Answers (2)

Remy Lebeau
Remy Lebeau

Reputation: 595827

@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;

Upvotes: 8

kobik
kobik

Reputation: 21242

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).

Upvotes: 5

Related Questions