home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1998 February / DPPCPRO0298.ISO / code / visprog.txt next >
Encoding:
Text File  |  1997-11-27  |  4.5 KB  |  167 lines
  1. Listing One
  2.  
  3. unit Importer;
  4.  
  5. { This is an add-in Delphi expert to display the dynamic imports
  6.   needed by the current project's EXE file.
  7.   (c)1997 Dave Jewell, All rights reserved.
  8. }
  9.  
  10. interface
  11.  
  12. uses Windows, SysUtils, Classes, ExptIntf, ToolIntf, Dialogs;
  13.  
  14. type
  15.     TProjectOpenCloseEvent = procedure (Sender: TObject; Opening: Boolean) of Object;
  16.  
  17.     { Custom notifier for Import Export }
  18.     TImportNotifier = class (TIAddInNotifier)
  19.     public
  20.         Hook: TProjectOpenCloseEvent;
  21.         constructor Create;
  22.         destructor Destroy; override;
  23.         procedure EventNotification (NotifyCode: TEventNotification; 
  24.          var Cancel: Boolean); override;
  25.         procedure FileNotification (NotifyCode: TFileNotification; 
  26.          const FileName: String; var Cancel: Boolean); override;
  27.     end;
  28.  
  29.     TImportExpert = class (TIExpert)
  30.     public
  31.         function GetName: string; override;
  32.         function GetAuthor: string; override;
  33.         function GetComment: string; override;
  34.         function GetPage: string; override;
  35.         function GetGlyph: hIcon; override;
  36.         function GetStyle: TExpertStyle; override;
  37.         function GetState: TExpertState; override;
  38.         function GetIDString: string; override;
  39.         function GetMenuText: string; override;
  40.         procedure Execute; override;
  41.         constructor Create;
  42.         destructor Destroy; override;
  43.         procedure MenuClick (Sender: TIMenuItemIntf);
  44.         procedure ProjectNotify (Sender: TObject; Opening: Boolean);
  45.     private
  46.         MyMenuItem: TIMenuItemIntf;
  47.         MyNotifier: TImportNotifier;
  48.     end;
  49.  
  50. implementation
  51.  
  52. resourcestring
  53.     idAuthor   = 'Dave''s ExpertWare Inc.';
  54.     idName     = 'Import Expert';
  55.     idMenuText = 'Project Imports';
  56.     idMenuName = 'ImportMenuItem';
  57.  
  58. { TImportNotifier }
  59.  
  60. constructor TImportNotifier.Create;
  61. begin
  62.     Inherited Create;
  63.     ToolServices.AddNotifierEx (Self);
  64. end;
  65.  
  66. destructor TImportNotifier.Destroy;
  67. begin
  68.     ToolServices.RemoveNotifier (Self);
  69.     Inherited Destroy;
  70. end;
  71.  
  72. procedure TImportNotifier.EventNotification (NotifyCode: TEventNotification; 
  73.                        var Cancel: Boolean);
  74. begin
  75.     { I'm not interested in event notifications }
  76. end;
  77.  
  78. procedure TImportNotifier.FileNotification (NotifyCode: TFileNotification; 
  79.                      const FileName: String; var Cancel: Boolean);
  80. begin
  81.     { Note: fnProjectClosing is not foolproof - see text }
  82.     if Assigned (Hook) and (NotifyCode in [fnProjectOpened, fnProjectClosing]) then
  83.         Hook (Self, NotifyCode = fnProjectOpened);
  84. end;
  85.  
  86. { TImportExpert }
  87.  
  88. constructor TImportExpert.Create;
  89. var
  90.     Target, Parent: TIMenuItemIntf;
  91. begin
  92.     Inherited Create;
  93.     with ToolServices.GetMainMenu do
  94.     try
  95.         Target := FindMenuItem ('ViewPrjSourceItem');
  96.         if Target <> nil then
  97.         try
  98.             Parent := Target.GetParent;
  99.             if Parent <> nil then
  100.             try
  101.                 MyMenuItem := Parent.InsertItem (Target.GetIndex + 1,
  102.                         idMenuText, idMenuName, '', 0, 0, 0,
  103.                         [mfEnabled, mfVisible], MenuClick);
  104.             finally
  105.                 Parent.Free;
  106.             end;
  107.         finally
  108.             Target.Free;
  109.         end;
  110.     finally
  111.         Free;
  112.     end;
  113.  
  114.     MyNotifier := TImportNotifier.Create;
  115.     MyNotifier.Hook := ProjectNotify;
  116. end;
  117.  
  118. destructor TImportExpert.Destroy;
  119. begin
  120.     MyMenuItem.Free;
  121.     MyNotifier.Free;
  122.     Inherited Destroy;
  123. end;
  124.  
  125. function TImportExpert.GetName: string;
  126. begin Result := idName; end;
  127.  
  128. function TImportExpert.GetAuthor: string;
  129. begin Result := ''; end;
  130.  
  131. function TImportExpert.GetComment: string;
  132. begin Result := ''; end;
  133.  
  134. function TImportExpert.GetPage: string;
  135. begin Result := ''; end;
  136.  
  137. function TImportExpert.GetGlyph: hIcon;
  138. begin Result := 0; end;
  139.  
  140. function TImportExpert.GetStyle: TExpertStyle;
  141. begin Result := esAddIn; end;
  142.  
  143. function TImportExpert.GetState: TExpertState;
  144. begin Result := []; end;
  145.  
  146. function TImportExpert.GetIDString: string;
  147. begin Result := idAuthor + idName; end;
  148.  
  149. function TImportExpert.GetMenuText: string;
  150. begin Result := ''; end;
  151.  
  152. procedure TImportExpert.Execute;
  153. begin end;
  154.  
  155. procedure TImportExpert.ProjectNotify (Sender: TObject; Opening: Boolean);
  156. begin
  157.     if Opening then MyMenuItem.SetFlags ([mfEnabled], [mfEnabled])
  158.     else MyMenuItem.SetFlags ([mfEnabled], []);
  159. end;
  160.  
  161. procedure TImportExpert.MenuClick (Sender: TIMenuItemIntf);
  162. begin
  163.     ShowMessage ('Watch this space...');
  164. end;
  165.  
  166. end.
  167.