TPopupMenu as a subcomponent, TMenuItems serialization

Question

I am trying to include TPopupMenu as a subcomponent in a custom component as follows:

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 problem is that TMenuItems are not saved in DFM. Overriding GetChildren allows you to save items, but loading does not work.

The SetSubComponent (True) setting is not affected, TMenuItems are not saved in DFM.

UPD:

I 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 "Error reading stream"

Answer 1

If you follow the steps outlined in this answer , then the code will look like this:

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.

: . :

• PopupMenu PopupMenu,
• , Menu ,
• PopupMenu, PopupMenu Object Inspector, ( - " " ),
• PopupMenu ( - , , "" - - " " ).
• PopupMenu,
• PopupMenu ,
• , - " " (, , , TLabeledEdit ).

, .

---

? ActionList PopupMenu PopupMenu 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.

PopupMenu .

MenuItems CollectionItems , , , , .