Использование открытых интерфейсов среды программирования Delphi

unit  exmpl_02;
 
{ ADD-IN ЭКСПЕРТ,  ДОБАВЛЕНИЕ ПУНКТА В   ГЛАВНОЕ МЕНЮ IDE DELPHI   }
 
interface
 
uses
 Classes,  Dialogs,  Toollntf,  Exptlntf,  Menus;
 
type
 { класс эксперта является потомком базового класса TIExpert }
 TEMyExpert = class(TIExpert)
 private
  Menultem:   TIMenultemIntf; 
 public
  constructor  Create;
  destructor Destroy;  override;
  function  GetName:   string;  override;
  function  GetStyle:   TExpertStyle;   override;
  function  GetlDString:   string;  override;
  procedure MenultemСlick(Sender:   TIMenuItemlntf); 
 end;
 
procedure Register;
 
{ функция, добавляющая пункт в главное меню IDE Delphi  } 
function AddIDEMenultem   (const  Caption,  Name,   PreviousItemName:   string; 
 const   ShortCutKey:   Char;   OnClick:   TIMenuClickEvent):   TIMenuItemlntf;
 
implementation
 
constructor  TEMyExpert.Create; 
begin
 inherited  Create;
 { добавляем пункт в   главное меню IDE Delphi:
  1} текст вставляемого пункта меню -   'Simple Expert   2';
  2) идентификатор  вставляемого пункта меню  -   'ViewMyExpertItem2';
  3) идентификатор пункта меню, перед  которым добавляется новый пункт
   меню -   'ViewWatchItem';
  4} горячая  клавиша вставляемого пункта -   'Ctrl   + 2' ; 
  5) обработчик события,  соответствующего выбору вставляемого пункта
   меню - MenuItemClick }
 Menultem  := AddIDEMenultem   ('Simple  Expert 2',   'ViewMyExpertItem2',
  'ViewWatchltem', '2', MenuItemClick); 
end;
 
destructor TEMyExpert.Destroy; 
begin
 Menultem.Free;
 inherited Destroy; 
end;
 
procedure ТЕMyExpert.MenuItemClick; 
begin
 { при выборе соответствующего эксперту пункта меню видаем сообщение,
  содержащее имя активного проекта } 
 MessageDlg('Current project name is ' + ToolServices.GetProjectName,
  mtlnformation, [mbOk], 0); 
end;
 
function TEMyExpert. GetName: string; 
begin
 { возвращаем имя эксперта } 
 Result := 'Mу Simple Expert 2'; 
end;
 
function TEMyExpert.GetStyle: TExpertStyle; 
begin
 { возвращаем стиль эксперта } 
 Result := esAddln; 
end;
 
function TEMyExpert. GetIDString: string; 
begin
 { возвращаем строку-идентификатор эксперта } 
 Result := 'Doomy.SimpleAddInExpert_2' 
end;
 
function AddIDEMenultem (const Caption, Name, PreviousItemName: string;
 const ShortCutKey: Char; OnClick: TIMenuClickEvent): TIMenuItemlntf; 
var MainMenu: TIMainMenuIntf;
 Menultems, PreviousItem, Parentltem: TIMenuItemlntf; 
begin
 { получаем интерфейс главного меню IDE } 
 MainMenu := ToolServices.GetMainMenu; 
 if Assigned (MainMenu) then 
 try
  { получаем интерфейс пунктов верхнего уровня меню }
  Menultems := MainMenu.GetMenultems; 
  if Assigned(Menultems) then 
  try
   { ищем пункт меню, перед которым необходимо вставить новый пункт }
   PreviousItem := MainMenu.FindMenultem(PreviousItemName); 
   if Assigned(PreviousItem) then 
   try
    { получаем интерфейс к родительскому пункту меню } 
    Parentltem := PreviousItem.GetParent; 
    if Assigned(Parentltem) then
    try
     { вставляем новый пункт меню и в качестве результата функции
      возвращаем его интерфейс } 
     Result := Parentltem.Insertltem
      (PreviousItem.Getlndex, Caption, Name, 
      '', ShortCut(Word(ShortCutKey), [ssCtrl]), 0, 0, 
      [mfVisible, mfEnabled], OnClick); 
    finally
     { освобождаем интерфейс родительского пункта меню }
     Parentltem.Free; 
    end; 
   finally
    { освобождаем интерфейс пункта меню, перед которым вставили
     новый пункт } 
     PreviousItem.Free; 
   end; 
  finally
   { освобождаем интерфейс пунктов верхнего уровня меню } 
   Menultems. Free; 
  end; 
 finally
  { освобождаем интерфейс главного меню IDE }
  MainMenu.Free; 
 end; 
end;
 
procedure Register; 
begin
 { регистрируем эксперт }
 RegisterLibraryExpert(TEMyExpert.Create); 
end;
 
end.