Question

我正在关注如何使用IOTAProjectManager在Delphi IDE中扩展项目菜单的CodeCentral article。

代码中心的示例向导代码执行此操作：

procedure Register;
begin
  FNotifierIndex := (BorlandIDEServices as IOTAProjectManager).AddMenuCreatorNotifier(TMyContextMenu.Create); // deprecated.
end;

注册上下文菜单（例如项目菜单）的新技术是什么？请注意，这已被弃用，甚至没有将其添加到docwiki上。

所需结果的屏幕截图：

更新：我找不到包含代码的最新教程。在Embarcadero的网站上有一份PDF白皮书，但Bruno Fierens的白皮书中的代码样本并不在网上任何地方。我在下面用一个工作示例做了一个答案，在bitbucket上，你可以下载下面的拉链。

Answer 1

如果您查看$(BDS)\Source\ToolsAPI\ToolsAPI.pas中的源代码，IOTAProjectManager.AddMenuCreatorNotifier()的声明会说：

不推荐使用此功能 - 使用AddMenuItemCreatorNotifier

此外，INTAProjectMenuCreatorNotifier的声明说：

此通知程序已弃用。 改为使用IOTAProjectMenuItemCreatorNotifier。它支持在项目管理器中为多选项添加菜单项。

以下是相关的声明和说明。请注意评论：

