SearchPath.pas 5.6 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199
  1. unit SearchPath;
  2. interface
  3. uses
  4. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  5. Dialogs, StdCtrls, ExtCtrls, JvComponent, JvBaseDlg, JvBrowseFolder,
  6. JvExStdCtrls, JvListBox, JvDotNetControls, Mask, JvExMask, JvToolEdit;
  7. type
  8. TfrmSearchPath = class(TForm)
  9. GroupBox1: TGroupBox;
  10. Panel1: TPanel;
  11. btnAdd: TButton;
  12. btnDelete: TButton;
  13. btnDeleteInvalid: TButton;
  14. btnReplace: TButton;
  15. txtSearchPath: TJvDotNetDirectoryEdit;
  16. lstSearchPath: TJvDotNetListBox;
  17. lblMessage: TLabel;
  18. btnCancel: TButton;
  19. btnOk: TButton;
  20. procedure FormShow(Sender: TObject);
  21. procedure lstSearchPathDrawItem(Control: TWinControl; Index: Integer;
  22. Rect: TRect; State: TOwnerDrawState);
  23. procedure txtSearchPathButtonClick(Sender: TObject);
  24. procedure btnAddClick(Sender: TObject);
  25. procedure btnReplaceClick(Sender: TObject);
  26. procedure lstSearchPathClick(Sender: TObject);
  27. procedure btnDeleteInvalidClick(Sender: TObject);
  28. procedure btnOkClick(Sender: TObject);
  29. procedure btnDeleteClick(Sender: TObject);
  30. private
  31. { Private declarations }
  32. public
  33. { Public declarations }
  34. procedure InitSearchPathForm(SearchPathString, SearchPathFormTitle, SearchPathMessage: String);
  35. function GetSearchPathString(): String;
  36. end;
  37. var
  38. frmSearchPath: TfrmSearchPath;
  39. implementation
  40. {$R *.dfm}
  41. procedure TfrmSearchPath.InitSearchPathForm(SearchPathString, SearchPathFormTitle, SearchPathMessage: String);
  42. begin
  43. // Initialize a few things before filling
  44. lstSearchPath.Clear;
  45. lstSearchPath.Items.CommaText := SearchPathString;
  46. Self.Caption := SearchPathFormTitle;
  47. lblMessage.Caption := SearchPathMessage;
  48. end;
  49. function TfrmSearchPath.GetSearchPathString(): String;
  50. var
  51. x: Integer;
  52. begin
  53. for x := 0 to lstSearchPath.Items.Count - 1 do
  54. begin
  55. if x = 0 then
  56. Result := '"' + lstSearchPath.Items[x] + '"'
  57. else
  58. Result := Result + ', "' + lstSearchPath.Items[x] + '"';
  59. end;
  60. end;
  61. procedure TfrmSearchPath.FormShow(Sender: TObject);
  62. begin
  63. if lstSearchPath.Count > 0 then
  64. begin
  65. lstSearchPath.Selected[0] := True;
  66. txtSearchPath.Text := lstSearchPath.Items[0];
  67. end;
  68. end;
  69. procedure TfrmSearchPath.lstSearchPathDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  70. begin
  71. // if current item is selected, simply use white
  72. if odSelected in State then
  73. begin
  74. lstSearchPath.Canvas.Font.Color := clWhite;
  75. end
  76. else
  77. begin
  78. // Determine color of font to use according existance of the directory
  79. if DirectoryExists(lstSearchPath.Items[Index]) then
  80. lstSearchPath.Canvas.Font.Color := clBlack
  81. else
  82. lstSearchPath.Canvas.Font.Color := lstSearchPath.DisabledTextColor;
  83. end;
  84. // Draw the text
  85. lstSearchPath.Canvas.TextRect(Rect, Rect.Left, Rect.Top, ' '+lstSearchPath.Items[Index]);
  86. end;
  87. procedure TfrmSearchPath.txtSearchPathButtonClick(Sender: TObject);
  88. begin
  89. if DirectoryExists(txtSearchPath.Text) then
  90. txtSearchPath.InitialDir := txtSearchPath.Text
  91. else
  92. txtSearchPath.InitialDir := ExtractFilePath(Application.ExeName);
  93. end;
  94. procedure TfrmSearchPath.btnAddClick(Sender: TObject);
  95. var
  96. ItemInList: Boolean;
  97. FormatedPath: String;
  98. x: Integer;
  99. begin
  100. if txtSearchPath.Text <> '' then
  101. begin
  102. // Initialize stuff
  103. ItemInList := False;
  104. // Format search path to add (add '\' character if none)
  105. if Copy(txtSearchPath.Text, Length(txtSearchPath.Text), 1) <> '\' then
  106. FormatedPath := txtSearchPath.Text + '\'
  107. else
  108. FormatedPath := txtSearchPath.Text;
  109. // Search for new path in list
  110. for x := 0 to lstSearchPath.Count - 1 do
  111. begin
  112. if lstSearchPath.Items[x] = FormatedPath then
  113. ItemInList := True;
  114. end;
  115. // Add path to list only if not already in the list
  116. if not ItemInList then
  117. lstSearchPath.Items.Add(FormatedPath);
  118. btnReplace.Enabled := (lstSearchPath.ItemIndex <> -1);
  119. btnDelete.Enabled := (lstSearchPath.ItemIndex <> -1);
  120. btnDeleteInvalid.Enabled := (lstSearchPath.Count > 0);
  121. end;
  122. end;
  123. procedure TfrmSearchPath.btnReplaceClick(Sender: TObject);
  124. begin
  125. // Replace selected item by new path if any item is selected
  126. if lstSearchPath.ItemIndex <> -1 then
  127. lstSearchPath.Items[lstSearchPath.ItemIndex] := txtSearchPath.Text;
  128. end;
  129. procedure TfrmSearchPath.lstSearchPathClick(Sender: TObject);
  130. begin
  131. btnReplace.Enabled := (lstSearchPath.ItemIndex <> -1);
  132. btnDelete.Enabled := (lstSearchPath.ItemIndex <> -1);
  133. if lstSearchPath.ItemIndex <> -1 then
  134. txtSearchPath.Text := lstSearchPath.Items[lstSearchPath.ItemIndex]
  135. else
  136. txtSearchPath.Text := '';
  137. end;
  138. procedure TfrmSearchPath.btnDeleteClick(Sender: TObject);
  139. var
  140. DeletedIndex: Integer;
  141. begin
  142. DeletedIndex := lstSearchPath.ItemIndex;
  143. // Delete currently selected item if any
  144. if lstSearchPath.ItemIndex <> -1 then
  145. lstSearchPath.Items.Delete(lstSearchPath.ItemIndex);
  146. // Select next or previous in the list if any
  147. if ((lstSearchPath.Count > 0) and (DeletedIndex <> -1)) then
  148. begin
  149. if lstSearchPath.Count >= DeletedIndex + 1 then
  150. lstSearchPath.Selected[DeletedIndex] := True
  151. else
  152. lstSearchPath.Selected[DeletedIndex - 1] := True;
  153. end;
  154. btnReplace.Enabled := (lstSearchPath.ItemIndex <> -1);
  155. btnDelete.Enabled := (lstSearchPath.ItemIndex <> -1);
  156. btnDeleteInvalid.Enabled := (lstSearchPath.Count > 0);
  157. end;
  158. procedure TfrmSearchPath.btnDeleteInvalidClick(Sender: TObject);
  159. var
  160. x: Integer;
  161. begin
  162. for x := lstSearchPath.Items.Count - 1 downto 0 do
  163. begin
  164. if not DirectoryExists(lstSearchPath.Items[x]) then
  165. lstSearchPath.Items.Delete(x);
  166. end;
  167. end;
  168. procedure TfrmSearchPath.btnOkClick(Sender: TObject);
  169. begin
  170. ModalResult := mrOk;
  171. end;
  172. end.