intexpt.pas

Delphi函数工厂。。。。。。。。。。。。。

unit IntExpt;

interface

uses
  SysUtils,  Classes, Graphics,WinTypes,Forms,
 ExptIntf, ToolIntf, VirtIntf, registry, Menus;//,WinProcs
type

  TDelphiFactoryExpert = class(TIExpert)
  private
    MenuItem: TIMenuItemIntf;
    function GetMenuShortCut: TShortCut;
    procedure SetMenuShortCut(AShortCut: TShortCut);
  protected
    procedure OnClick(Sender: TIMenuItemIntf); virtual;
  public
    constructor Create; virtual;
    destructor Destroy; override;
    function GetName: string; override;
    function GetComment: string; override;
    function GetAuthor: string; override;
    function GetPage: string; override;
    function GetGlyph: HICON; override;
    function GetStyle: TExpertStyle; override;
    function GetState: TExpertState; override;
    function GetIDString: string; override;
    function GetMenuText: string; override;
    property MenuShortCut: TShortCut read GetMenuShortCut write SetMenuShortCut;

    procedure Execute; override;
  end;

function InitExpert(ToolServices: TIToolServices; RegisterProc:
  TExpertRegisterProc;
  var Terminate: TExpertTerminateProc): Boolean; stdcall;

implementation

//专家作者
{
同 GetName
}

function TDelphiFactoryExpert.GetAuthor: string;
begin
  Result := 'AWIN';
end;

//专家名称
{
对于esForm专家或 esProject来说,对象库中显示它们的名称
(esForm esProject 见GetStyle)
}

function TDelphiFactoryExpert.GetName: string;
begin
  Result := 'Expert Expert';
end;

//有关专家注解
{
同 GetName
}

function TDelphiFactoryExpert.GetComment: string;
begin
  Result := ' ';
end;

//指定专家图标

function TDelphiFactoryExpert.GetGlyph: HICON;
begin
  Result := 0;
end;

//用于esForm, esProject
{
这个函数指定专家加到对象库的哪一个页上,例:
result:='Projects'
}

function TDelphiFactoryExpert.GetPage: string;
begin

end;

//指定专家风格
{参数说明:
esStandard: 它可以在IDE的"Help"菜单中加入一条命令
esAddIn: 它可以在IDE的任何菜单中加入命令.
esForm: 专家可以出现在对象库的"Forms"页
esProject: 专家可以出现在对象库的"Project"页
}

function TDelphiFactoryExpert.GetStyle: TExpertStyle;
begin
  Result := esAddIn;
end;


//使专家总是有效
//另一个参数是esChecked

function TDelphiFactoryExpert.GetState: TExpertState;
begin
  Result := [esEnabled];
end;

//指定专家的标识符
//命名规则companyName.ExpertName

function TDelphiFactoryExpert.GetIDString: string;
begin
  Result := 'AWIN.DelphiFactory';
end;

//专家在菜单上的标签

function TDelphiFactoryExpert.GetMenuText: string;
begin
  Result := 'Delphi函数工厂';
end;

constructor TDelphiFactoryExpert.Create;
var
  Main: TIMainMenuIntf;
  ReferenceMenuItem: TIMenuItemIntf;
  Menu: TIMenuItemIntf;
begin
  inherited Create;
  MenuItem := nil;
  if ToolServices <> nil then
  begin
    Main := ToolServices.GetMainMenu;
    if Main <> nil then
    begin
      try
        ReferenceMenuItem := Main.FindMenuItem('ToolsOptionsItem');
        if ReferenceMenuItem <> nil then
        try
          Menu := ReferenceMenuItem.GetParent;
          if Menu <> nil then
          try
            MenuItem := Menu.InsertItem(ReferenceMenuItem.GetIndex + 1, GetMenuText,
              'delphifactroy', '',
              0, 0, 0,
              [mfEnabled, mfVisible], OnClick);
          finally
            Menu.DestroyMenuItem;
          end;
        finally
          ReferenceMenuItem.DestroyMenuItem;
        end;
      finally
        Main.Free;
      end;
    end;
  end;
end;

procedure TDelphiFactoryExpert.SetMenuShortCut(AShortCut: TShortCut);
begin
  MenuItem.SetShortCut(AShortCut);
end;

function TDelphiFactoryExpert.GetMenuShortCut: TShortCut;
begin
  if MenuItem <> nil then
    Result := MenuItem.GetShortCut
  else
    Result := ShortCut(Word('C'), [ssCtrl]);
end;

destructor TDelphiFactoryExpert.Destroy;
begin
  if MenuItem <> nil then MenuItem.DestroyMenuItem;
  inherited Destroy;
end;

procedure TDelphiFactoryExpert.OnClick(Sender: TIMenuItemIntf);
begin
  Execute;
end;

//运行Delphi函数工厂
procedure TDelphiFactoryExpert.Execute;
var
  reg: Tregistry;
  path: string;
begin
  try
    reg := TRegistry.Create;
    reg.RootKey := HKEY_CURRENT_USER;
    reg.OpenKey('Software\AWINSoft', true);
    path := reg.ReadString('Delphi函数工厂');
  finally
    reg.Free;
  end;                 
  if (path <> '') and (FileExists(path)) then
    winexec(pchar(path), SW_SHOW);
end;

function InitExpert(ToolServices: TIToolServices; RegisterProc:
  TExpertRegisterProc;
  var Terminate: TExpertTerminateProc): Boolean;
begin
  Result := True;
  try
    ExptIntf.ToolServices := ToolServices;
    Application.Handle := ToolServices.GetParentHandle;
    RegisterProc(TDelphiFactoryExpert.Create);
  except
    //如果发生异常,把异常传播给IDE处理
    ToolServices.RaiseException(ReleaseException);
  end;
end;

end.