Delphi ide extension (2)

The following describes how to create a menu item in the ide and right-click the menu in the project to display the extended ide content.

Unit Test; interfaceuses SysUtils, Windows, ToolsAPI, ImgList, Controls, Classes, ActnList, Menus, ComCtrls, Graphics; type TTest = class (TNotifierObject, IOTAWizard, IOTAMenuWizard) protected {IOTAMenuWizard} function GetMenuText: string; {Expert UI strings} function GetIDString: string; function GetName: string; function GetState: TWizardState; {Launch the AddIn} procedure Execute; end; TTestPM = class (TNotifierObject, rule) private procedure construct (Sender: TObject); public function AddMenu (const Ident: string): TMenuItem; function CanHandle (const Ident: string): Boolean; end; procedure Register; procedure ExcuteChose; procedure ShowEditForm; function region: string; procedure region; function GetCurrentProject: IOTAProject; function suppsex sex (const Instance: IInterface; const Intf: TGUID; out Inst): Boolean; var FNotifierIndex: Integer; implementationuses Registry, Forms, Dialogs, ShellAPI; resourcestring defPopMenu = 'test Menu '; defHelpMenu = 'test '; //////////////////////////////////////// //////////////////////////////////////// // function: classes required for package registration // parameters: //////////////////////////////////////// //////////////////////////////////////// procedure Register; begin RegisterPackageWizard (TTest. create); FNotifierIndex: = (BorlandIDEServices as IOTAProjectManager ). addMenuCreatorNotifier (TTestPM. create); end; //////////////////////////////////////// //////////////////////////////////////// // function: execute the selection, mainly to determine whether the existing program contains gcpedit, if it contains direct call for release, // If not, the entire form is displayed // parameter: //////////////////////////////////////// //////////////////////////////////////// procedure ExcuteChose; var oProject: IOTAProject; begin oProject: = GetCurrentProject; if oProject = nil then ShowEditForm else ExcuteByDos; end; //////////////////////////////////////// //////////////////////////////////////// // function: public Functions: display the published form interface // parameters: //////////////////////////////////////// //////////////////////////////////////// procedure ShowEditForm; var S: string; begin S: = FindGCPEditorPath; ShellExecute (0, 'open', PChar (s), nil, nil, 0); end; //////////////////////////////////////// //////////////////////////////////////// // function: // parameters: //////////////////////////////////////// //////////////////////////////////////// function SupportsEx (const Instance: IInterface; const Intf: TGUID; out Inst): Boolean; begin Result: = (Instance <> nil) and (Instance. queryInterface (Intf, Inst) = 0) and (Pointer (Inst) <> nil); end; function GetCurrentProject: IOTAProject; function FindModuleInterface (AInterface: TGUID): IUnknown; var I: integer; ModuleServices: IOTAModuleServices; begin Result: = nil; if not suppsex sex (BorlandIDEServices, IOTAModuleServices, ModuleServices) then Exit; for I: = 0 to (ModuleServices. moduleCount-1) do if (SupportsEx (ModuleServices. modules [I], AInterface, Result) then Break; end; var ProjectGroup: IOTAProjectGroup; ProjectIndex: Integer; begin Result: = nil; if Application. terminated then Exit; try ProjectGroup: = FindModuleInterface (IOTAProjectGroup) as IOTAProjectGroup; if Assigned (ProjectGroup) then begin for ProjectIndex: = 0 to ProjectGroup. projectCount-1 do begin if Pos ('cpeditor', ProjectGroup. projects [ProjectIndex]. fileName)> 1 then begin Result: = ProjectGroup. projects [ProjectIndex]; Break; end else begin Result: = FindModuleInterface (IOTAProject) as IOTAProject; if Pos ('gcpeditor', Result. fileName)> 1 then ShowMessage (Result. fileName); end; else t // Sometimes a 3th party "IDE hook" can returns invalid interfaces... end; //////////////////////////////////////// //////////////////////////////////////// // function: right-click to publish gcp. To call the command line, you must pass the Release parameter // parameter: //////////////////////////////////////// //////////////////////////////////////// procedure ExcuteByDos; var strCmd: string; strExePath: string; begin strExePath: = FindGCPEditorPath; strCmd: = 'cmd/C' + strExePath + '-Release'; WinExec (PChar (strCmd ), SW_HIDE); end; //////////////////////////////////////// //////////////////////////////////////// // function: run. When the corresponding button is selected in the help menu bar, run the // parameter: //////////////////////////////////////// //////////////////////////////////////// procedure TTest. execute; begin ExcuteChose; end; //////////////////////////////////////// //////////////////////////////////////// // function: find the path of test.exe in the Registration Table // parameter: //////////////////////////////////////// //////////////////////////////////////// function FindGCPEditorPath: string; const defAppRegKey = '\ SOFTWARE \ *'; begin with TRegistry. create (KEY_READ) do begin RootKey: = HKEY_CURRENT_USER; if OpenKey (defAppRegKey + '\ test', False) then begin Result: = ReadString ('path'); end; Closekey; free; end; function TTest. getIDString: string; begin Result: = defHelpMenu; end; function TTest. getMenuText: string; begin Result: = defHelpMenu; end; function TTest. getName: string; begin Result: = defHelpMenu; end; function TTest. getState: TWizardState; begin Result: = [wsEnabled]; end; {TTestPM }///////////////////////////////////// //////////////////////////////////////// //// functions: right-click the Add button in the menu and select Add to project or pas. // parameter: //////////////////////////////////////// //////////////////////////////////////// function TTestPM. addMenu (const Ident: string): TMenuItem; begin result: = TMenuItem. create (nil); result. caption: = defPopMenu; result. onClick: = MyContextMenuClickHandler; end; //////////////////////////////////////// //////////////////////////////////////// // function: // parameters: //////////////////////////////////////// //////////////////////////////////////// function TTestPM. canHandle (const Ident: string): Boolean; begin result: = SameText (Ident, sProjectContainer); end; //////////////////////////////////////// //////////////////////////////////////// // function: context Menu Execution Process // parameters: //////////////////////////////////////// //////////////////////////////////////// procedure TTestPM. dependencies (Sender: TObject); begin ExcuteChose; end; initialization FNotifierIndex: =-1; finalization if FNotifierIndex>-1 then (BorlandIDEServices as IOTAProjectManager ). removeMenuCreatorNotifier (FNotifierIndex); end.