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

unit exmpl_01;

{ STANDARD EXPERT }

interface

uses
  Dialogs, ExptIntf;

type
  { класс эксперта является потомком базового класса TIExpert }
  TEMyExpert = class( TIExpert)
    function GetName: string; override;
    function GetStyle: TExpertStyle; override;
    function GetIDString: string; override;
    function GetMenuText: string; override;
    function GetState: TExpertState; override;
    procedure Execute; override;
end;

procedure register;

implementation

{ возвращаем имя эксперта }
function TEMyExpert.GetName: string;
begin
  Result := 'My Simple Expert 1';
end;

{ возвращаем стиль эксперта }
function TEMyExpert.GetStyle: TExpertStyle;
begin
  Result := esStandard;
end;

{ возвращаем строку - идентификатор эксперта }
function TEMyExpert.GetIDString: string;
begin
  Result := 'Doomy.SimpleAddInExpert_1';
end;

{ возвращаем текст пункта меню }
function TEMyExpert.GetMenuText: string;
begin
  Result := 'Simple Expert 1';
end;

{ возвращаем множество, характеризующее состояние пункта меню эксперта }
{ (доступность, наличие "галочки"); в данном случае пункт меню доступен, }
{ а "галочка" отсутствует }
function TEMyExpert.GetState: TExpertState;
begin
  Result := [esEnabled];
end;

{ при выборе пункта меню эксперта отображаем сообщение }
procedure TEMyExpert.Execute;
begin
  MessageDlg('Standard Expert Started!', mtInformation, [mbOK], 0);
end;

{ регистрируем эксперт }
procedure register;
begin
  RegisterLibraryExpert( TEMyExpert.Create);
end;

end.

unit exmpl_02;

{ ADD-IN EXPERT, ДОБАВЛЕНИЕ ПУНКТА В ГЛАВНОЕ МЕНЮ IDE DELPHI }
interface

uses
  Classes, Dialogs, ToolIntF, ExptIntf, Menus;

type
  { класс эксперта является потомком базового класса TIExpert }
  TEMyExpert = class( TIExpert)
  private
    MenuItem: TIMenuItemIntf;
  public
    constructor Create;
    destructor Destroy; override;
    function GetName: string; override;
    function GetStyle: TExpertStyle; override;
    function GetIDString: string; override;
    procedure MenuItemClick( Sender: TIMenuItemIntf);
end;

procedure register;

function AddIDEMenuItem( const Caption, name, PreviousItemName: string;
const ShortCutKey: Char; OnClick: TIMenuClickEvent): TIMenuItemIntf;

implementation

{ добавляем пункт в главное меню IDE Delphi: }
{ 1) текст вставляемого пункта меню - 'Simple Expert 2'; }
{ 2) идентификатор вставляемого пункта меню - 'ViewMyExpertItem2'; }
{ 3) идентификатор пункта меню, перед которым добавляется новый }
{ пункт меню - 'ViewWatchItem' (для Delphi 5 - 'ViewWatchesItem');}
{ 4) горячая клавиша вставляемого пункта - 'Ctrl + 2'; }
{ 5) обработчик события, соответствующего выбору вставляемого пункта }
{ меню - MenuItemClick }
constructor TEMyExpert.Create;
begin
  inherited Create;
  MenuItem:= AddIDEMenuItem( 'Simple Expert 2', 'ViewMyExpertItem2',
  {$IFDEF VER130}
  'ViewWatchesItem', '2', MenuItemClick);
  {$ELSE}
  'ViewWatchItem', '2', MenuItemClick);
  {$ENDIF}
end;

destructor TEMyExpert.Destroy;
begin
  if Assigned( MenuItem) then
    MenuItem.Free;
  inherited Destroy;
end;

{ при выборе пункта меню эксперта отображаем сообщение, содержащее }
{ имя активного проекта }
procedure TEMyExpert.MenuItemClick( Sender: TIMenuItemIntf);
begin
  MessageDlg( 'Current project name is ' + ToolServices.GetProjectName,
  mtInformation, [mbOK], 0);
end;

{ возвращаем имя эксперта }
function TEMyExpert.GetName: string;
begin
  Result := 'My Simple Expert 2';
end;

{ возвращаем стиль эксперта }
function TEMyExpert.GetStyle: TExpertStyle;
begin
  Result := esAddIn;
end;

{ возвращаем строку - идентификатор эксперта }
function TEMyExpert.GetIDString: string;
begin
  Result := 'Doomy.SimpleAddInExpert_2';
