Как изменить TComponentProperty, чтобы в раскрывающемся списке отображались только определенные элементы?

Question

Пожалуйста, рассмотрите такой сценарий:

У меня есть компонент с именем TMenuItemSelector, который имеет два опубликованных свойства: PopupMenu - позволяет выбрать экземпляр TPopupMenu из формы и MenuItem, который позволяет выбрать любой экземпляр TMenuItem с формы.

Я хотел бы изменить редактор свойств для свойства MenuItem таким образом, чтобы при назначении PopupMenu в раскрывающемся списке отображались только элементы меню из этого PopupMenu.

Я знаю, что мне нужно написать собственного потомка TComponentProperty и переопределить GetValues метод. Проблема в том, что я не знаю, как получить доступ к форме, на которой лежит TMenuItemSelector.

Original 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, и если это так, то просмотреть его элементы как необходимо, например:

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() (которая реализована в пакете времени выполнения), код времени разработки не может быть скомпилирован в исполняемые файлы времени выполнения. Это противоречит лицензионному соглашению, и пакеты, выпущенные 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.