TPopupMenu as subcomponent, serializing TMenuItems

Question

I am trying to include TPopupMenu as subcomponent into custom component like this:

interface

  TComp1 = class(TComponent)
  private
    FMenu: TPopupMenu;
  protected
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Menu: TPopupMenu read FMenu;
  end;

implementation

  constructor TComp1.Create(AOwner: TComponent);
  begin
    inherited Create(AOwner);
    FMenu := TPopupMenu.Create(Self);
    FMenu.Name := 'Menu1';
    //FMenu.SetSubComponent(True);
  end;

  procedure TComp1.GetChildren(Proc: TGetChildProc; Root: TComponent);
  begin
    Proc(FMenu);
  end;

The issue is that TMenuItems are not saving to DFM. Overriding GetChildren makes items to save, but loading isn't working.

Setting SetSubComponent(True) has no effect, TMenuItems are not saving to DFM.

UPD:

I have tried:

procedure TComp1.DefineProperties(Filer: TFiler);
begin
  inherited;
  Filer.DefineProperty('Menu', ReadMenuItems, WriteMenuItems, True);
end;

procedure TComp1.WriteMenuItems(Writer: TWriter);
begin
  Writer.WriteComponent(FMenu);
end;

WriteMenuItems gives "Stream read error"

Do you want the menuitems to appear in the form class declaration (in the source editor), or not? — NGLN, Nov 25 '15 at 22:41
I have tried DefineProperies, but it gives "Stream read error" in write method. — Dzirt, Nov 26 '15 at 09:09
I want to create custom component which includes TPopupMenu. Several items in PopupMenu will be created automatically and some of them will be added manually and I want to have the ability to edit MenuItems in Object Inspector. — Dzirt, Nov 26 '15 at 09:12

score 1 · Accepted Answer · edited May 23 '17 at 12:30

If you follow the steps given in this answer, then the code becomes:

interface

uses
  System.Classes, Vcl.Menus;

type
  TMyComponent = class;

  TMyPopupMenu = class(TPopupMenu)
  private
    FParent: TMyComponent;
    procedure SetParent(Value: TMyComponent);
  protected
    procedure SetParentComponent(Value: TComponent); override;
  public
    destructor Destroy; override;
    function GetParentComponent: TComponent; override;
    function HasParent: Boolean; override;
    property Parent: TMyComponent read FParent write SetParent;
  end;

  TMyComponent = class(TComponent)
  private
    FMenu: TPopupMenu;
  protected
    function GetChildOwner: TComponent; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property Menu: TPopupMenu read FMenu;
  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Samples', [TMyComponent]);
end;

{ TMyComponent }

constructor TMyComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FMenu := TMyPopupMenu.Create(Self);
end;

function TMyComponent.GetChildOwner: TComponent;
begin
  Result := Self;
end;

procedure TMyComponent.GetChildren(Proc: TGetChildProc; Root: TComponent);
begin
  inherited GetChildren(Proc, Root);
  Proc(FMenu);
end;

{ TMyPopupMenu }

destructor TMyPopupMenu.Destroy;
begin
  FParent := nil;
  inherited Destroy;
end;

function TMyPopupMenu.GetParentComponent: TComponent;
begin
  Result := FParent;
end;

function TMyPopupMenu.HasParent: Boolean;
begin
  Result := FParent <> nil;
end;

procedure TMyPopupMenu.SetParent(Value: TMyComponent);
begin
  if FParent <> Value then
  begin
    if FParent <> nil then
      FParent.FMenu := nil;
    FParent := Value;
    if FParent <> nil then
      FParent.FMenu := Self;
  end;
end;

procedure TMyPopupMenu.SetParentComponent(Value: TComponent);
begin
  if Value is TMyComponent then
    SetParent(TMyComponent(Value));
end;

initialization
  RegisterClass(TMyPopupMenu);

end.

This solves your streaming issue: the menu items are saved to and read back in from the form file. But there are some disadvantages:

