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属性, 也许另一种方法更好. 我可以建议另类设计吗?添加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,但我还没有研究过是否可以从代码中调用菜单设计器. (编辑:李大同) 【声明】本站内容均来自网络,其相关言论仅代表作者个人观点,不代表本站立场。若无意侵犯到您的权利,请及时与联系站长删除相关内容! |