delphi - TPopupMenu 作为子组件，序列化 TMenuItems

我正在尝试将 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 给出“流读取错误”

最佳答案

如果您按照 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 的事件，这只能通过关闭菜单设计器来完成(并且由于“无法为未命名的组件创建方法”而无法分配这些事件)异常(exception))，

然后您可以修改 PopupMenu 的名称(顺便说一下，没有任何后果。但是您不能将其命名为“Menu” - 属性的名称 - 因为这将导致“重复组件名称”异常。)，

结构 View 将菜单项列为窗体的直接子项，而不是组件或 PopupMenu 的子项，

PopupMenu 没有显示在结构 View 中，

你不能在代码中命名子组件，也是因为“重复的组件名称异常”(我想知道为什么；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 包装在临时集合中，例如 I have done here，但我还没有研究是否可以从代码中调用菜单设计器。

关于delphi - TPopupMenu 作为子组件，序列化 TMenuItems，我们在Stack Overflow上找到一个类似的问题：https://stackoverflow.com/questions/33893563/