请考虑这样的场景:
我有一个名为TMenuItemSelector
的组件,它有两个已发布的属性:PopupMenu
- 允许从表单中选择TPopupMenu
的实例,MenuItem
允许选择表单中TMenuItem
的任何实例。
我想修改MenuItem
属性的属性编辑器,以便在分配PopupMenu
时,只有PopupMenu
中的菜单项才会显示在下拉列表中。
我知道我需要编写自己的TComponentProperty
后代并覆盖GetValues
方法。问题是我不知道如何访问TMenuItemSelector
所在的表单。
原始TComponentProperty
正在使用此方法迭代所有可用实例:
procedure TComponentProperty.GetValues(Proc: TGetStrProc);
begin
Designer.GetComponentNames(GetTypeData(GetPropType), Proc);
end;
但是,Designer
似乎是预先编译的,所以我不知道GetComponentNames
是如何工作的。
这是我到目前为止所做的,我想我唯一遗漏的是GetValues
的实现:
unit uMenuItemSelector;
interface
uses
Classes, Menus, DesignIntf, DesignEditors;
type
TMenuItemSelector = class(TComponent)
private
FPopupMenu: TPopUpMenu;
FMenuItem: TMenuItem;
procedure SetPopupMenu(const Value: TPopUpMenu);
procedure SetMenuItem(const Value: TMenuItem);
published
property PopupMenu: TPopUpMenu read FPopupMenu write SetPopupMenu;
property MenuItem: TMenuItem read FMenuItem write SetMenuItem;
end;
type
TMenuItemProp = class(TComponentProperty)
public
function GetAttributes: TPropertyAttributes; override;
procedure GetValues(Proc: TGetStrProc); override;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterPropertyEditor(TypeInfo(TMenuItem), TMenuItemSelector, 'MenuItem', TMenuItemProp);
RegisterComponents('Test', [TMenuItemSelector]);
end;
{ TMenuItemSelector }
procedure TMenuItemSelector.SetMenuItem(const Value: TMenuItem);
begin
FMenuItem := Value;
end;
procedure TMenuItemSelector.SetPopupMenu(const Value: TPopUpMenu);
begin
FPopupMenu := Value;
end;
{ TMenuItemProperty }
function TMenuItemProp.GetAttributes: TPropertyAttributes;
begin
Result := inherited GetAttributes + [paValueList, paSortList];
end;
procedure TMenuItemProp.GetValues(Proc: TGetStrProc);
begin
//How to filter MenuItems from the form in a way that only
//MenuItems which belong to TMenuItemSelector.PopupMenu are displayed? \
//And how to get to that form?
//inherited;
end;
end.
任何人都可以提供帮助吗?
感谢。
答案 0 :(得分:7)
调用TMenuItemProp.GetValues()
时,您需要查看当前正在编辑TMenuItemSelector
属性的MenuItem
对象,查看该对象是否已分配PopupMenu
,并且如果是这样,那么循环遍历其项目,例如:
procedure TMenuItemProp.GetValues(Proc: TGetStrProc);
var
Selector: TMenuItemSelector;
I: Integer;
begin
Selector := GetComponent(0) as TMenuItemSelector;
if Selector.PopupMenu <> nil then
begin
with Selector.PopupMenu.Items do
begin
for I := 0 to Count-1 do
Proc(Designer.GetComponentName(Items[I]));
end;
end else
inherited GetValues(Proc);
end;
顺便说一句,您需要在单独的包中实施TMenuItemSelector
和TMenuItemProp
。除了RegisterComponents()
函数(在运行时包中实现)之外,不允许将设计时代码编译为运行时可执行文件。这是针对EULA的,Embarcadero的设计时间版本不允许分发。您需要在仅运行时的包中实现TMenuItemSelector
,然后在仅{4}运行时包和{TMenuItemProp
的仅限设计时的包中实现Register()
和Requires
1}}声明uses
的单位,例如:
TMenuItemSelector
unit uMenuItemSelector;
interface
uses
Classes, Menus;
type
TMenuItemSelector = class(TComponent)
private
FPopupMenu: TPopUpMenu;
FMenuItem: TMenuItem;
procedure SetPopupMenu(const Value: TPopUpMenu);
procedure SetMenuItem(const Value: TMenuItem);
protected
procedure Notification(AComponent: TComponent; Operation: TOperation); override;
published
property PopupMenu: TPopUpMenu read FPopupMenu write SetPopupMenu;
property MenuItem: TMenuItem read FMenuItem write SetMenuItem;
end;
implementation
{ TMenuItemSelector }
procedure TMenuItemSelector.Notification(AComponent: TComponent; Operation: TOperation);
begin
inherited;
if Operation = opRemove then
begin
if AComponent = FPopupMenu then
begin
FPopupMenu := nil;
FMenuItem := nil;
end
else if AComponent = FMenuItem then
begin
FMenuItem := nil;
end;
end;
end;
procedure TMenuItemSelector.SetMenuItem(const Value: TMenuItem);
begin
if FMenuItem <> Value then
begin
if FMenuItem <> nil then FMenuItem.RemoveFreeNotification(Self);
FMenuItem := Value;
if FMenuItem <> nil then FMenuItem.FreeNotification(Self);
end;
end;
procedure TMenuItemSelector.SetPopupMenu(const Value: TPopUpMenu);
begin
if FPopupMenu <> Value then
begin
if FPopupMenu <> nil then FPopupMenu.RemoveFreeNotification(Self);
FPopupMenu := Value;
if FPopupMenu <> nil then FPopupMenu.FreeNotification(Self);
SetMenuItem(nil);
end;
end;
end.