type
TMyExpert = class(TIExpert)
private
FMyExpert: TIMenuItemIntf;
public
procedure MyExpertClick(Sender: TIMenuItemIntf);
function GetName: string; override;
function GetComment: string; override;
function GetGlyph: HICON; override;
function GetStyle: TExpertStyle; override;
function GetState: TExpertState; override;
function GetIDString: string; override;
function GetAuthor: string; override;
function GetPage: string; override;
function GetMenuText: string; override;
constructor Create;
destructor Destroy; override;
procedure Execute;override;
end;
{$R EXPTBMPS.RES}
procedure HandleException;
begin
ToolServices.RaiseException(ReleaseException);
end;
{ TDialogExpert }
function TMyExpert.GetName: string;
begin
try
Result := 'MyExpert';
except
HandleException;
end;
end;
function TMyExpert.GetComment: string;
begin
try
Result := 'MyExpert, by 沈前卫 shenqw@cmmail.com';
except
HandleException;
Result:='';
end;
end;
function TMyExpert.GetGlyph: HICON;
begin
Result := 0;
end;
function TMyExpert.GetStyle: TExpertStyle;
begin
try
Result := esAddin;
except
HandleException;
Result := esAddin;
end;
end;
function TMyExpert.GetState: TExpertState;
begin
try
Result := [esEnabled,esChecked];
except
HandleException;
Result := [];
end;
end;
function TMyExpert.GetIDString: string;
begin
try
Result := 'Shenqw.MyExpert';
except
HandleException;
Result := '';
end;
end;
function TMyExpert.GetAuthor: string;
begin
try
Result := 'Shenqw';
except
HandleException;
Result := '';
end;
end;
function TMyExpert.GetPage: string;
begin
Result := '';
end;
function TMyExpert.GetMenuText: string;
begin
Result := 'My_Expert';
end;
constructor TMyExpert.Create;
var
MainMenu: TIMainMenuIntf;
MenuItems, HelpBorlandPage, HelpMenu: TIMenuItemIntf;
begin
inherited Create;
MainMenu := ToolServices.GetMainMenu;
if MainMenu <> nil then
try
MenuItems := MainMenu.GetMenuItems;
if MenuItems <> nil then
try
HelpBorlandPage := MainMenu.FindMenuItem('ViewPrjMgrItem');
if HelpBorlandPage <> nil then
try
HelpMenu := HelpBorlandPage.GetParent;
if HelpMenu <> nil then
try
FMyExpert := HelpMenu.InsertItem(0,
'My_Expert','MyExpertMenuItem','This is a test',integer(ShortCut(Ord('k'),[ssCtrl,ssAlt])),0,0,
[mfVisible, mfEnabled], MyExpertClick);
finally
HelpMenu.Free;
end;
finally
HelpBorlandPage.Free;
end;
finally
MenuItems.Free;
end;
finally;
MainMenu.Free;
end;
end;
destructor TMyExpert.Destroy;
begin
FMyExpert.Free;
inherited Destroy;
end;
procedure TMyExpert.MyExpertClick(Sender: TIMenuItemIntf);
var
TM:TIModuleInterface;
TE:TIEditorInterface;
CW:TIEditWriter;
begin
TM:=ToolServices.GetModuleInterface(ToolServices.GetCurrentFile);
if TM<>nil then
begin
TE:=TM.GetEditorInterface;
if TE<>nil then
begin
CW:=TE.CreateWriter;
if CW<>nil then
begin
CW.Insert('沈前卫----恭喜发财，龙年吉祥'#13#10);
{...}
end;
CW.Free;
end;
TE.Free;
end;
TM.Free;
end;
procedure TMyExpert.Execute;
begin
end;
procedure DoneExpert; export;
begin
{ Put any general destruction code here. Note that the Delphi IDE
will destroy any experts which have been registered. }
end;
function InitExpert(ToolServices: TIToolServices;
RegisterProc: TExpertRegisterProc;
var Terminate: TExpertTerminateProc): Boolean; export; stdcall;
begin
if ExptIntf.ToolServices = nil then
begin
ExptIntf.ToolServices := ToolServices;
if ToolServices <> nil then
Application.Handle := ToolServices.GetParentHandle;
end;
Result := RegisterProc(TMyExpert.Create);
end;
exports
InitExpert name ExpertEntryPoint resident;