end;


function AddIDEMenuItem( const Caption, name, PreviousItemName: string;
const ShortCutKey: Char; OnClick: TIMenuClickEvent): TIMenuItemIntf;
var
  MainMenu: TIMainMenuIntf;
  MenuItems, PreviousItem, ParentItem: TIMenuItemIntf;
begin
  Result:= nil;
  { получаем интерфейс пунктов главного меню IDE }
  MainMenu:= ToolServices.GetMainMenu;
  if Assigned( MainMenu) then
    try
      { получаем интерфейс пунктов верхнего уровня меню }
      MenuItems:= MainMenu.GetMenuItems;
      if Assigned( MenuItems) then
        try
          { ищем пункт меню перед которым необходимо вставить новый пункт }
          PreviousItem:= MainMenu.FindMenuItem( PreviousItemName);
          if Assigned( PreviousItem) then
            try
              { получаем интерфейс к родительскому пункту меню }
              ParentItem:= PreviousItem.GetParent;
              if Assigned( ParentItem) then
                try
                  { вставляем новый пункт меню и в качестве результата функции }
                  { возвращаем его интерфейс }
                  Result:= ParentItem.InsertItem( PreviousItem.GetIndex, Caption,
                  name, '', ShortCut( Word( ShortCutKey), [ssCtrl]), 0, 0,
                  [mfVisible, mfEnabled], OnClick);
                finally
                  { освобождаем интерфейс родительского пункта меню }
                  ParentItem.Free;
                end;
            finally
              { освобождаем интерфейс пункта меню перед которым вставили }
              { новый пункт }
              PreviousItem.Free;
            end;
        finally
          { освобождаем интерфейс пунктов верхнего уровня меню }
          MenuItems.Free;
        end;
    finally
      { освобождаем интерфейс главного меню IDE }
      MainMenu.Free;
    end;
end;

procedure register;
begin
  { регистрируем эксперт }
  RegisterLibraryExpert( TEMyExpert.Create);
end;

end.

unit exmpl_03;

{ ИСПОЛЬЗОВАНИЕ ADD-IN НОТИФИКАТОРОВ }
interface

uses
  Classes, Dialogs, ToolIntF, ExptIntf, Menus;

type
  TEMyExpert = class;

  { касс add-in нотификатора порождаем от TIAddInNotifier}
  TAddInNotifier = class(TIAddInNotifier)
  private
    Expert: TEMyExpert;
  public
    constructor Create( anExpert: TEMyExpert);
    procedure FileNotification( NotifyCode: TFileNotification;
    const FileName: string; var Cancel: Boolean); override;
end;

  { класс эксперта является потомком базового класса TIExpert }
  TEMyExpert = class( TIExpert)
  private
    ProjectName: string;
    MenuItem: TIMenuItemIntf;
    AddInNotifier: TAddInNotifier;
  public
    constructor Create;
    destructor Destroy; override;
    function GetName: string; override;
    function GetStyle: TExpertStyle; override;
    function GetIDString: string; override;
    procedure MenuItemClick( Sender: TIMenuItemIntf);
end;

procedure register;

function AddIDEMenuItem( const Caption, name, PreviousItemName: string;
const ShortCutKey: Char; OnClick: TIMenuClickEvent): TIMenuItemIntf;

implementation

constructor TAddInNotifier.Create;
begin
  inherited Create;
  Expert := anExpert;
end;

procedure TAddInNotifier.FileNotification( NotifyCode: TFileNotification;
const FileName: string; var Cancel: Boolean);
begin
  with Expert do
    case NotifyCode of
      fnProjectOpened:
        ProjectName:= FileName; { открытие проекта }
      fnProjectClosing:
        ProjectName:= 'unknown' { закрытие проекта }
    end;
end;

constructor TEMyExpert.Create;
begin
  inherited Create;
  { добавляем пункт в главное меню IDE Delphi }
  MenuItem:= AddIDEMenuItem( 'Simple Expert 3', 'ViewMyExpertItem3',
  {$IFDEF VER130}
  'ViewWatchesItem', '3', MenuItemClick);
  {$ELSE}
  'ViewWatchItem', '3', MenuItemClick);
  {$ENDIF}
  try
    { создаем add-in нотификатор }
    AddInNotifier:= TAddInNotifier.Create( Self);
    { регистрируем add-in нотификатор }
    ToolServices.AddNotifier( AddInNotifier);
  except
    AddInNotifier:= nil;
  end;
  { инициализируем поле, хранящее имя активного проекта }
  ProjectName:= ToolServices.GetProjectName;
