如何修改TComponentProperty以仅显示下拉列表中的特定项目？

Question

请考虑这样之情况：

我有分量叫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. 

任何人都可以帮助吗？

谢谢。

Answer 1

当TMenuItemProp.GetValues()被调用时，你需要看看TMenuItemSelector对象，其MenuItem酒店目前正在编辑，了解该对象是否具有分配PopupMenu，如果这样的话作为neded循环通过其项目，如：

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，然后实现在仅设计时包TMenuItemProp和Register()是Requires的仅运行时包和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. 

。

unit uMenuItemSelectorEditor; 

interface 

uses 
    Classes, DesignIntf, DesignEditors; 

type 
    TMenuItemSelectorMenuItemProp = class(TComponentProperty) 
    public 
    function GetAttributes: TPropertyAttributes; override; 
    procedure GetValues(Proc: TGetStrProc); override; 
    end;  

procedure Register; 

implementation 

uses 
    Menus, uMenuItemSelector; 

procedure Register; 
begin 
    RegisterComponents('Test', [TMenuItemSelector]); 
    RegisterPropertyEditor(TypeInfo(TMenuItem), TMenuItemSelector, 'MenuItem', TMenuItemSelectorMenuItemProp); 
end; 

{ TMenuItemSelectorMenuItemProp } 

function TMenuItemSelectorMenuItemProp.GetAttributes: TPropertyAttributes; 
begin 
    Result := inherited GetAttributes + [paValueList, paSortList] - [paMultiSelect]; 
end; 

procedure TMenuItemSelectorMenuItemProp.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; 

end.