1 unit frmFileBrowser;
2
3 {$mode objfpc}{$H+}
4
5 interface
6
7 uses
8 Classes, SysUtils,
9 // LCL
10 LCLType, Forms, Controls, Dialogs, FileCtrl, ComCtrls, StdCtrls, ExtCtrls,
11 // LazUtils
12 FileUtil, LazFileUtils, LazUTF8;
13
14 type
15 TOpenFileEvent = procedure(Sender: TObject; const AFileName: string) of object;
16
17 { TFileBrowserForm }
18
19 TFileBrowserForm = class(TForm)
20 btnConfigure: TButton;
21 btnReload: TButton;
22 cbHidden: TCheckBox;
23 FileListBox: TFileListBox;
24 FilterComboBox: TFilterComboBox;
25 Panel1: TPanel;
26 Splitter1: TSplitter;
27 TV: TTreeView;
28 procedure btnConfigureClick(Sender: TObject);
29 procedure btnReloadClick(Sender: TObject);
30 procedure cbHiddenChange(Sender: TObject);
31 procedure FileListBoxDblClick(Sender: TObject);
32 procedure FilterComboBoxChange(Sender: TObject);
33 procedure FormClose(Sender: TObject; var CloseAction: TCloseAction);
34 procedure FormCreate(Sender: TObject);
35 procedure FormShow(Sender: TObject);
36 procedure TVExpanded(Sender: TObject; Node: TTreeNode);
37 procedure TVSelectionChanged(Sender: TObject);
38 procedure FormActivate(Sender: TObject);
39 procedure FilterComboBoxSelect(Sender: TObject);
40 procedure FileListBoxKeyPress(Sender: TObject; var Key: char);
41 private
42 FOnConfigure: TNotifyEvent;
43 FOnOpenFile: TOpenFileEvent;
44 FOnSelectDir: TNotifyEvent;
45 FRootDir: string;
46 FDir: string;
47 FShowHidden: Boolean;
48 procedure AddDirectories(Node: TTreeNode; Dir: string);
GetAbsolutePathnull49 function GetAbsolutePath(Node: TTreeNode): string;
50 procedure SetDir(const Value: string);
51 procedure SetRootDir(const Value: string);
52 procedure InitializeTreeview;
53 {$IFDEF MSWINDOWS}
54 procedure AddWindowsDriveLetters;
55 {$ENDIF}
56 public
57 { return the selected directory }
SelectedDirnull58 function SelectedDir: string;
59 { The selected/opened directory }
60 property Directory: string read FDir write SetDir;
61 { Directory the treeview starts from }
62 property RootDirectory: string read FRootDir write SetRootDir;
63 { Must we show hidden directories - not working on unix type systems }
64 property ShowHidden: Boolean read FShowHidden write FShowHidden default False;
65 { Called when user double-clicks file name }
66 property OnOpenFile: TOpenFileEvent read FOnOpenFile write FOnOpenFile;
67 { Called when user clicks configure button }
68 property OnConfigure: TNotifyEvent read FOnConfigure write FOnConfigure;
69 { Called when a new directory is selected }
70 property OnSelectDir: TNotifyEvent read FOnSelectDir write FOnSelectDir;
71 end;
72
73 var
74 FileBrowserForm: TFileBrowserForm;
75
76
77 implementation
78
79 {$R frmfilebrowser.lfm}
80
81 {$IFDEF MSWINDOWS}
82 uses
83 Windows;
84 {$ENDIF}
85
86 const
87 cFilter = 'All Files (' + AllFilesMask + ')|' + AllFilesMask +
88 '|Source(*.pas;*.pp)|*.pas;*.pp' +
89 '|Projectfiles(*.pas;*.pp;*.inc;*.lfm;*.lpr;*.lrs;*.lpi;*.lpk)|' +
90 '*.pas;*.pp;*.inc;*.lfm;*.lpr;*.lrs;*.lpi;*.lpk;|';
91
92
93 {function HasSubDirs returns True if the directory passed has subdirectories}
HasSubDirsnull94 function HasSubDirs(const Dir: string; AShowHidden: Boolean): Boolean;
95 var
96 FileInfo: TSearchRec;
97 FCurrentDir: string;
98 begin
99 //Assume No
100 Result := False;
101 if Dir <> '' then
102 begin
103 FCurrentDir := AppendPathDelim(Dir);
104 FCurrentDir := FCurrentDir + GetAllFilesMask;
105 try
106 if SysUtils.FindFirst(FCurrentDir, faAnyFile or $00000080, FileInfo) = 0 then
107 repeat
108 if FileInfo.Name = '' then
109 Continue;
110
111 // check if special file
112 if ((FileInfo.Name = '.') or (FileInfo.Name = '..')) or
113 // unix dot directories (aka hidden directories)
114 ((FileInfo.Name[1] in ['.']) and AShowHidden) or
115 // check Hidden attribute
116 (((faHidden and FileInfo.Attr) > 0) and AShowHidden) then
117 Continue;
118
119 Result := ((faDirectory and FileInfo.Attr) > 0);
120
121 //We found at least one non special dir, that's all we need.
122 if Result then
123 break;
124 until SysUtils.FindNext(FileInfo) <> 0;
125 finally
126 SysUtils.FindClose(FileInfo);
127 end;
128 end;
129 end;
130
131
132 { TFileBrowserForm }
133
134 procedure TFileBrowserForm.TVExpanded(Sender: TObject; Node: TTreeNode);
135 begin
136 if Node.Count = 0 then
137 AddDirectories(Node, GetAbsolutePath(Node));
138 end;
139
140 procedure TFileBrowserForm.TVSelectionChanged(Sender: TObject);
141 begin
142 FileListBox.Directory := ChompPathDelim(SelectedDir);
143 if Assigned(OnSelectDir) then
144 OnselectDir(Self);
145 end;
146
147 procedure TFileBrowserForm.FormActivate(Sender: TObject);
148 begin
149 { for some reason this does not work in FormShow }
150 TV.MakeSelectionVisible;
151 end;
152
153 procedure TFileBrowserForm.FilterComboBoxSelect(Sender: TObject);
154 begin
155 FileListBox.Mask := FilterComboBox.Mask;
156 end;
157
158 procedure TFileBrowserForm.FileListBoxKeyPress(Sender: TObject; var Key: char);
159 begin
160 if Key = Char(VK_RETURN) then
161 FileListBoxDblClick(Sender);
162 end;
163
164 procedure TFileBrowserForm.btnConfigureClick(Sender: TObject);
165 begin
166 if Assigned(FOnConfigure) then
167 FOnConfigure(Self);
168 end;
169
170 procedure TFileBrowserForm.btnReloadClick(Sender: TObject);
171 var
172 d: string;
173 begin
174 // save current directory location
175 d := ChompPathDelim(SelectedDir);
176 // rebuild tree
177 TV.Items.Clear;
178 InitializeTreeview;
179 // restore directory
180 Directory := d;
181 end;
182
183 procedure TFileBrowserForm.cbHiddenChange(Sender: TObject);
184 begin
185 ShowHidden := cbHidden.Checked;
186 if ShowHidden then
187 FileListBox.FileType := FileListBox.FileType + [ftHidden]
188 else
189 FileListBox.FileType := FileListBox.FileType - [ftHidden];
190 end;
191
192 procedure TFileBrowserForm.FileListBoxDblClick(Sender: TObject);
193 begin
194 if Assigned(FOnOpenFile) then
195 FOnOpenFile(Self, FileListBox.FileName);
196 end;
197
198 procedure TFileBrowserForm.FilterComboBoxChange(Sender: TObject);
199 begin
200 FileListBox.Mask := FilterComboBox.Text;
201 end;
202
203 procedure TFileBrowserForm.FormClose(Sender: TObject; var CloseAction: TCloseAction);
204 begin
205
206 end;
207
208 procedure TFileBrowserForm.FormCreate(Sender: TObject);
209 begin
210 FShowHidden := False;
211 InitializeTreeview;
212 FilterComboBox.Filter := cFilter;
213 end;
214
215 procedure TFileBrowserForm.FormShow(Sender: TObject);
216 begin
217 if TV.Selected <> nil then
218 TV.Selected.Expand(False);
219 end;
220
221 { Adds Subdirectories to a passed node if they exist }
222 procedure TFileBrowserForm.AddDirectories(Node: TTreeNode; Dir: string);
223 var
224 FileInfo: TSearchRec;
225 NewNode: TTreeNode;
226 i: integer;
227 FCurrentDir: string;
228 //used to sort the directories.
229 SortList: TStringListUTF8Fast;
230 begin
231 if Dir <> '' then
232 begin
233 FCurrentDir := Dir;
234 FCurrentDir := AppendPathDelim(FCurrentDir);
235 i := length(FCurrentDir);
236 FCurrentDir := FCurrentDir + GetAllFilesMask;
237 try
238 if SysUtils.FindFirst(FCurrentDir, faAnyFile or $00000080, FileInfo) = 0 then
239 begin
240 try
241 SortList := TStringListUTF8Fast.Create;
242 repeat
243 // check if special file
244 if (FileInfo.Name = '.') or (FileInfo.Name = '..') or (FileInfo.Name = '') then
245 Continue;
246 // if hidden files or directories must be filtered, we test for
247 // dot files, considered hidden under unix type OS's.
248 if not FShowHidden then
249 if (FileInfo.Name[1] in ['.']) then
250 Continue;
251
252 // if this is a directory then add it to the tree.
253 if ((faDirectory and FileInfo.Attr) > 0) then
254 begin
255 //if this is a hidden file and we have not been requested to show
256 //hidden files then do not add it to the list.
257 if ((faHidden and FileInfo.Attr) > 0) and not FShowHidden then
258 continue;
259
260 SortList.Add(FileInfo.Name);
261 end;
262 until SysUtils.FindNext(FileInfo) <> 0;
263 SortList.Sorted := True;
264 for i := 0 to SortList.Count - 1 do
265 begin
266 NewNode := TV.Items.AddChild(Node, SortList[i]);
267 // if subdirectories then indicate so.
268 NewNode.HasChildren := HasSubDirs(AppendPathDelim(Dir) + NewNode.Text, FShowHidden);
269 end;
270 finally
271 SortList.Free;
272 end;
273 end; { if FindFirst... }
274 finally
275 SysUtils.FindClose(FileInfo);
276 end;
277 end; { if Dir... }
278 if Node.Level = 0 then
279 Node.Text := Dir;
280 end;
281
TFileBrowserForm.GetAbsolutePathnull282 function TFileBrowserForm.GetAbsolutePath(Node: TTreeNode): string;
283 begin
284 Result := '';
285 while Node <> nil do
286 begin
287 if Node.Text = PathDelim then
288 Result := Node.Text + Result
289 else
290 Result := Node.Text + PathDelim + Result;
291 Node := Node.Parent;
292 end;
293 end;
294
295 procedure TFileBrowserForm.SetDir(const Value: string);
296 var
297 StartDir: string;
298 Node: TTreeNode;
299 i, p: integer;
300 SubDir: PChar;
301 begin
302 FDir := Value;
303 StartDir := Value;
304 if TV.Items.Count = 0 then
305 Exit;
306 p := AnsiPos(FRootDir, StartDir);
307 if p = 1 then
308 Delete(StartDir, P, Length(FRootDir));
309 for i := 1 to Length(StartDir) do
310 if (StartDir[i] = PathDelim) then
311 StartDir[i] := #0;
312 SubDir := PChar(StartDir);
313 if SubDir[0] = #0 then
314 SubDir := @SubDir[1];
315 Node := TV.Items.GetFirstNode;
316 while SubDir[0] <> #0 do
317 begin
318 Node := Node.GetFirstChild;
319 while (Node <> nil) and (AnsiCompareStr(Node.Text, SubDir) <> 0) do
320 Node := Node.GetNextSibling;
321 if Node = nil then
322 break
323 else
324 Node.Expand(False);
325 SubDir := SubDir + StrLen(SubDir) + 1;
326 end;
327 TV.Selected := Node;
328 TV.MakeSelectionVisible;
329 end;
330
331 procedure TFileBrowserForm.SetRootDir(const Value: string);
332 var
333 RootNode: TTreeNode;
334 lNode: TTreeNode;
335 begin
336 { Clear the list }
337 TV.Items.Clear;
338 FRootDir := Value;
339
340 {$IFDEF MSWINDOWS}
341 { Add Windows drive letters }
342 AddWindowsDriveLetters;
343 {$ENDIF}
344
345 { Remove the path delimiter unless this is root. }
346 if FRootDir = '' then
347 FRootDir := PathDelim;
348 if (FRootDir <> PathDelim) and (FRootDir[length(FRootDir)] = PathDelim) then
349 SetLength(FRootDir, length(FRootDir)-1);
350 { Find or Create the root node and add it to the Tree View. }
351 RootNode := TV.Items.FindTopLvlNode(FRootDir + PathDelim);
352 if RootNode = nil then
353 RootNode := TV.Items.Add(nil, FRootDir);
354
355 { Add the Subdirectories to Root nodes }
356 lNode := TV.Items.GetFirstNode;
357 while lNode <> nil do
358 begin
359 AddDirectories(lNode, lNode.Text);
360 lNode := lNode.GetNextSibling;
361 end;
362
363 { Set the original root node as the selected node. }
364 TV.Selected := RootNode;
365 end;
366
367 procedure TFileBrowserForm.InitializeTreeview;
368 begin
369 { I'm not sure what we should set these to. Maybe another Config option? }
370 {$IFDEF UNIX}
371 RootDirectory := '/';
372 {$ENDIF}
373 {$IFDEF MSWINDOWS}
374 RootDirectory := 'C:\';
375 {$ENDIF}
376 end;
377
378 {$IFDEF MSWINDOWS}
379 procedure TFileBrowserForm.AddWindowsDriveLetters;
380 const
381 MAX_DRIVES = 25;
382 var
383 n: integer;
384 drvs: string;
385 begin
386 // making drive list, skipping drives A: and B: and Removable Devices without media
387 n := 2;
388 while n <= MAX_DRIVES do
389 begin
390 drvs := chr(n + Ord('A')) + ':\';
391 if (Windows.GetDriveType(PChar(drvs)) <> 1) and
392 (GetDiskFreeSpaceEx(PChar(drvs), nil, nil, nil)) then
393 TV.Items.Add(nil, drvs);
394 Inc(n);
395 end;
396 end;
397 {$ENDIF}
398
SelectedDirnull399 function TFileBrowserForm.SelectedDir: string;
400 begin
401 Result := '';
402 if TV.Selected <> nil then
403 Result := GetAbsolutePath(TV.Selected);
404 end;
405
406 end.
407
408