TPopupMenu作为子组件，序列化TMenuItems

Question

我试图将TPopupMenu作为子组件包含在自定义组件中，如下所示：

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;

问题是TMenuItems没有保存到DFM。 覆盖GetChildren使项目保存，但加载不起作用。

设置SetSubComponent（True）无效，TMenuItems不保存到DFM。

UPD：

我试过了：

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给出“流读取错误”

Answer 1

如果您按照本答案中给出的步骤操作，则代码将变为：

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.

这解决了您的流媒体问题：菜单项被保存到表单文件中并从表单文件中读回。 但是有一些缺点：

1. 你不能将PopupMenu分配给另一个PopupMenu属性，
2. 您只能通过双击组件的Menu属性来调用菜单设计器，
3. 您只能通过选择Object Inspector中的PopupMenu来获取PopupMenu的事件，这只能通过关闭菜单设计器来完成（由于'无法为未命名的组件创建方法'，因此无法分配这些事件' ）
4. 然后你可以修改PopupMenu的名称（顺便说一下，没有任何后果。但你不能将它命名为'Menu' - 属性的名称 - 因为这将导致'重复组件名'异常。），
5. 结构视图将菜单项列为表单的直接子项而不是组件或PopupMenu，
6. PopupMenu未显示在结构视图中，
7. 你不能在代码中命名子组件，也因为'重复组件名称异常' （我想知道为什么顺便说一下; TLabeledEdit标签的命名工作得很好）。

也许另一种方法更好。

---

我可以建议另类设计吗？ 添加ActionList属性而不是PopupMenu属性，并从ActionList内部创建PopupMenu：

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包装在临时Collection中，就像我在这里所做的那样 ，但我还没有研究过你是否可以从代码中调用菜单设计器。