home *** CD-ROM | disk | FTP | other *** search
/ CD Shareware Magazine 1996 December / CD_shareware_12-96.iso / WIN / Programa / FILEEXP.ZIP / PROPERTI.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-08-20  |  4.0 KB  |  139 lines
  1. unit Properties;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, BrowseDr, Registry, About;
  8.  
  9. type
  10.   TfrmProperties = class(TForm)
  11.     lstFolders: TListBox;
  12.     lblFolders: TLabel;
  13.     btnOk: TButton;
  14.     btnCancel: TButton;
  15.     btnDefault: TButton;
  16.     txtFolderName: TEdit;
  17.     lblFolderName: TLabel;
  18.     btnBrowse: TButton;
  19.     btnAdd: TButton;
  20.     btnRemove: TButton;
  21.     btnAbout: TButton;
  22.     btnRemFiles: TButton;
  23.     btnRemFolders: TButton;
  24.     procedure btnBrowseClick(Sender: TObject);
  25.     procedure btnAddClick(Sender: TObject);
  26.     procedure btnRemoveClick(Sender: TObject);
  27.     procedure lstFoldersKeyDown(Sender: TObject; var Key: Word;
  28.       Shift: TShiftState);
  29.     procedure lstFoldersClick(Sender: TObject);
  30.     procedure btnDefaultClick(Sender: TObject);
  31.     procedure btnAboutClick(Sender: TObject);
  32.     procedure btnRemFoldersClick(Sender: TObject);
  33.     procedure btnRemFilesClick(Sender: TObject);
  34.   private
  35.     { Private declarations }
  36.   public
  37.     procedure ShowDlg(lst: TStringList);
  38.   end;
  39.  
  40. var
  41.   frmProperties: TfrmProperties;
  42.  
  43. implementation
  44.  
  45. uses FileExpU;
  46.  
  47. {$R *.DFM}
  48.  
  49. procedure TfrmProperties.ShowDlg(lst: TStringList);
  50. begin
  51.   lstFolders.Items.Assign(lst);
  52.   if ShowModal=mrOk then
  53.     lst.Assign(lstFolders.Items);
  54. end;
  55.  
  56. procedure TfrmProperties.btnBrowseClick(Sender: TObject);
  57. var       sSelected: String;
  58. begin
  59.   if BrowseDirectory(sSelected, Self, 'Choose Directory', idDesktopExpanded, [bfDirectoriesOnly]) then
  60.     txtFolderName.Text:=sSelected;
  61. end;
  62.  
  63. procedure TfrmProperties.btnAddClick(Sender: TObject);
  64. var       lCounter: Longint;
  65. begin
  66.   if Trim(txtFolderName.Text)='' then
  67.     exit;
  68.   for lCounter:=0 to Pred(lstFolders.Items.Count) do
  69.     if UpperCase(lstFolders.Items[lCounter])=UpperCase(txtFolderName.Text) then
  70.       exit;
  71.   lstFolders.Items.Add(txtFolderName.Text);
  72. end;
  73.  
  74. procedure TfrmProperties.btnRemoveClick(Sender: TObject);
  75. begin
  76.   if lstFolders.ItemIndex>=0 then
  77.     lstFolders.Items.Delete(lstFolders.ItemIndex);
  78. end;
  79.  
  80. procedure TfrmProperties.lstFoldersKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  81. begin
  82.   if Key=VK_DELETE then
  83.     btnRemoveClick(Sender);
  84. end;
  85.  
  86. procedure TfrmProperties.lstFoldersClick(Sender: TObject);
  87. begin
  88.   txtFolderName.Text:=lstFolders.Items[lstFolders.ItemIndex];
  89. end;
  90.  
  91. procedure TfrmProperties.btnDefaultClick(Sender: TObject);
  92. var       lCounter:  Longint;
  93.           lCounter2: Longint;
  94.           bFound:    Boolean;
  95.           asDefault: array[1..5] of String;
  96. begin
  97.   with TRegistry.Create do begin
  98.     RootKey:=HKEY_LOCAL_MACHINE;
  99.     OpenKey('\Software\Borland\Delphi\2.0', TRUE);
  100.     asDefault[1]:=ReadString('RootDir')+'\Source\VCL';
  101.     asDefault[2]:=ReadString('RootDir')+'\Source\RTL\WIN';
  102.     asDefault[3]:=ReadString('RootDir')+'\Source\RTL\SYS';
  103.     asDefault[4]:=ReadString('RootDir')+'\Source\ToolsAPI';
  104.     OpenKey('\Software\Abacus Research AG\Abalib32', TRUE);
  105.     asDefault[5]:=ReadString('InstallDir')+'\aba\lib';
  106.     Free;
  107.   end;
  108.   for lCounter2:=1 to 5 do begin
  109.     bFound:=FALSE;
  110.     for lCounter:=0 to Pred(lstFolders.Items.Count) do
  111.       if UpperCase(asDefault[lCounter2])=UpperCase(lstFolders.Items[lCounter]) then
  112.         bFound:=TRUE;
  113.     if not bFound then
  114.       lstFolders.Items.Add(asDefault[lCounter2]);
  115.   end;
  116. end;
  117.  
  118. procedure TfrmProperties.btnAboutClick(Sender: TObject);
  119. begin
  120.   with TfrmAbout.Create(Application) do begin
  121.     ShowDialog('1.07');
  122.     Free;
  123.   end;
  124. end;
  125.  
  126. procedure TfrmProperties.btnRemFoldersClick(Sender: TObject);
  127. begin
  128.   if MessageDlg('Are you really sure to remove all paths from the Folders List?', mtConfirmation, [mbYes, mbNo], 0)=idYes then
  129.     lstFolders.Items.Clear;
  130. end;
  131.  
  132. procedure TfrmProperties.btnRemFilesClick(Sender: TObject);
  133. begin
  134.   if MessageDlg('Are you really sure to remove all items from the FileName Combo?', mtConfirmation, [mbYes, mbNo], 0)=idYes then
  135.     frmFileName.cmbFiles.Items.Clear;
  136. end;
  137.  
  138. end.
  139.