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

Question

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

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

Пример кода мастера на code-central делает это:

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

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

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

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

0

delphi delphi-10-seattle otapi

Источник

user84704 10 фев '16 в 01:41

2 ответа

Решение

Ответ Реми верный, но я даю этот ответ, потому что я написал небольшой блок для интеграции 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

2

Источник

user84704 10 фев '16 в 02:36

Другие вопросы по тегам delphi delphi-10-seattle otapi

user65863 10 фев '16 в 02:50 2016-02-10 02:50 · Accepted Answer · 2016-02-10 02:50

Если вы посмотрите на исходный код в $(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;