home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / WIN / Programa / FILEEXP.ZIP / FILEEXPU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-20  |  8.9 KB  |  291 lines
  1. unit FileExpU;
  2.  
  3. interface
  4.  
  5. uses Windows, Controls, Forms, Menus, Dialogs, Classes, ToolIntf, EditIntf, ExptIntf, VirtIntf, Registry, SysUtils,
  6.      Messages, Graphics, StdCtrls;
  7.  
  8. type
  9.   TfrmFileName = class(TForm)
  10.     lblFileName: TLabel;
  11.     cmbFiles: TComboBox;
  12.     btnOk: TButton;
  13.     btnCancel: TButton;
  14.     btnBrowse: TButton;
  15.     procedure btnOkClick(Sender: TObject);
  16.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  17.     procedure FormDestroy(Sender: TObject);
  18.     procedure btnCancelClick(Sender: TObject);
  19.     procedure btnBrowseClick(Sender: TObject);
  20.   private
  21.   public
  22.     lstFolders: TStringList;
  23.     procedure   ShowDlg(lst: TStringList);
  24.     procedure   OpenFile(sFile: String);
  25.   end;
  26.  
  27.   //... and the Expert
  28.   TFileNameExpert = class(TIExpert)
  29.     menFileExp:     TIMenuItemIntf;
  30.     menFileSep:     TIMenuItemIntf;
  31.     menFileProp:    TIMenuItemIntf;
  32.     lstFolders:     TStringList;
  33.     constructor     Create; virtual;
  34.     destructor      Destroy; override;
  35.     function        GetName: string; override;
  36.     function        GetStyle: TExpertStyle; override;
  37.     function        GetState: TExpertState; override;
  38.     function        GetIDString: string; override;
  39.     procedure       menFileExpClick(Sender: TIMenuItemIntf); virtual;
  40.     procedure       menFileExpPropertiesClick(Sender: TIMenuItemIntf); virtual;
  41.     procedure       Execute; override;
  42.   end;
  43.  
  44. function InitExpert(ToolServices: TIToolServices; Registerproc: TExpertRegisterproc; var Terminate: TExpertTerminateProc): Boolean; export; stdcall;
  45.  
  46. var expFile:     TFileNameExpert = NIL;
  47.     frmFileName: TFrmFileName    = NIL;
  48.  
  49. implementation
  50.  
  51. uses Properties;
  52.  
  53. {$R *.DFM}
  54.  
  55. //********* ...and the Expert **************************************************************************************************
  56. constructor TFileNameExpert.Create;
  57. var         menMain:        TIMainMenuIntf;
  58.             menViewWinList: TIMenuItemIntf;
  59.             menViewMenu:    TIMenuItemIntf;
  60.             lst:            TStringList;
  61. begin
  62.   inherited Create;
  63.   menMain:=ToolServices.GetMainMenu;
  64.   if Assigned(menMain) then
  65.   try
  66.     menViewWinList:=menMain.FindMenuItem('FileCloseAllItem');
  67.     if Assigned(menViewWinList) then
  68.     try
  69.       menViewMenu:=menViewWinList.GetParent;
  70.       if Assigned(menViewMenu) then
  71.       try
  72.         menFileSep:=menViewMenu.InsertItem(menViewWinList.GetIndex+1, '-', 'FileSeparator1', '', 0, 0, 0, [mfVisible], NIL);
  73.         menFileExp:=menViewMenu.InsertItem(menFileSep.GetIndex+1, 'F&ileName Expert', 'FileExpItem', '', ShortCut(Ord('F'), [ssCtrl, ssAlt]), 0, 0, [mfEnabled, mfVisible], menFileExpClick);
  74.         menFileProp:=menViewMenu.InsertItem(menFileExp.GetIndex+1, 'FileName Expert Properties', 'FileExpProperties', '', ShortCut(Ord('O'), [ssCtrl, ssAlt]), 0, 0, [mfEnabled, mfVisible], menFileExpPropertiesClick);
  75.       finally
  76.         menViewMenu.Free;
  77.       end;
  78.     finally
  79.       menViewWinList.Free;
  80.     end;
  81.   finally
  82.     menMain.Free;
  83.   end;
  84.   frmFileName:=TfrmFileName.Create(Application);
  85.   with TRegistry.Create do begin
  86.     RootKey:=HKEY_CURRENT_USER;
  87.     OpenKey('\Software\Abacus Research AG\FileExp', TRUE);
  88.     if ValueExists('Top') then
  89.       frmFileName.Top:=ReadInteger('Top');
  90.     if ValueExists('Left') then
  91.       frmFileName.Left:=ReadInteger('Left');
  92.     lst:=TStringList.Create;
  93.     OpenKey('Files', TRUE);
  94.     GetValueNames(lst);
  95.     frmFileName.cmbFiles.Items.Assign(lst);
  96.     OpenKey('\Software\Abacus Research AG\FileExp\Folders', TRUE);
  97.     lstFolders:=TStringList.Create;
  98.     GetValueNames(lstFolders);
  99.     lst.Free;
  100.     CloseKey;
  101.     Free;
  102.   end;
  103. end;
  104.  
  105. destructor  TFileNameExpert.Destroy;
  106. var         lCounter: Longint;
  107. begin
  108.   with TRegistry.Create do begin
  109.     RootKey:=HKEY_CURRENT_USER;
  110.     OpenKey('\Software\Abacus Research AG\FileExp', TRUE);
  111.     WriteInteger('Top', frmFileName.Top);
  112.     WriteInteger('Left', frmFileName.Left);
  113.     DeleteKey('Files');
  114.     OpenKey('Files', TRUE);
  115.     for lCounter:=0 to Pred(frmFileName.cmbFiles.Items.Count) do
  116.       WriteString(frmFileName.cmbFiles.Items[lCounter], '');
  117.     OpenKey('\Software\Abacus Research AG\FileExp', TRUE);
  118.     DeleteKey('Folders');
  119.     OpenKey('Folders', TRUE);
  120.     for lCounter:=0 to Pred(lstFolders.Count) do
  121.       WriteString(lstFolders[lCounter], '');
  122.     CloseKey;
  123.     Free;
  124.   end;
  125.   lstFolders.Free;
  126.   menFileProp.Free;
  127.   menFileExp.Free;
  128.   menFileSep.Free;
  129.   frmFileName.Free;
  130.   inherited Destroy;
  131. end;
  132.  
  133. procedure   TFileNameExpert.menFileExpClick(Sender: TIMenuItemIntf);
  134. begin
  135.   frmFileName.ShowDlg(lstFolders);
  136. end;
  137.  
  138. procedure   TFileNameExpert.menFileExpPropertiesClick(Sender: TIMenuItemIntf);
  139. begin
  140.   with TfrmProperties.Create(Application) do begin
  141.     ShowDlg(Self.lstFolders);
  142.     Free;
  143.   end;
  144. end;
  145.  
  146. procedure   TFileNameExpert.Execute;
  147. begin
  148.   frmFileName.ShowDlg(lstFolders);
  149. end;
  150.  
  151. function    TFileNameExpert.GetName: String;
  152. begin
  153.   Result:='Filename Expert';
  154. end;
  155.  
  156. function    TFileNameExpert.GetStyle: TExpertStyle;
  157. begin
  158.   Result:=esAddIn;
  159. end;
  160.  
  161. function    TFileNameExpert.GetState: TExpertState;
  162. begin
  163.   Result := [esEnabled];
  164. end;
  165.  
  166. function    TFileNameExpert.GetIDString: String;
  167. begin
  168.   Result:='Abacus.FilenameExpert';
  169. end;
  170.  
  171. //******* Registration code ***************************************************************************************************
  172. procedure Register;
  173. begin
  174.   RegisterLibraryExpert(TFileNameExpert.Create);
  175. end;
  176.  
  177. procedure TerminateProc;
  178. begin
  179. end;
  180.  
  181. function    InitExpert(ToolServices: TIToolServices; Registerproc: TExpertRegisterproc; var Terminate: TExpertTerminateProc): Boolean; export; stdcall;
  182. begin
  183.   Result:=ExptIntf.ToolServices=NIL;
  184.   if not Result then
  185.     exit;
  186.   ExptIntf.ToolServices:=ToolServices;
  187.   if Assigned(ToolServices) then
  188.     Application.Handle:=ToolServices.GetParentHandle;
  189.   Terminate:=NIL;
  190.   expFile:=TFileNameExpert.Create;
  191.   RegisterProc(expFile);
  192. end;
  193.  
  194. //******* The Form Code *******************************************************************************************************
  195. procedure TfrmFileName.OpenFile(sFile: String);
  196. var       hn:      HWND;
  197.           mModule: TIModuleInterface;
  198. begin
  199.   hn:=FindWindow('TEditWindow', NIL);
  200.   if hn=0 then begin
  201.     ShowMessage('Cannot find an editor window');
  202.     exit;
  203.   end;
  204.   try
  205.     if not ToolServices.IsFileOpen(sFile) then begin
  206.       ToolServices.OpenFile(sFile);
  207.       mModule:=ToolServices.GetModuleInterface(sFile);
  208.       if Assigned(mModule) then
  209.       try
  210.         mModule.ShowSource;
  211.       finally
  212.         mModule.Free;
  213.       end;
  214.     end;
  215.   except
  216.     ShowMessage('couldn''t open file '+sFile);
  217.   end;
  218. end;
  219.  
  220. procedure TfrmFileName.ShowDlg(lst: TStringList);
  221. begin
  222.   if not Assigned(lstFolders) then
  223.     lstFolders:=TStringList.Create;
  224.   lstFolders.Assign(lst);
  225.   ShowModal;
  226. end;
  227.  
  228. procedure TfrmFileName.btnOkClick(Sender: TObject);
  229. var       lCounter:    Longint;
  230.           sFolderList: String;
  231.           bFound:      Boolean;
  232. begin
  233.   sFolderList:='';
  234.   for lCounter:=0 to Pred(cmbFiles.Items.Count) do
  235.     if UpperCase(cmbFiles.Items[lCounter])=UpperCase(cmbFiles.Text) then begin
  236.       bFound:=TRUE;
  237.       break;
  238.     end;
  239.   if not bFound then
  240.     cmbFiles.Items.Add(cmbFiles.Text);
  241.   for lCounter:=0 to Pred(lstFolders.Count) do
  242.     sFolderList:=sFolderList+lstFolders[lCounter]+';';
  243.   if (ExtractFilePath(cmbFiles.Text)='') then  // Kein Pfad angegeben?
  244.     if FileSearch(cmbFiles.Text, sFolderList)='' then  // Kommt das Mistding auch nirgends anders vor?
  245.       if FileSearch(cmbFiles.Text+'.PAS', sFolderList)='' then  // Vielleicht mit Extension?
  246.         ShowMessage('couldn''t find '+cmbFiles.Text)
  247.       else
  248.         OpenFile(FileSearch(cmbFiles.Text+'.PAS', sFolderList))
  249.     else
  250.       OpenFile(FileSearch(cmbFiles.Text, sFolderList))
  251.   else  // Pfad angegeben
  252.     if not FileExists(cmbFiles.Text) then  // nicht gefunden
  253.       if not FileExists(cmbFiles.Text+'.PAS') then  // vielleicht mit Extension?
  254.         ShowMessage('couldn''t find file '+cmbFiles.Text+' in any folder!')
  255.       else
  256.         OpenFile(cmbFiles.Text+'.PAS') // Yep
  257.     else
  258.       OpenFile(cmbFiles.Text)  // geht auch ohne (opder schon agegeben)
  259. end;
  260.  
  261. procedure TfrmFileName.FormClose(Sender: TObject; var Action: TCloseAction);
  262. begin
  263.   Action:=caHide;
  264. end;
  265.  
  266. procedure TfrmFileName.FormDestroy(Sender: TObject);
  267. begin
  268.   lstFolders.Free;
  269. end;
  270.  
  271. procedure TfrmFileName.btnCancelClick(Sender: TObject);
  272. begin
  273.   Hide;
  274. end;
  275.  
  276. procedure TfrmFileName.btnBrowseClick(Sender: TObject);
  277. var       sInitDir: String;
  278. begin
  279.   with TOpenDialog.Create(Application) do begin
  280.     Options:=[ofFileMustExist, ofPathMustExist, ofShowHelp];
  281.     GetDir(0, sInitDir);
  282.     InitialDir:=sInitDir;
  283.     Filter:='Pascal Files (*.pas)|*.pas|Project Files (*.dpr)|*.dpr|All Files (*.*)|*.*';
  284.     if Execute then
  285.       cmbFiles.Text:=FileName;
  286.     Free;
  287.   end;
  288. end;
  289.  
  290. end.
  291.