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

问题描述

请考虑这样的场景：

我有一个名为 TMenuItemSelector 的组件，该组件具有两个已发布的属性： PopupMenu -允许从窗体和 MenuItem 中选择 TPopupMenu 的实例允许从表单中选择 TMenuItem 的任何实例。

I have component called TMenuItemSelector which has two published properties: PopupMenu - allows to pick an instance of TPopupMenu from the form and MenuItem which allows to pick any instance of TMenuItem from the form.

我想要修改 MenuItem 属性的属性编辑器，方法是在分配 PopupMenu 时，仅此<$ c中的菜单项$ c> PopupMenu 在下拉列表中可见。

I would like to modify property editor for MenuItem property in a way that when PopupMenu is assigned then only menu items from this PopupMenu are visible in a drop down list.

我知道我需要编写自己的 TComponentProperty 并覆盖 GetValues 方法。问题是我不知道如何访问 TMenuItemSelector 所在的表单。

I know that I need to write my own descendant of TComponentProperty and override GetValues method. The problem is that I do not know how to access the form on which TMenuItemSelector is lying.

原始 TComponentProperty 使用此方法来迭代所有可用实例：

Original TComponentProperty is using this method to iterate all available instances:

procedure TComponentProperty.GetValues(Proc: TGetStrProc);
begin
  Designer.GetComponentNames(GetTypeData(GetPropType), Proc);
end;

但是， Designer 似乎是预编译的，因此我不知道 GetComponentNames 的工作原理。

However, Designer seems to be precompiled so I have no idea how GetComponentNames works.

这是我到目前为止所拥有的，我想我唯一的东西缺少的是 GetValues 的实现：

This is what I have so far, I guess only thing which I am missing is the implementation of 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.

有人可以帮助吗？

谢谢。

推荐答案

调用 TMenuItemProp.GetValues（）时，您需要查看当前正在编辑其 MenuItem 属性的 TMenuItemSelector 对象，查看该对象是否具有 PopupMenu 分配，如果是，则按需要遍历其项，例如：

When TMenuItemProp.GetValues() is called, you need to look at the TMenuItemSelector object whose MenuItem property is currently being edited, see if that object has a PopupMenu assigned, and if so then loop through its items as neded, eg:

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;

BTW，您需要实现 TMenuItemSelector 和 TMenuItemProp 在单独的程序包中。除了 RegisterComponents（）函数（在运行时程序包中实现）外，不允许将设计时代码编译为运行时可执行文件。这违反了EULA，并且不允许分发Embarcadero的设计时数据。您需要在仅运行时程序包中实现 TMenuItemSelector ，然后实现 TMenuItemProp 和 Register （）放在要求仅运行时的包中，并且使用的仅设计时包 TMenuItemSelector 的声明单位，例如：

BTW, you need to implement TMenuItemSelector and TMenuItemProp in separate packages. With the exception of the RegisterComponents() function, (which is implemented in a runtime package), design-time code is not allowed to be compiled into run-time executables. It is against the EULA, and Embarcadero's design-time pacakges are not allowed to be distributed. You need to implement TMenuItemSelector in a runtime-only package, and then implement TMenuItemProp and Register() in a designtime-only package that Requires the runtime-only package and uses the unit that TMenuItemSelector is declared in, eg:

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.

这篇关于如何修改TComponentProperty以仅显示下拉列表中的特定项目？的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持！