you cannot assign the PopupMenu to another PopupMenu property,
you can only call up the menu designer by double clicking on the Menu property of the component,
you can only get to the events of the PopupMenu by selecting the PopupMenu in the Object Inspector, which can only be done by closing the menu designer(and these events cannot be assigned due to a 'Cannot create a method for an unnamed component' exception),
then you can modify the name of the PopupMenu (with no consequence whatsoever by the way. But you cannot name it 'Menu' - the name of the property - because that will result in a 'duplicate component name' exception.),
the structure view lists the menu items as direct childs of the form instead of the component's or the PopupMenu's,
the PopupMenu is not shown in the structure view,
you cannot name the subcomponent in code, also because of a 'duplicate component name exception' (I wonder why by the way; the naming of the label in TLabeledEdit works just fine).

Maybe another approach works better.

May I suggest an alternative design? Add an ActionList property instead of a PopupMenu property, and let the PopupMenu be created internally from the ActionList:

interface

uses
  System.Classes, Vcl.ActnList, Vcl.Menus;

type
  TAwComponent = class(TComponent)
  private
    FActionList: TCustomActionList;
    FDropDownMenu: TPopupMenu;
    procedure ActionListChanged(Sender: TObject);
    function HasActions: Boolean;
    procedure SetActionList(Value: TCustomActionList);
    procedure SetupDropDownMenu;
  protected
    procedure Loaded; override;
  public
    constructor Create(AOwner: TComponent); override;
  published
    property ActionList: TCustomActionList read FActionList write SetActionList;
  end;

implementation

function SameEvent(A, B: TNotifyEvent): Boolean;
begin
  Result := (TMethod(A).Code = TMethod(B).Code) and
    (TMethod(A).Data = TMethod(B).Data);
end;

{ TAwComponent }

procedure TAwComponent.ActionListChanged(Sender: TObject);
begin
  if Sender = FActionList then
    SetupDropDownMenu;
end;

constructor TAwComponent.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDropDownMenu := TPopupMenu.Create(Self);
end;

function TAwComponent.HasActions: Boolean;
begin
  Result := (FActionList <> nil) and (FActionList.ActionCount > 0);
end;

procedure TAwComponent.Loaded;
begin
  inherited Loaded;
  SetupDropDownMenu;
end;

procedure TAwComponent.SetActionList(Value: TCustomActionList);
begin
  if FActionList <> Value then
  begin
    if FActionList is TActionList then
      if SameEvent(TActionList(FActionList).OnChange, ActionListChanged) then
        TActionList(FActionList).OnChange := nil;
    FActionList := Value;
    if FActionList is TActionList then
      if not Assigned(TActionList(FActionList).OnChange) then
        TActionList(FActionList).OnChange := ActionListChanged;
    SetupDropDownMenu;
  end;
end;

procedure TAwComponent.SetupDropDownMenu;
var
  I: Integer;
  MenuItem: TMenuItem;
begin
  FDropDownMenu.Items.Clear;
  if FActionList <> nil then
  begin
    FDropDownMenu.Images := FActionList.Images;
    for I := 0 to FActionList.ActionCount - 1 do
    begin
      MenuItem := TMenuItem.Create(Self);
      MenuItem.Action := FActionList[I];
      FDropDownMenu.Items.Add(MenuItem);
    end;
  end;
end;

end.

Or setup the PopupMenu outside of your component, and make the property writeable.

You could also try to wrap the MenuItems as CollectionItems in a temporary Collection, like I have done here for example, but I have not researched yet whether you can invoke a menu designer from code.

Great thanx for your time! You helped me a lot! I used the first approach, disadvantages are accepatble. The second option does not fit for me a little bit, ActionList doesn't supports TMenuItems tree structure — Dzirt, Nov 30 '15 at 14:05

TPopupMenu as subcomponent, serializing TMenuItems

1 Answers1