home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue30 / system / LibExp / LibTest.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-11-27  |  2.7 KB  |  114 lines
  1. unit LibTest;
  2.  
  3. interface
  4.  
  5. uses Windows, SysUtils, Classes, Forms, ExptIntf, ToolIntf, LibIntf, Dialogs;
  6.  
  7. type
  8.     TProjectOpenCloseEvent = procedure (Sender: TObject; Opening: Boolean) of Object;
  9.  
  10.     TLibExpert = class (TIExpert)
  11.     public
  12.         function GetName: string; override;
  13.         function GetAuthor: string; override;
  14.         function GetComment: string; override;
  15.         function GetPage: string; override;
  16.         function GetGlyph: hIcon; override;
  17.         function GetStyle: TExpertStyle; override;
  18.         function GetState: TExpertState; override;
  19.         function GetIDString: string; override;
  20.         function GetMenuText: string; override;
  21.         procedure Execute; override;
  22.         constructor Create;
  23.         destructor Destroy; override;
  24.         procedure MenuClick (Sender: TIMenuItemIntf);
  25.     private
  26.         MyMenuItem: TIMenuItemIntf;
  27.     end;
  28.  
  29. implementation
  30.  
  31. uses LibTestForm;
  32.  
  33. resourcestring
  34.     idAuthor   = 'Dave''s ExpertWare Inc.';
  35.     idName     = 'LibIntf Sample Expert';
  36.     idMenuName = 'LibExptMenuItem';
  37.  
  38. { TLibExpert }
  39.  
  40. constructor TLibExpert.Create;
  41. var
  42.     Target, Parent: TIMenuItemIntf;
  43. begin
  44.     Inherited Create;
  45.     with ToolServices.GetMainMenu do
  46.     try
  47.         Target := FindMenuItem ('ToolsOptionsItem');
  48.         if Target <> nil then
  49.         try
  50.             Parent := Target.GetParent;
  51.             if Parent <> nil then
  52.             try
  53.                 MyMenuItem := Parent.InsertItem (Target.GetIndex + 1,
  54.                         idName, idMenuName, '', 0, 0, 0,
  55.                         [mfEnabled, mfVisible], MenuClick);
  56.             finally
  57.                 Parent.Free;
  58.             end;
  59.         finally
  60.             Target.Free;
  61.         end;
  62.     finally
  63.         Free;
  64.     end;
  65. end;
  66.  
  67. destructor TLibExpert.Destroy;
  68. begin
  69.     MyMenuItem.Free;
  70.     Inherited Destroy;
  71. end;
  72.  
  73. function TLibExpert.GetName: string;
  74. begin Result := idName; end;
  75.  
  76. function TLibExpert.GetAuthor: string;
  77. begin Result := ''; end;
  78.  
  79. function TLibExpert.GetComment: string;
  80. begin Result := ''; end;
  81.  
  82. function TLibExpert.GetPage: string;
  83. begin Result := ''; end;
  84.  
  85. function TLibExpert.GetGlyph: hIcon;
  86. begin Result := 0; end;
  87.  
  88. function TLibExpert.GetStyle: TExpertStyle;
  89. begin Result := esAddIn; end;
  90.  
  91. function TLibExpert.GetState: TExpertState;
  92. begin Result := []; end;
  93.  
  94. function TLibExpert.GetIDString: string;
  95. begin Result := idAuthor + idName; end;
  96.  
  97. function TLibExpert.GetMenuText: string;
  98. begin Result := ''; end;
  99.  
  100. procedure TLibExpert.Execute;
  101. begin end;
  102.  
  103. procedure TLibExpert.MenuClick (Sender: TIMenuItemIntf);
  104. begin
  105.     with TLibExTest.Create (Application) do try
  106.         ShowModal;
  107.     finally
  108.         Free;
  109.     end;
  110. end;
  111.  
  112. end.
  113.  
  114.