end;

destructor TEMyExpert.Destroy;
begin
  if Assigned( MenuItem) then
    MenuItem.Free;
  if Assigned( AddInNotifier) then
  begin
    { снимаем регистрацию add-in нотификатора }
    ToolServices.RemoveNotifier( AddInNotifier);
    { уничтожаем add-in нотификатор }
    AddInNotifier.Free;
  end;
  inherited Destroy;
end;

{ при выборе пункта меню эксперта отображаем сообщение, содержащее }
{ имя активного проекта }
procedure TEMyExpert.MenuItemClick( Sender: TIMenuItemIntf);
begin
  MessageDlg( 'Current project name is ' + ProjectName,
  mtInformation, [mbOK], 0);
end;

...

end.

unit exmpl_04;

{ ИСПОЛЬЗОВАНИЕ МОДУЛЬНЫХ НОТИФИКАТОРОВ }

interface

uses
  Classes, Dialogs, ToolIntF, ExptIntf, Menus
  {$IFDEF VER130}, EditIntf{$ENDIF};

type
  { класс модульного нотификатора порождаем от TIModuleNotifier }
  TModuleNotifier = class( TIModuleNotifier)
  private
    FileName: string;
  public
    constructor Create(const aFileName: string);
    procedure Notify( NotifyCode: TNotifyCode); override;
    {$IFDEF VER130}
    procedure ComponentRenamed(ComponentHandle: Pointer;
    const OldName, NewName: string); override;
    {$ELSE}
    procedure ComponentRenamed( const oldName, newName: string); override;
    {$ENDIF}
end;

  TEMyExpert = class;

  { класс add-in нотификатора порождаем от TIAddInNotifier}
  TAddInNotifier = class(TIAddInNotifier)
  private
    Expert: TEMyExpert;
  public
    constructor Create( anExpert: TEMyExpert);
    procedure FileNotification( NotifyCode: TFileNotification;
    const FileName: string; var Cancel: Boolean); override;
end;

  { класс эксперта является потомком базового класса TIExpert }
  TEMyExpert = class( TIExpert)
  private
    AddInNotifier: TAddInNotifier;
    ModuleInterface: TIModuleInterface;
    ModuleNotifier: TModuleNotifier;
  public
    constructor Create;
    destructor Destroy; override;
    function GetName: string; override;
    function GetStyle: TExpertStyle; override;
    function GetIDString: string; override;
    procedure AddModuleNotifier( const FileName: string);
    procedure RemoveModuleNotifier;
end;

procedure register;

implementation

constructor TModuleNotifier.Create(const aFileName: string);
begin
  inherited Create;
  FileName := aFileName;
end;

procedure TModuleNotifier.Notify( NotifyCode: TNotifyCode);
begin
  { если произошло сохранение соответствующего нотификатору файла, }
  { то выдаем сообщение об этом }
  if NotifyCode = ncAfterSave then
    MessageDlg(FileName + 'saved', mtInformation, [mbOK], 0);
end;

procedure TModuleNotifier.ComponentRenamed;
begin
  { ничего здесь не делаем, но метод необходимо перекрыть }
end;

procedure TAddInNotifier.FileNotification( NotifyCode: TFileNotification;
const FileName: string; var Cancel: Boolean);
begin
  with Expert do
    case NotifyCode of
      fnProjectOpened: { открытие проекта }
        { добавляем модульный нотификатор }
        AddModuleNotifier( FileName);
      fnProjectClosing: { закрытие проекта }
        { освобождаем модульный нотификатор }
        RemoveModuleNotifier;
    end;
end;

constructor TEMyExpert.Create;
begin
  inherited Create;
  try
    { создаем add-in нотификатор }
    AddInNotifier:= TAddInNotifier.Create( Self);
    { регистрируем add-in нотификатор }
    ToolServices.AddNotifier( AddInNotifier);
  except
    AddInNotifier:= nil;
  end;
  { добавляем модульный нотификатор }
  AddModuleNotifier( ToolServices.GetProjectName);
end;

destructor TEMyExpert.Destroy;
begin
  if Assigned( AddInNotifier) then
  begin
    { снимаем регистрацию add-in нотификатора }
    ToolServices.RemoveNotifier( AddInNotifier);
    { уничтожаем add-in нотификатор }
    AddInNotifier.Free;
  end;
  { освобождаем модульный нотификатор }
  RemoveModuleNotifier;
  inherited Destroy;
