Delphi OTAPI AddMenuCreatorNotifier устарел, что такое замена?

Question

Я следую за CodeCentral article о том, как расширить меню проекта в Delphi IDE, используя IOTAProjectManager.

Пример кода мастер на код-центральный делает это:

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

Что такое новый метод, чтобы зарегистрировать контекстное меню, таких как меню проекта один? Обратите внимание, что это было устарело, даже не сделав его на docwiki.

Скриншот желаемого результата:

Обновление: Я не мог найти до даты учебники, включая код. На веб-сайте Embarcadero есть PDF-документ, но примеры кода из этого документа Bruno Fierens нигде в Интернете отсутствуют. Я сделал ответ ниже с рабочим примером, который находится на битбакете, вы можете скачать zip ниже.

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.
• Он также добавляет меню в главное меню.

Обработка интерфейсов, которые обсуждает ответ Реми, нетривиальна, поэтому я сделал рабочий пример.

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. 

полный рабочий пример на BitBucket в https://bitbucket.org/wpostma/helloworldexpert