type
  ...
  { This notifier is deprecated. Use IOTAProjectMenuItemCreatorNotifier instead.
    It supports adding menu items for multi-selected items in the Project Manager. }
  INTAProjectMenuCreatorNotifier = interface(IOTANotifier)
    ['{8209348C-2114-439C-AD4E-BFB7049A636A}']
    { The result will be inserted into the project manager local menu. Menu
      may have child menus. }
    function AddMenu(const Ident: string): TMenuItem;
    { Return True if you wish to install a project manager menu item for this
      ident.  In cases where the project manager node is a file Ident will be
      a fully qualified file name. }
    function CanHandle(const Ident: string): Boolean;
  end;

  IOTAProjectMenuItemCreatorNotifier = interface(IOTANotifier)
    ['{CFEE5A57-2B04-4CD6-968E-1CBF8BF96522}']
    { For each menu item you wish to add to the project manager for the given
      list of idents, add an IOTAProjectManagerMenu to the ProjectManagerMenuList.
      An example of a value for IdentList is sFileContainer and the name of the
      file, look above in this file for other constants. }
    procedure AddMenu(const Project: IOTAProject; const IdentList: TStrings;
      const ProjectManagerMenuList: IInterfaceList; IsMultiSelect: Boolean);
  end;

  IOTAProjectManager = interface(IInterface)
    ['{B142EF92-0A91-4614-A72A-CE46F9C88B7B}']
    { This function is deprecated -- use AddMenuItemCreatorNotifier instead }
    function AddMenuCreatorNotifier(const Notifier: INTAProjectMenuCreatorNotifier): Integer; deprecated;
    { Adds a menu notifier, which allows you to customize the local menu of the
      project manager }
    function AddMenuItemCreatorNotifier(const Notifier: IOTAProjectMenuItemCreatorNotifier): Integer;
    ...
    { This function is deprecated -- use RemoveMenuItemCreatorNotifier instead }
    procedure RemoveMenuCreatorNotifier(Index: Integer); deprecated;
    { Removes a previously added menu notifier }
    procedure RemoveMenuItemCreatorNotifier(Index: Integer);
  end;

  ...

  { This is meant to be an abstract interface that describes a menu context that
    can be passed to an IOTALocalMenu-descendant's Execute method. }
  IOTAMenuContext = interface(IInterface)
    ['{378F0D38-ED5F-4128-B7D6-9D423FC1502F}']
    { Returns the identifier for this context }
    function GetIdent: string;
    { Returns the verb for this context }
    function GetVerb: string;

    property Ident: string read GetIdent;
    property Verb: string read GetVerb;
  end;

  { This is meant to be an abstract interface that describes a local menu item
    in an IDE view.  Specific views that can have their local menus customized
    will provide a descendant interface to be used for that view }
  IOTALocalMenu = interface(IOTANotifier)
    ['{83ECCBDF-939D-4F8D-B96D-A0C67ACC86EA}']
    { Returns the Caption to be used for this menu item }
    function GetCaption: string;
    { Returns the Checked state to be used for this menu item }
    function GetChecked: Boolean;
    { Returns the Enabled state to be used for this menu item }
    function GetEnabled: Boolean;
    { Returns the help context to be used for this menu item }
    function GetHelpContext: Integer;
    { Returns the Name for this menu item.  If blank, a name will be generated }
    function GetName: string;
    { Returns the parent menu for this menu item }
    function GetParent: string;
    { Returns the position of this menu item within the menu }
    function GetPosition: Integer;
    { Returns the verb associated with this menu item }
    function GetVerb: string;
    { Sets the Caption of the menu item to the specified value }
    procedure SetCaption(const Value: string);
    { Sets the Checked state of the menu item to the specified value }
    procedure SetChecked(Value: Boolean);
    { Sets the Enabled  state of the menu item to the specified value }
    procedure SetEnabled(Value: Boolean);
    { Sets the help context of the menu item to the specified value }
    procedure SetHelpContext(Value: Integer);
    { Sets the Name of the menu item to the specified value }
    procedure SetName(const Value: string);
    { Sets the Parent of the menu item to the specified value }
    procedure SetParent(const Value: string);
    { Sets the position of the menu item to the specified value }
    procedure SetPosition(Value: Integer);
    { Sets the verb associated with the menu item to the specified value }
    procedure SetVerb(const Value: string);

    property Caption: string read GetCaption write SetCaption;
    property Checked: Boolean read GetChecked write SetChecked;
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property HelpContext: Integer read GetHelpContext write SetHelpContext;
    property Name: string read GetName write SetName;
    property Parent: string read GetParent write SetParent;
    property Position: Integer read GetPosition write SetPosition;
    property Verb: string read GetVerb write SetVerb;
  end;

  { This is the context used for Project Manager local menu items.  The list
  passed to IOTAProjectManagerMenu.Execute will be a list of these interfaces }
  IOTAProjectMenuContext = interface(IOTAMenuContext)
    ['{ECEC33FD-837A-46DC-A0AD-1FFEBEEA23AF}']
    { Returns the project associated with the menu item }
    function GetProject: IOTAProject;

    property Project: IOTAProject read GetProject;
  end;

  { This is a Project Manager specific local menu item }
  IOTAProjectManagerMenu = interface(IOTALocalMenu)
    ['{5E3B2F18-306E-4922-9067-3F71843C51FA}']
    { Indicates whether or not this menu item supports multi-selected items }
    function GetIsMultiSelectable: Boolean;
    { Sets this menu item's multi-selected state }
    procedure SetIsMultiSelectable(Value: Boolean);
    { Execute is called when the menu item is selected.  MenuContextList is a
      list of IOTAProjectMenuContext.  Each item in the list represents an item
      in the project manager that is selected }
    procedure Execute(const MenuContextList: IInterfaceList); overload;
    { PreExecute is called before the Execute method.  MenuContextList is a list
      of IOTAProjectMenuContext.  Each item in the list represents an item in
      the project manager that is selected }
    function PreExecute(const MenuContextList: IInterfaceList): Boolean;
    { PostExecute is called after the Execute method.  MenuContextList is a list
      of IOTAProjectMenuContext.  Each item in the list represents an item in
      the project manager that is selected }
    function PostExecute(const MenuContextList: IInterfaceList): Boolean;

    property IsMultiSelectable: Boolean read GetIsMultiSelectable write SetIsMultiSelectable;
  end;

Answer 2

Remy的回答是正确的，但是我提供了这个答案，因为我已经编写了一个小单元来进行Project Menu（上下文菜单）集成，此外，作为奖励，此演示还显示了主菜单和IDE洞察力。

我的回答中的代码片段介绍了如何实际编写多层类中的代码，其中一个类必须实现IOTAProjectMenuItemCreatorNotifier接口。

bitbucket上的演示实际上做了几件有用的事情：

正如这个问题所要求的那样，它会在项目右键单击上下文菜单中放置一个自定义项目。
它还会注册全局键盘快捷键（热键）。
它还可以在IDE洞察搜索中显示相同的操作。
它还在主菜单中添加了一个菜单。

处理Remy的回答所讨论的接口并非易事，所以我做了一个有效的例子。

unit HelloExpertContextMenu;

// Example of a Project Right Click (Context) menu for Delphi 10 Seattle
// using OTAPI. Must be provided an action list full of actions with valid
// unique names.
//
// Register menu:
//
// Similar code would work in RAD Studio 2010 and newer, but not in older
// Delphi versions.

interface

uses Classes,
  SysUtils,
  Generics.Collections,
  Vcl.ActnList,
  ToolsAPI,
  Menus,
  Windows,
  Messages;
type


  TProjectManagerMenu = class(TNotifierObject, IOTANotifier, IOTAProjectMenuItemCreatorNotifier)
  private
    FActionList: TActionList; // reference only.
    FProject: IOTAProject; // Reference valid ONLY during MenuExecute
    FNotifierIndex: Integer;
    FFault:Boolean; // nicer than raising inside the IDE.
    { IOTAProjectMenuItemCreatorNotifier }
    procedure AddMenu(const Project: IOTAProject; const Ident: TStrings;
      const ProjectManagerMenuList: IInterfaceList; IsMultiSelect: Boolean);

  protected
    procedure ExecuteVerb(const Verb:string);

  public
    procedure InstallMenu;



    constructor Create(ActionList:TActionList);
    procedure MenuExecute(const MenuContextList: IInterfaceList);

    property Project: IOTAProject read FProject; // Reference valid ONLY during MenuExecute

    property Fault: Boolean read FFault; // InstallMenu fail.
  end;


 TOTAActionMenu = class(TInterfacedObject, IOTANotifier, IOTALocalMenu)
  private
    FAction:TAction;
    FParent: string;
    FPosition: Integer;
  public
    { IOTANotifier }
    procedure AfterSave;
    procedure BeforeSave;
    procedure Destroyed;
    procedure Modified;
  public


    { IOTALocalMenu }
    function GetCaption: string;
    function GetChecked: Boolean;
    function GetEnabled: Boolean;
    function GetHelpContext: Integer;
    function GetName: string;
    function GetParent: string;
    function GetPosition: Integer;
    function GetVerb: string;
    procedure SetChecked(Value: Boolean);
    procedure SetEnabled(Value: Boolean);
    procedure SetHelpContext(Value: Integer);
    procedure SetName(const Value: string);
    procedure SetParent(const Value: string);
    procedure SetPosition(Value: Integer);
    procedure SetVerb(const Value: string);
    procedure SetCaption(const Value: string);

    property Action: TAction read FAction write FAction; // MUST NOT BE NIL!
    property Caption: string read GetCaption write SetCaption;
    property Checked: Boolean read GetChecked write SetChecked;
    property Enabled: Boolean read GetEnabled write SetEnabled;
    property HelpContext: Integer read GetHelpContext write SetHelpContext;
    property Name: string read GetName write SetName;
    property Parent: string read GetParent write SetParent;
    property Position: Integer read GetPosition write SetPosition;
    property Verb: string read GetVerb write SetVerb;
  end;

  TProjectManagerMenuExecuteEvent = procedure (const MenuContextList: IInterfaceList) of object;

  TOTAProjectManagerActionMenu = class(TOTAActionMenu, IOTANotifier, IOTALocalMenu, IOTAProjectManagerMenu)
  private
    FIsMultiSelectable: Boolean;
  public
    { IOTAProjectManagerMenu }
    function GetIsMultiSelectable: Boolean;
    procedure SetIsMultiSelectable(Value: Boolean);
    procedure Execute(const MenuContextList: IInterfaceList); overload;
    function PreExecute(const MenuContextList: IInterfaceList): Boolean;
    function PostExecute(const MenuContextList: IInterfaceList): Boolean;
    property IsMultiSelectable: Boolean read GetIsMultiSelectable write SetIsMultiSelectable;
  end;

implementation



constructor TProjectManagerMenu.Create(ActionList:TActionList);
begin
  inherited Create;
  FActionList := ActionList;
end;

procedure TProjectManagerMenu.ExecuteVerb(const Verb: string);
var
 AnAction: TAction;
begin
  if Assigned(FActionList) then
  begin
    AnAction := FActionList.FindComponent(Verb) as TAction;
    if Assigned(AnAction) then
        AnAction.Execute();

  end;

end;

procedure TProjectManagerMenu.InstallMenu;
var
  OTAProjectManager: IOTAProjectManager;
begin
  if Supports(BorlandIDEServices, IOTAProjectManager, OTAProjectManager) then
    FNotifierIndex := OTAProjectManager.AddMenuItemCreatorNotifier(Self)
  else
    FFault := True;

end;

procedure TProjectManagerMenu.AddMenu(const Project: IOTAProject; const Ident: TStrings;
  const ProjectManagerMenuList: IInterfaceList; IsMultiSelect: Boolean);
var
  AMenu: TOTAProjectManagerActionMenu;
  Action:TAction;
  n:Integer;
begin
  if (not IsMultiSelect) and Assigned(Project) and (Ident.IndexOf(sProjectContainer) <> -1) then
  begin


    for n := 0 to FActionList.ActionCount-1 do
    begin
      Action := FActionList.Actions[n] as TAction;
      if Action.Name ='' then
        Action.Name := 'HelloExpertContextMenuAction'+IntToStr(n+1);
      AMenu := TOTAProjectManagerActionMenu.Create;
      AMenu.Action := Action;
      if AMenu.Caption='' then
        AMenu.Caption := 'Menu Item Text Missing'+IntToStr(n);
      AMenu.IsMultiSelectable := True;
      AMenu.Position := pmmpUserBuild;
      ProjectManagerMenuList.Add(AMenu);
    end;
  end;
end;

procedure TProjectManagerMenu.MenuExecute(const MenuContextList: IInterfaceList);
var
  Index: Integer;
  MenuContext: IOTAProjectMenuContext;
  Verb: string;
begin
  try
    for Index := 0 to MenuContextList.Count - 1 do
    begin
      MenuContext := MenuContextList.Items[Index] as IOTAProjectMenuContext;
      FProject := MenuContext.Project;
      try
          Verb := MenuContext.Verb;
          ExecuteVerb(Verb);
      finally
        FProject := nil;
      end;
    end;
  except
    on E:Exception do
    begin
      OutputDebugString(PChar(E.Message));
    end;
  end;
end;

procedure TOTAActionMenu.AfterSave;
begin

end;

procedure TOTAActionMenu.BeforeSave;
begin

end;

procedure TOTAActionMenu.Destroyed;
begin

end;

procedure TOTAActionMenu.Modified;
begin

end;

function TOTAActionMenu.GetCaption: string;
begin
  Result := FAction.Caption;
end;

function TOTAActionMenu.GetChecked: Boolean;
begin
  Result := FAction.Checked;
end;

function TOTAActionMenu.GetEnabled: Boolean;
begin
  Result := FAction.Enabled;
end;

function TOTAActionMenu.GetHelpContext: Integer;
begin
  Result := FAction.HelpContext;
end;

function TOTAActionMenu.GetName: string;
begin
  Result := FAction.Name;
end;

function TOTAActionMenu.GetParent: string;
begin
  Result := FParent;
end;

function TOTAActionMenu.GetPosition: Integer;
begin
  Result := FPosition;
end;

function TOTAActionMenu.GetVerb: string;
begin
  Result := FAction.Name; // Name is also Verb
end;



procedure TOTAActionMenu.SetCaption(const Value: string);
begin
  FAction.Caption := Value;
end;

procedure TOTAActionMenu.SetChecked(Value: Boolean);
begin
  FAction.Checked := Value;
end;

procedure TOTAActionMenu.SetEnabled(Value: Boolean);
begin
  FAction.Enabled := Value;
end;

procedure TOTAActionMenu.SetHelpContext(Value: Integer);
begin
  FAction.HelpContext := Value;
end;

procedure TOTAActionMenu.SetName(const Value: string);
begin
  FAction.Name := Value;
end;

procedure TOTAActionMenu.SetParent(const Value: string);
begin
  FParent := Value;
end;

procedure TOTAActionMenu.SetPosition(Value: Integer);
begin
  FPosition := Value;
end;

procedure TOTAActionMenu.SetVerb(const Value: string);
begin
  FAction.Name := Value; // NAME == VERB!
end;

//=== { TOTAProjectManagerActionMenu } ==========================================

function TOTAProjectManagerActionMenu.GetIsMultiSelectable: Boolean;
begin
  Result := FIsMultiSelectable;
end;

procedure TOTAProjectManagerActionMenu.SetIsMultiSelectable(Value: Boolean);
begin
  FIsMultiSelectable := Value;
end;

procedure TOTAProjectManagerActionMenu.Execute(const MenuContextList: IInterfaceList);
begin
  if Assigned(FAction) then
  begin
     FAction.Execute;
  end;
end;

function TOTAProjectManagerActionMenu.PreExecute(const MenuContextList: IInterfaceList): Boolean;
begin
  Result := True;
end;

function TOTAProjectManagerActionMenu.PostExecute(const MenuContextList: IInterfaceList): Boolean;
begin
  Result := True;
end;
end.

在https://bitbucket.org/wpostma/helloworldexpert

的bitbucket上完成工作示例

不推荐使用Delphi OTAPI AddMenuCreatorNotifier，有什么替代品？

2 个答案: