XPDUnitMenuWizard.pas
上传用户:yjb1804
上传日期:2021-01-30
资源大小:3105k
文件大小:10k
源码类别:

Email服务器

开发平台:

Delphi

  1. unit XPDUnitMenuWizard;
  2. {
  3.  $Source: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject/XPDUnitMenuWizard.pas,v $
  4.  $Revision: 1.2 $
  5.  $Date: 2004/05/03 15:07:16 $
  6.  Last amended by $Author: pvspain $
  7.  $State: Exp $
  8.  XPDUnitMenuWizard:
  9.  Adds DUnit submenu to IDE main menu
  10.  Copyright (c) 2002 by The Excellent Programming Company Pty Ltd
  11.  (Australia) (ABN 27 005 394 918). All rights reserved.
  12.  Contact Paul Spain via email: paul@xpro.com.au
  13.  This unit is free software; you can redistribute it and/or
  14.  modify it under the terms of the GNU Lesser General Public
  15.  License as published by the Free Software Foundation; either
  16.  version 2.1 of the License, or (at your option) any later version.
  17.  This unit is distributed in the hope that it will be useful,
  18.  but WITHOUT ANY WARRANTY; without even the implied warranty of
  19.  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  20.  Lesser General Public License for more details.
  21.  You should have received a copy of the GNU Lesser General Public
  22.  License along with this unit; if not, the license can be viewed at:
  23.  http://www.gnu.org/copyleft/lesser.html
  24.  or write to the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  25.  Boston, MA  02111-1307  USA
  26. }
  27. interface
  28. {$I JEDI.inc}
  29. uses
  30.   ToolsAPI;
  31. function MenuWizard(const TestClassWizard, TestModuleWizard,
  32.   ProjectWizard: IOTAWizard): IOTAWizard;
  33. implementation
  34. uses
  35.   Windows,              // RT_ICON
  36.   Classes,              // TResourceStream
  37.   Graphics,             // TIcon
  38.   SysUtils,             // Supports()
  39.   Menus,                // NewMenuItem()
  40.   XPDUnitCommon,
  41.   XPDUnitSetup,
  42.   XP_OTAWizards,        // TXP_OTAWizard
  43.   XP_OTAUtils,          // GetCurrentProjectGroup()
  44.   XPDUnitProjectWizard, // ProjectCreator()
  45. {$IFNDEF DELPHI6_UP}
  46.   FileCtrl,
  47. {$ELSE}
  48.   QDialogs,
  49. {$ENDIF}
  50.   ShellAPI,             // ShellExecute()
  51.   Registry,             // TRegistryIniFile
  52.   Forms;                // Application
  53. const CVSID: string = '$Header: /cvsroot/dunit/dunit/Contrib/DUnitWizard/Source/DelphiExperts/DUnitProject/XPDUnitMenuWizard.pas,v 1.2 2004/05/03 15:07:16 pvspain Exp $';
  54. const Author = 'Paul Spain, EPC';
  55. const DisplayName = 'DUnit Menu Wizard';
  56. type
  57. //////////////////////////////////////////////////////////////////////////////
  58. ///     Wizard declaration
  59. //////////////////////////////////////////////////////////////////////////////
  60.   TXPDUnitMenuWizard = class(TXP_OTAWizard)
  61.   private
  62.     FDUnitMenu: TMenuItem;
  63.     FTestClassWizard, FTestModuleWizard, FProjectWizard: IOTAWizard;
  64.   protected
  65.     function GetAuthor: string; override;
  66.     function GetName: string; override;
  67.     procedure ProjectItemClick(Sender: TObject);
  68.     procedure TestModuleItemClick(Sender: TObject);
  69.     procedure TestClassItemClick(Sender: TObject);
  70.     procedure SetupItemClick(Sender: TObject);
  71.     procedure DocumentationItemClick(Sender: TObject);
  72.   public
  73.     constructor Create(const TestClassWizard, TestModuleWizard,
  74.       ProjectWizard: IOTAWizard);
  75.     destructor Destroy; override;
  76.   end;
  77. //////////////////////////////////////////////////////////////////////////////
  78. ///     Wizard entry point
  79. //////////////////////////////////////////////////////////////////////////////
  80. function MenuWizard(const TestClassWizard, TestModuleWizard,
  81.   ProjectWizard: IOTAWizard): IOTAWizard;
  82. begin
  83.   Result := TXPDUnitMenuWizard.Create(TestClassWizard, TestModuleWizard,
  84.     ProjectWizard);
  85. end;
  86. //////////////////////////////////////////////////////////////////////////////
  87. ///   Wizard implementation
  88. //////////////////////////////////////////////////////////////////////////////
  89. constructor TXPDUnitMenuWizard.Create(
  90.   const TestClassWizard, TestModuleWizard, ProjectWizard: IOTAWizard);
  91. const
  92.   ShortCut = 0;
  93.   HelpContext = 0;
  94.   Enabled = True;
  95.   UnChecked = False;
  96.   SubMenuCaption = 'D&Unit';
  97.   SubMenuName = 'DUnit';
  98.   ProjectItemCaption = 'New &Project...';
  99.   ProjectItemName = 'DUnitNewProject';
  100.   TestModuleItemCaption = 'New Test&Module...';
  101.   TestModuleItemName = 'DUnitNewTestModule';
  102.   TestClassItemCaption = 'New Test&Class...';
  103.   TestClassItemName = 'DUnitNewTestClass';
  104.   SetupItemCaption = '&Options...';
  105.   SetupItemName = 'DUnitOptions';
  106.   DocumentationItemCaption = '&Documentation';
  107.   DocumentationItemName = 'DUnitDocumentation';
  108. var
  109.   NTAServices: INTAServices;
  110.   ProjectImage, TestModuleImage, TestClassImage: TBitmap;
  111.   ProjectImageIndex, TestModuleImageIndex, TestClassImageIndex: integer;
  112.   function FindDUnitMenu: boolean;
  113.   var
  114.     idx: integer;
  115.   begin
  116.     idx := NTAServices.MainMenu.Items.Count - 1;
  117.     Result := false;
  118.     while (idx >= 0) and not Result do
  119.     begin
  120.       Result := NTAServices.MainMenu.Items[idx].Name = SubMenuName;
  121.       System.Dec(idx);
  122.     end;
  123.   end;
  124. begin
  125.   inherited Create;
  126.   FTestClassWizard := TestClassWizard;
  127.   FTestModuleWizard := TestModuleWizard;
  128.   FProjectWizard := ProjectWizard;
  129.   // Initialise to nil so we don't need to nest try finallys
  130.   ProjectImage := nil;
  131.   TestModuleImage := nil;
  132.   TestClassImage := nil;
  133.   try
  134.     if SysUtils.Supports(BorlandIDEServices, INTAServices, NTAServices)
  135.       and System.Assigned(NTAServices.MainMenu) and (not FindDUnitMenu)
  136.       then
  137.     begin
  138.       // New submenu and two contained items for New Project and New TestModule
  139.       FDUnitMenu := Menus.NewSubMenu(SubMenuCaption, HelpContext, SubMenuName,
  140.         [ Menus.NewItem(ProjectItemCaption, ShortCut, UnChecked,
  141.             Enabled, ProjectItemClick, HelpContext, ProjectItemName),
  142.           Menus.NewItem(TestModuleItemCaption, ShortCut, UnChecked,
  143.             Enabled, TestModuleItemClick, HelpContext, TestModuleItemName),
  144.           Menus.NewItem(TestClassItemCaption, ShortCut, UnChecked,
  145.             Enabled, TestClassItemClick, HelpContext, TestClassItemName),
  146.           Menus.NewItem(SetupItemCaption, ShortCut, UnChecked,
  147.             Enabled, SetupItemClick, HelpContext, SetupItemName),
  148.           Menus.NewItem(DocumentationItemCaption, ShortCut, UnChecked,
  149.             Enabled, DocumentationItemClick, HelpContext, DocumentationItemName)
  150.         ], Enabled);
  151.       // Insert submenu as new main menu item immediately before Help
  152.       NTAServices.MainMenu.Items.Insert(
  153.         NTAServices.MainMenu.Items.Count - 1, FDUnitMenu);
  154.       // Load up images from package resources
  155.       ProjectImage := TBitmap.Create;
  156.       ProjectImage.LoadFromResourceName(SysInit.HInstance,
  157.         ProjectMenuResource);
  158.       TestModuleImage := TBitmap.Create;
  159.       TestModuleImage.LoadFromResourceName(SysInit.HInstance,
  160.         TestModuleMenuResource);
  161.       TestClassImage := TBitmap.Create;
  162.       TestClassImage.LoadFromResourceName(SysInit.HInstance,
  163.         TestClassMenuResource);
  164.       // Assign images to menu items
  165.       NTAServices.MainMenu.Images.Masked := true;
  166.       ProjectImageIndex
  167.         := NTAServices.MainMenu.Images.AddMasked(ProjectImage, clWhite);
  168.       TestModuleImageIndex
  169.         := NTAServices.MainMenu.Images.AddMasked(TestModuleImage, clWhite);
  170.       TestClassImageIndex
  171.         := NTAServices.MainMenu.Images.AddMasked(TestClassImage, clWhite);
  172.       NTAServices.MainMenu.Images.Masked := false;
  173.       FDUnitMenu.Items[0].ImageIndex := ProjectImageIndex;
  174.       FDUnitMenu.Items[1].ImageIndex := TestModuleImageIndex;
  175.       FDUnitMenu.Items[2].ImageIndex := TestClassImageIndex;
  176.     end;
  177.   finally
  178.     TestClassImage.Free;
  179.     TestModuleImage.Free;
  180.     ProjectImage.Free;
  181.   end;
  182. end;
  183. destructor TXPDUnitMenuWizard.Destroy;
  184. begin
  185.   if System.Assigned(FDUnitMenu) then
  186.   begin
  187.     // Menu items remove themselves from parent menu as part of destructor
  188.     // action, so FDUnitMenu.Count will be consequently adjusted for each
  189.     // iteration.
  190.     while FDUnitMenu.Count > 0 do
  191.       FDUnitMenu.Items[0].Free;
  192.   end;
  193.   FDUnitMenu.Free;
  194.   inherited Destroy;
  195. end;
  196. function TXPDUnitMenuWizard.GetAuthor: string;
  197. begin
  198.   Result := Author;
  199. end;
  200. function TXPDUnitMenuWizard.GetName: string;
  201. begin
  202.   Result := DisplayName;
  203. end;
  204. procedure TXPDUnitMenuWizard.ProjectItemClick(Sender: TObject);
  205. begin
  206.   if System.Assigned(FProjectWizard) then
  207.     FProjectWizard.Execute;
  208. end;
  209. procedure TXPDUnitMenuWizard.SetupItemClick(Sender: TObject);
  210. begin
  211.   XPDUnitSetup.ShowXPDUnitSetupForm;
  212. end;
  213. procedure TXPDUnitMenuWizard.TestClassItemClick(Sender: TObject);
  214. begin
  215.   if System.Assigned(FTestClassWizard) then
  216.     FTestClassWizard.Execute;
  217. end;
  218. procedure TXPDUnitMenuWizard.TestModuleItemClick(Sender: TObject);
  219. begin
  220.   if System.Assigned(FTestModuleWizard) then
  221.     FTestModuleWizard.Execute;
  222. end;
  223. resourcestring
  224.   sWizardInstallationCaption = 'Find DUnitWizard installation root directory';
  225. procedure TXPDUnitMenuWizard.DocumentationItemClick(Sender: TObject);
  226. var
  227.   Registry: TRegistryIniFile;
  228. {$IFDEF DELPHI7_UP}
  229.   DocumentationRoot: Widestring;
  230. {$ELSE}
  231.   DocumentationRoot: string;
  232. {$ENDIF}
  233.   Documentation: string;
  234. begin
  235.   Registry := TRegistryIniFile.Create(DUnitWizardRegistryKey);
  236.   try
  237.     DocumentationRoot := Registry.ReadString('', 'InstallationRoot', '');
  238.     if (DocumentationRoot = '') then
  239.     begin
  240.       SelectDirectory(sWizardInstallationCaption, '', DocumentationRoot);
  241.      if (DocumentationRoot <> '') then
  242.       Registry.WriteString('', 'InstallationRoot', DocumentationRoot);
  243.       
  244.     end;
  245.     if (DocumentationRoot <> '') then
  246.       Documentation := Format('%sDocsindex.htm', [DocumentationRoot]);
  247.     if SysUtils.FileExists(Documentation) then
  248.       ShellAPI.ShellExecute(Application.Handle, 'open', PChar(Documentation),
  249.         '', '', SW_SHOW);
  250.   finally
  251.     Registry.Free;
  252.   end;
  253. end;
  254. end.