我正在关注关于如何使用 IOTAProjectManager 在 Delphi IDE 中扩展项目菜单 的CodeCentral 文章。
code-central 上的示例向导代码执行以下操作：
procedure Register;
begin
FNotifierIndex := (BorlandIDEServices as IOTAProjectManager).AddMenuCreatorNotifier(TMyContextMenu.Create); // deprecated.
end;
注册上下文菜单（例如项目菜单之一）的新技术是什么？请注意，这已被弃用，甚至没有出现在 docwiki 上。
所需结果的屏幕截图：
更新：我找不到任何最新的教程，包括代码。Embarcadero 的网站上有一份 PDF 白皮书，但来自 Bruno Fierens 的白皮书中的代码示例不在网络上的任何地方。我在下面给出了一个工作示例的答案，该示例位于 bitbucket 上，您可以下载下面的 zip。
如果您查看 中的源代码$(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;
Remy 的答案是正确的，但我提供这个答案是因为我已经编写了一个小单元来进行项目菜单（上下文菜单）集成，此外，作为奖励，这个演示还显示了主菜单和 IDE 洞察力。
我的答案中的代码片段涵盖了如何实际编写多层类中的代码，其中一层必须实现IOTAProjectMenuItemCreatorNotifier接口。
bitbucket 上的演示实际上做了几件有用的事情：
处理 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 的完整工作示例