如何修改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()时，您需要查看其MenuItem属性当前正在编辑的TMenuItemSelector对象，看看该对象是否分配了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.