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。

更新：

我试过：

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 给出 "Stream read error"

Answer 1

如果按照this answer中给出的步骤进行操作，则代码变为：

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 的事件，这只能通过关闭菜单设计器来完成（并且由于 [ 而无法分配这些事件=53=]例外),
然后您可以修改 PopupMenu 的名称（顺便说一句，没有任何后果。但是您不能将其命名为 'Menu' - 属性的名称 - 因为这将导致'duplicate component name'例外。),
结构视图将菜单项列为表单的直接子项，而不是组件或 PopupMenu 的子项，
PopupMenu 未显示在结构视图中，
你不能在代码中命名子组件，也是因为一个'duplicate component name exception'（顺便问一下为什么；标签的命名在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 包装在临时集合中，例如我 have done here，但我还没有研究是否可以从代码中调用菜单设计器。

TPopupMenu 作为子组件，序列化 TMenuItems

TPopupMenu as subcomponent, serializing TMenuItems

delphi

serialization

components