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.

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

如果您按照 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属性来调用菜单设计器,
>您只能通过选择Object Inspector中的PopupMenu来获取PopupMenu的事件,这只能通过关闭菜单设计器来完成(由于’无法为未命名的组件创建方法’而无法分配这些事件’例外),
>然后你可以修改PopupMenu的名称(顺便说一句,没有任何后果.但你不能将它命名为’Menu’ – 属性的名称 – 因为这将导致’重复的组件名’异常.),
>结构视图将菜单项列为表单的直接子项而不是组件或PopupMenu,
> PopupMenu未显示在结构视图中,
>你不能在代码中命名子组件,也因为’重复组件名称异常'(我想知道为什么顺便说一下; 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中,例如I have done here,但我还没有研究过是否可以从代码中调用菜单设计器.