end;

procedure TEMyExpert.AddModuleNotifier;
begin
  { если модульный нотификатор для проектного файла уже зарегистрирован, }
  { то никаких действий не выполняем, во избежание появления дубликатов }
  { нотификаторов; в противном случае дубликаты могли бы появиться, }
  { например, при открытии Delphi: один нотификатор добавился бы при }
  { создании эксперта (в конструкторе класса эксперта), а второй - при }
  { открытии проекта (в TAddNotifier.FileNotification }
  if Assigned( ModuleInterface) and Assigned( ModuleNotifier) then
    Exit;
  try
    { получаем интерфейс модуля }
    ModuleInterface:= ToolServices.GetModuleInterface( FileName);
    try
      { создаем модульный нотификатор }
      ModuleNotifier:= TModuleNotifier.Create( FileName);
      { регистрируем модульный нотификатор }
      ModuleInterface.AddNotifier( ModuleNotifier);
    except
      ModuleNotifier:= nil;
    end;
  except
    ModuleInterface:= nil;
  end;
end;

procedure TEMyExpert.RemoveModuleNotifier;
begin
  if Assigned(ModuleNotifier) then
  begin
    if Assigned( ModuleInterface) then
      { снимаем регистрацию модульного нотификатора }
      ModuleInterface.RemoveNotifier( ModuleNotifier);
    { уничтожаем модульный нотификатор }
    ModuleNotifier.Free;
    ModuleNotifier:= nil;
  end;
  if Assigned( ModuleInterface) then
  begin
    { освобождаем модульный интерфейс }
    ModuleInterface.Free;
    ModuleInterface:= nil;
  end;
end;

...

end.

unit exmpl_05;

{ ОПРЕДЕЛЕНИЕ ПОЗИЦИИ КУРСОРА }
interface

uses
  SysUtils, Classes, Dialogs, ToolIntF, ExptIntf, EditIntf, Menus;

type
  { класс эксперта является потомком базового класса TIExpert }
  TEMyExpert = class( TIExpert)
  private
    MenuItem: TIMenuItemIntf;
  public
    constructor Create;
    destructor Destroy; override;
    function GetName: string; override;
    function GetStyle: TExpertStyle; override;
    function GetIDString: string; override;
    procedure MenuItemClick( Sender: TIMenuItemIntf);
    function GetCursorPos: TEditPos;
end;

procedure register;

function AddIDEMenuItem( const Caption, name, PreviousItemName: string;
const ShortCutKey: Char; OnClick: TIMenuClickEvent): TIMenuItemIntf;

implementation

{ при выборе пункта меню эксперта отображаем сообщение, содержащее }
{ имя активного проекта }
procedure TEMyExpert.MenuItemClick( Sender: TIMenuItemIntf);
var
  CurPos: TEditPos;
begin
  CurPos:= GetCursorPos;
  if CurPos.Line > 0 then
    MessageDlg( 'Current file: ' + ToolServices.GetCurrentFile + #13 +
    'Current cursor position: ' + IntToStr( CurPos.Line) +
    ', ' + IntToStr( CurPos.Col), mtInformation, [mbOK], 0);
end;

function TEMyExpert.GetCursorPos: TEditPos;
var
  ModuleInterface: TIModuleInterface;
  EditorInterface: TIEditorInterface;
  EditView: TIEditView;
  FileName: string;
begin
  { определяем имя активного файла }
  FileName:= ToolServices.GetCurrentFile;
  Result.Line:= 0;
  Result.Col:= 0;
  { для простоты определяем позицию только в pas- файлах }
  if ExtractFileExt( FileName) = '.pas' then
  begin
    { получаем интерфейс модуля }
    ModuleInterface:= ToolServices.GetModuleInterface( FileName);
    try
      { получаем интерфейс редактора кода }
      EditorInterface:= ModuleInterface.GetEditorInterface;
      try
        { получаем интерфейс представления модуля в редакторе }
        { передавая методу GetView индекс нужного нам представления; }
        { если файл открыт в нескольких окнах редактора кода, то для }
        { простоты берем первое (хотя конечно, это не совсем }
        { правильно }
        EditView:= EditorInterface.GetView( 0);
        try
          Result:= EditView.CursorPos;
        finally
          EditView.Free;
        end;
      finally
        EditorInterface.Free;
      end;
    finally
      ModuleInterface.Free;
    end;
  end;
end;

...