1 | Unit FileDialogForm;
|
---|
2 |
|
---|
3 | // NewView - a new OS/2 Help Viewer
|
---|
4 | // Copyright 2003 Aaron Lawrence (aaronl at consultant dot com)
|
---|
5 | // This software is released under the Gnu Public License - see readme.txt
|
---|
6 |
|
---|
7 | Interface
|
---|
8 |
|
---|
9 | // This form is a generic, sizeable file dialog. I never
|
---|
10 | // got round to making it a seperate thing. Better would be
|
---|
11 | // to enhance the one in SPCC.
|
---|
12 |
|
---|
13 | Uses
|
---|
14 | Classes,
|
---|
15 | Forms,
|
---|
16 | StdCtrls,
|
---|
17 | Buttons,
|
---|
18 | Messages,
|
---|
19 | CustomFileControls,
|
---|
20 | SplitBar,
|
---|
21 | MultiColumnListBox,
|
---|
22 | ACLLanguageUnit;
|
---|
23 |
|
---|
24 | // Note: filters have the form:
|
---|
25 | // <Description 1>|<filename mask 1>|<Description 2>|<filename mask 2>...
|
---|
26 |
|
---|
27 | function DoSaveFileDialog( const Caption: string;
|
---|
28 | const Filters: string;
|
---|
29 | const DefaultFilename: string;
|
---|
30 | var Directory: string;
|
---|
31 | var Filename: string ): boolean;
|
---|
32 |
|
---|
33 | function DoOpenFileDialog( const Caption: string;
|
---|
34 | const Filters: string;
|
---|
35 | const DefaultFilename: string;
|
---|
36 | var Directory: string;
|
---|
37 | var Filename: string ): boolean;
|
---|
38 |
|
---|
39 | function DoOpenMultiFileDialog( const Caption: string;
|
---|
40 | const Filters: string;
|
---|
41 | const DefaultFilename: string;
|
---|
42 | Var Directory: string;
|
---|
43 | Var KeepCurrent: boolean;
|
---|
44 | Filenames: TStrings ): boolean;
|
---|
45 |
|
---|
46 | Const
|
---|
47 | WM_CHECKFOCUS = WM_USER + 103;
|
---|
48 |
|
---|
49 | Type
|
---|
50 | TFileDialogForm = Class (TForm)
|
---|
51 | FilenameEdit: TEdit;
|
---|
52 | FileNameLabel: TLabel;
|
---|
53 | KeepCurrentCheckBox: TCheckBox;
|
---|
54 | CompletionsListBox: TListBox;
|
---|
55 | FilesLabel: TLabel;
|
---|
56 | FilterLabel: TLabel;
|
---|
57 | DrivesLabel: TLabel;
|
---|
58 | DirectoriesLabel: TLabel;
|
---|
59 | DirectoryListBox: TCustomDirectoryListBox;
|
---|
60 | DriveComboBox: TCustomDriveComboBox;
|
---|
61 | HelpButton: TButton;
|
---|
62 | FileListBox: TMultiColumnListBox;
|
---|
63 | FilterComboBox: TCustomFilterComboBox;
|
---|
64 | OKButton: TButton;
|
---|
65 | CancelButton: TButton;
|
---|
66 | SplitBar: TSplitBar;
|
---|
67 | Procedure FileDialogFormOnSetupShow (Sender: TObject);
|
---|
68 | Procedure FilterComboBoxOnChange (Sender: TObject);
|
---|
69 | Procedure DirectoryListBoxOnChange (Sender: TObject);
|
---|
70 | Procedure CancelButtonOnEnter (Sender: TObject);
|
---|
71 | Procedure OKButtonOnEnter (Sender: TObject);
|
---|
72 | Procedure FilterComboBoxOnEnter (Sender: TObject);
|
---|
73 | Procedure FileListBoxOnEnter (Sender: TObject);
|
---|
74 | Procedure DirectoryListBoxOnEnter (Sender: TObject);
|
---|
75 | Procedure DriveComboBoxOnEnter (Sender: TObject);
|
---|
76 | Procedure CompletionsListBoxOnExit (Sender: TObject);
|
---|
77 | Procedure FilenameEditOnChange (Sender: TObject);
|
---|
78 | Procedure FilenameEditOnExit (Sender: TObject);
|
---|
79 | Procedure FilenameEditOnScan (Sender: TObject; Var KeyCode: TKeyCode);
|
---|
80 | Procedure CompletionsListBoxOnScan (Sender: TObject;
|
---|
81 | Var KeyCode: TKeyCode);
|
---|
82 | Procedure FileListBoxOnItemSelect (Sender: TObject; Index: LongInt);
|
---|
83 | Procedure FileDialogFormOnDismissDlg (Sender: TObject);
|
---|
84 | Procedure FileDialogFormOnResize (Sender: TObject);
|
---|
85 | Procedure SplitBarOnChange (NewSplit: LongInt);
|
---|
86 | Procedure FileListBoxOnDblClick (Sender: TObject);
|
---|
87 | Procedure FileDialogFormOnShow (Sender: TObject);
|
---|
88 | Procedure FileDialogFormOnDestroy (Sender: TObject);
|
---|
89 | Procedure FileListBoxOnItemFocus (Sender: TObject; Index: LongInt);
|
---|
90 | Procedure OKButtonOnClick (Sender: TObject);
|
---|
91 | Procedure FileDialogFormOnCreate (Sender: TObject);
|
---|
92 | Protected
|
---|
93 |
|
---|
94 | Split: real;
|
---|
95 | Filenames: TStringList;
|
---|
96 | RequireFileExists: boolean;
|
---|
97 | DefaultFilename: string;
|
---|
98 | FocussingFile: boolean;
|
---|
99 | FileMask: string;
|
---|
100 | Procedure LayoutControls;
|
---|
101 | Procedure ShowCompletions;
|
---|
102 | Procedure ReadFiles;
|
---|
103 |
|
---|
104 | Protected
|
---|
105 | Procedure OnLanguageEvent( Language: TLanguageFile;
|
---|
106 | const Apply: boolean );
|
---|
107 | InvalidFilterErrorTitle: string;
|
---|
108 | InvalidFilterError: string;
|
---|
109 | FileNotFoundErrorTitle: string;
|
---|
110 | FileNotFoundError: string;
|
---|
111 | MultiSelectErrorTitle: string;
|
---|
112 | MultiSelectError: string;
|
---|
113 |
|
---|
114 | Public
|
---|
115 | Procedure WMCheckFocus( Var Msg: TMessage ); message WM_CHECKFOCUS;
|
---|
116 | End;
|
---|
117 |
|
---|
118 | Implementation
|
---|
119 |
|
---|
120 | uses
|
---|
121 | BseDos,
|
---|
122 | OS2Def,
|
---|
123 | PmWin,
|
---|
124 | SysUtils,
|
---|
125 | FileUtilsUnit,
|
---|
126 | ACLDialogs,
|
---|
127 | ACLString,
|
---|
128 | AStringUtilityUnit,
|
---|
129 | ControlsUtility,
|
---|
130 | SettingsUnit,
|
---|
131 | HelpFile,
|
---|
132 | StringUtilsUnit,
|
---|
133 | DebugUnit;
|
---|
134 |
|
---|
135 | Imports
|
---|
136 | // Redeclared since the Sibyl declaration passes text as a cstring :(
|
---|
137 | Function _WinSetWindowText( ahwnd: HWND;
|
---|
138 | pszText: pchar ): BOOL;
|
---|
139 | APIENTRY;
|
---|
140 | 'PMWIN' index 877;
|
---|
141 |
|
---|
142 | Function _WinQueryWindowText( ahwnd: HWND;
|
---|
143 | cchBufferMax: LONG;
|
---|
144 | pchBuffer: pchar ): LONG;
|
---|
145 | APIENTRY;
|
---|
146 | 'PMWIN' index 841;
|
---|
147 |
|
---|
148 | end;
|
---|
149 |
|
---|
150 | Procedure TFileDialogForm.FileDialogFormOnSetupShow (Sender: TObject);
|
---|
151 | Begin
|
---|
152 | ScaleForm( self, 11, 16 );
|
---|
153 |
|
---|
154 | FileNameEdit.YAlign := yaTop;
|
---|
155 | FileNameEdit.xStretch := xsFrame;
|
---|
156 | FileNameLabel.YAlign := yaTop;
|
---|
157 |
|
---|
158 | CompletionsListBox.YAlign := yaTop;
|
---|
159 | CompletionsListBox.xStretch := xsFrame;
|
---|
160 |
|
---|
161 | FilterComboBox.YAlign := yaTop;
|
---|
162 | FilterLabel.YAlign := yaTop;
|
---|
163 | DriveComboBox.YAlign := yaTop;
|
---|
164 | DrivesLabel.YAlign := yaTop;
|
---|
165 | DirectoryListBox.YStretch := ysFrame;
|
---|
166 | DirectoriesLabel.YAlign := yaTop;
|
---|
167 | FileListBox.yStretch := ysFrame;
|
---|
168 | FilesLabel.YAlign := yaTop;
|
---|
169 | FileNames := TStringList.Create;
|
---|
170 | SplitBar.YStretch := ysFrame;
|
---|
171 |
|
---|
172 | LayoutControls;
|
---|
173 | End;
|
---|
174 |
|
---|
175 | Procedure TFileDialogForm.FilterComboBoxOnChange (Sender: TObject);
|
---|
176 | Begin
|
---|
177 | FileMask := FilterComboBox.Mask;
|
---|
178 | FileNameEdit.Text := FileMask;
|
---|
179 | ReadFiles;
|
---|
180 | End;
|
---|
181 |
|
---|
182 | Procedure TFileDialogForm.DirectoryListBoxOnChange (Sender: TObject);
|
---|
183 | Begin
|
---|
184 | ReadFiles;
|
---|
185 | End;
|
---|
186 |
|
---|
187 | Procedure TFileDialogForm.CancelButtonOnEnter (Sender: TObject);
|
---|
188 | Begin
|
---|
189 | CompletionsListBox.Hide;
|
---|
190 | End;
|
---|
191 |
|
---|
192 | Procedure TFileDialogForm.OKButtonOnEnter (Sender: TObject);
|
---|
193 | Begin
|
---|
194 | CompletionsListBox.Hide;
|
---|
195 | End;
|
---|
196 |
|
---|
197 | Procedure TFileDialogForm.FilterComboBoxOnEnter (Sender: TObject);
|
---|
198 | Begin
|
---|
199 | CompletionsListBox.Hide;
|
---|
200 | End;
|
---|
201 |
|
---|
202 | Procedure TFileDialogForm.FileListBoxOnEnter (Sender: TObject);
|
---|
203 | Begin
|
---|
204 | CompletionsListBox.Hide;
|
---|
205 | End;
|
---|
206 |
|
---|
207 | Procedure TFileDialogForm.DirectoryListBoxOnEnter (Sender: TObject);
|
---|
208 | Begin
|
---|
209 | CompletionsListBox.Hide;
|
---|
210 | End;
|
---|
211 |
|
---|
212 | Procedure TFileDialogForm.DriveComboBoxOnEnter (Sender: TObject);
|
---|
213 | Begin
|
---|
214 | CompletionsListBox.Hide;
|
---|
215 | End;
|
---|
216 |
|
---|
217 | Procedure TFileDialogForm.CompletionsListBoxOnExit (Sender: TObject);
|
---|
218 | Begin
|
---|
219 | End;
|
---|
220 |
|
---|
221 | Procedure TFileDialogForm.FilenameEditOnChange (Sender: TObject);
|
---|
222 | Begin
|
---|
223 | if FocussingFile then
|
---|
224 | exit;
|
---|
225 | ShowCompletions;
|
---|
226 | End;
|
---|
227 |
|
---|
228 | Procedure TFileDialogForm.FilenameEditOnExit (Sender: TObject);
|
---|
229 | Begin
|
---|
230 | End;
|
---|
231 |
|
---|
232 | Procedure TFileDialogForm.WMCheckFocus( Var Msg: TMessage );
|
---|
233 | begin
|
---|
234 | end;
|
---|
235 |
|
---|
236 | Procedure TFileDialogForm.FilenameEditOnScan (Sender: TObject;
|
---|
237 | Var KeyCode: TKeyCode);
|
---|
238 | Begin
|
---|
239 | if KeyCode = kbCDown then
|
---|
240 | begin
|
---|
241 | if CompletionsListBox.Visible then
|
---|
242 | begin
|
---|
243 | CompletionsListBox.ItemIndex := 0;
|
---|
244 | CompletionsListBox.Focus;
|
---|
245 | KeyCode := kbNull;
|
---|
246 | end;
|
---|
247 | end
|
---|
248 | else if KeyCode = kbTab then
|
---|
249 | begin
|
---|
250 | DriveComboBox.Focus;
|
---|
251 | end
|
---|
252 | else
|
---|
253 | begin
|
---|
254 | ShowCompletions;
|
---|
255 | end;
|
---|
256 | End;
|
---|
257 |
|
---|
258 | Procedure TFileDialogForm.CompletionsListBoxOnScan (Sender: TObject;
|
---|
259 | Var KeyCode: TKeyCode);
|
---|
260 | Begin
|
---|
261 | if KeyCode = kbCR then
|
---|
262 | begin
|
---|
263 | if CompletionsListBox.ItemIndex <> -1 then
|
---|
264 | begin
|
---|
265 | FilenameEdit.Text := CompletionsListBox.Items[ CompletionsListBox.ItemIndex ];
|
---|
266 | FilenameEdit.Focus;
|
---|
267 | ShowCompletions;
|
---|
268 | KeyCode := kbNull; // eat the keystroke
|
---|
269 | end;
|
---|
270 | end
|
---|
271 | else if KeyCode = kbCUp then
|
---|
272 | begin
|
---|
273 | if CompletionsListBox.ItemIndex = 0 then
|
---|
274 | begin
|
---|
275 | CompletionsListBox.ItemIndex := -1;
|
---|
276 | FilenameEdit.Focus;
|
---|
277 | KeyCode := kbNull;
|
---|
278 | end;
|
---|
279 | end;
|
---|
280 | End;
|
---|
281 |
|
---|
282 | Procedure TFileDialogForm.ShowCompletions;
|
---|
283 | var
|
---|
284 | i: integer;
|
---|
285 | search: string;
|
---|
286 | filename: string;
|
---|
287 | ShowList: boolean;
|
---|
288 | tmpNameAndTitle: string;
|
---|
289 | Begin
|
---|
290 | CompletionsListBox.Items.Clear;
|
---|
291 | search := FilenameEdit.Text;
|
---|
292 |
|
---|
293 | if Search <> '' then
|
---|
294 | begin
|
---|
295 | for i := 0 to FileListBox.Items.Count - 1 do
|
---|
296 | begin
|
---|
297 | tmpNameAndTitle := FileListBox.Items[ i ];
|
---|
298 | Filename := StrLeftUntil(tmpNameAndTitle, [StrTAB]);
|
---|
299 |
|
---|
300 | if StrStartsWithIgnoringCase(filename, search) then
|
---|
301 | CompletionsListBox.Items.Add( filename );
|
---|
302 | end;
|
---|
303 | end;
|
---|
304 |
|
---|
305 | ShowList := false;
|
---|
306 | if CompletionsListBox.Items.Count = 1 then
|
---|
307 | begin
|
---|
308 | if not StrEqualIgnoringCase(CompletionsListBox.Items[0], search) then
|
---|
309 | ShowList := true;
|
---|
310 | end
|
---|
311 | else if CompletionsListBox.Items.Count > 0 then
|
---|
312 | begin
|
---|
313 | ShowList := true;
|
---|
314 | end;
|
---|
315 |
|
---|
316 | if ShowList then
|
---|
317 | begin
|
---|
318 | CompletionsListBox.BringToFront;
|
---|
319 | CompletionsListBox.Height := ( CompletionsListBox.Items.Count + 1 )
|
---|
320 | * CompletionsListBox.ItemHeight
|
---|
321 | + 6;
|
---|
322 | CompletionsListBox.Bottom := FilenameEdit.Bottom
|
---|
323 | - CompletionsListBox.Height;
|
---|
324 | end;
|
---|
325 |
|
---|
326 | CompletionsListBox.Visible := ShowList;
|
---|
327 |
|
---|
328 | End;
|
---|
329 |
|
---|
330 | Procedure TFileDialogForm.FileListBoxOnItemSelect (Sender: TObject;
|
---|
331 | Index: LongInt);
|
---|
332 | Begin
|
---|
333 | OKButton.Click;
|
---|
334 | End;
|
---|
335 |
|
---|
336 | Procedure TFileDialogForm.FileDialogFormOnDismissDlg (Sender: TObject);
|
---|
337 | Begin
|
---|
338 | WriteWindowPos( self );
|
---|
339 | Settings.FileDialogSplit := Split;
|
---|
340 | End;
|
---|
341 |
|
---|
342 | Procedure TFileDialogForm.FileDialogFormOnResize (Sender: TObject);
|
---|
343 | Begin
|
---|
344 | LayoutControls;
|
---|
345 | End;
|
---|
346 |
|
---|
347 | Procedure TFileDialogForm.SplitBarOnChange (NewSplit: LongInt);
|
---|
348 | Begin
|
---|
349 | Split := NewSplit / ClientWidth;
|
---|
350 |
|
---|
351 | if Split < 0.2 then
|
---|
352 | Split := 0.2;
|
---|
353 | if Split > 0.8 then
|
---|
354 | Split := 0.8;
|
---|
355 |
|
---|
356 | LayoutControls;
|
---|
357 | End;
|
---|
358 |
|
---|
359 | Procedure TFileDialogForm.LayoutControls;
|
---|
360 | var
|
---|
361 | SplitX: longint;
|
---|
362 | LeftPaneWidth: longint;
|
---|
363 | RightPaneWidth: longint;
|
---|
364 | RightPaneX: longint;
|
---|
365 | begin
|
---|
366 | SplitX := round( ClientWidth * Split );
|
---|
367 | LeftPaneWidth := SplitX - 8; // note we are not including borders here
|
---|
368 | RightPaneWidth := ClientWidth - SplitX - 8;
|
---|
369 | RightPaneX := SplitX + 3;
|
---|
370 |
|
---|
371 | DrivesLabel.Width := LeftPaneWidth;
|
---|
372 | DriveComboBox.Width := LeftPaneWidth;
|
---|
373 |
|
---|
374 | DirectoriesLabel.Width := LeftPaneWidth;
|
---|
375 | DirectoryListBox.Width := LeftPaneWidth;
|
---|
376 |
|
---|
377 | FilesLabel.Left := RightPaneX;
|
---|
378 | FilesLabel.Width := RightPaneWidth;
|
---|
379 | FileListBox.Left := RightPaneX;
|
---|
380 | FileListBox.Width := RightPaneWidth;
|
---|
381 |
|
---|
382 | FilterLabel.Left := RightPaneX;
|
---|
383 | FilterLabel.Width := RightPaneWidth;
|
---|
384 | FilterComboBox.Left := RightPaneX;
|
---|
385 | FilterComboBox.Width := RightPaneWidth;
|
---|
386 |
|
---|
387 | SplitBar.Left := SplitX - 3;
|
---|
388 | end;
|
---|
389 |
|
---|
390 | Procedure TFileDialogForm.FileListBoxOnDblClick (Sender: TObject);
|
---|
391 | Begin
|
---|
392 | OKButton.Click;
|
---|
393 | End;
|
---|
394 |
|
---|
395 | Procedure TFileDialogForm.FileDialogFormOnShow (Sender: TObject);
|
---|
396 | Begin
|
---|
397 | Split := Settings.FileDialogSplit;
|
---|
398 |
|
---|
399 | ReadWindowPos( self );
|
---|
400 |
|
---|
401 | OKButton.Default := true;
|
---|
402 |
|
---|
403 | // get some more space in the edit field
|
---|
404 | SendMsg( FilenameEdit.Handle,
|
---|
405 | EM_SETTEXTLIMIT,
|
---|
406 | 1024,
|
---|
407 | 0 );
|
---|
408 |
|
---|
409 | FilenameEdit.Text := DefaultFilename;
|
---|
410 | FilenameEdit.Focus;
|
---|
411 |
|
---|
412 | // re-read files
|
---|
413 | ReadFiles;
|
---|
414 |
|
---|
415 | ShowCompletions;
|
---|
416 |
|
---|
417 | KeepCurrentCheckBox.Checked := false;
|
---|
418 | End;
|
---|
419 |
|
---|
420 | Procedure TFileDialogForm.FileDialogFormOnDestroy (Sender: TObject);
|
---|
421 | Begin
|
---|
422 | FileNames.Destroy;
|
---|
423 | End;
|
---|
424 |
|
---|
425 | Procedure TFileDialogForm.FileListBoxOnItemFocus (Sender: TObject;
|
---|
426 | Index: LongInt);
|
---|
427 | var
|
---|
428 | FileIndex: longint;
|
---|
429 | NameAndTitle: string;
|
---|
430 | FilenamesString: TAString;
|
---|
431 | Begin
|
---|
432 | FileNames.Clear;
|
---|
433 | for FileIndex := 0 to FileListBox.Items.Count - 1 do
|
---|
434 | begin
|
---|
435 | if FileListBox.Selected[ FileIndex ] then
|
---|
436 | begin
|
---|
437 | NameAndTitle := FileListBox.Items[ FileIndex ];
|
---|
438 | FileNames.Add(StrLeftUntil(NameAndTitle, [StrTAB]));
|
---|
439 | end;
|
---|
440 | end;
|
---|
441 | FocussingFile := true;
|
---|
442 | FilenamesString := TAString.Create;
|
---|
443 | ListToAString( Filenames, FilenamesString, '+' );
|
---|
444 | _WinSetWindowText( FileNameEdit.Handle,
|
---|
445 | FilenamesString.AsPChar );
|
---|
446 | FilenamesString.Destroy;
|
---|
447 | FocussingFile := false;
|
---|
448 | End;
|
---|
449 |
|
---|
450 | Procedure TFileDialogForm.OKButtonOnClick (Sender: TObject);
|
---|
451 | var
|
---|
452 | FileNameText: string;
|
---|
453 | FileName: string;
|
---|
454 | Directory: string;
|
---|
455 | NewDirectory: string;
|
---|
456 | FilePath: string;
|
---|
457 | FilenameString: TAString;
|
---|
458 | i: longint;
|
---|
459 | Begin
|
---|
460 | FileNameText := trim( FileNameEdit.Text );
|
---|
461 | if FileNameText = '' then
|
---|
462 | exit;
|
---|
463 |
|
---|
464 | if ( Pos( '*', FileNameText ) > 0 )
|
---|
465 | or ( Pos( '?', FileNameText ) > 0 ) then
|
---|
466 | begin
|
---|
467 | if ( Pos( '\', FileNameText ) > 0 )
|
---|
468 | or ( Pos( ':', FileNameText ) > 0 )
|
---|
469 | or ( Pos( '/', FileNameText ) > 0 )
|
---|
470 | then
|
---|
471 | begin
|
---|
472 | DoErrorDlg( InvalidFilterErrorTitle,
|
---|
473 | StrInDoubleQuotes(FileNameText)
|
---|
474 | + InvalidFilterError
|
---|
475 | + StrCRLF
|
---|
476 | + ' \ / :' );
|
---|
477 | exit;
|
---|
478 | end;
|
---|
479 |
|
---|
480 | // Treat as a filter
|
---|
481 | FileMask := FileNameText;
|
---|
482 | ReadFiles;
|
---|
483 |
|
---|
484 | exit;
|
---|
485 | end;
|
---|
486 |
|
---|
487 | // First, see if it's a directory to change to
|
---|
488 | // (in order to support typing directories, either full or relative)
|
---|
489 | Directory := DirectoryListBox.Directory;
|
---|
490 | NewDirectory := ExpandPath( Directory, FileNameText );
|
---|
491 |
|
---|
492 | DosErrorAPI( FERR_DISABLEHARDERR );
|
---|
493 |
|
---|
494 | if DirectoryExists( NewDirectory ) then
|
---|
495 | begin
|
---|
496 | // Yes, the typed text is a directory, so change to it.
|
---|
497 | DirectoryListBox.Directory:= NewDirectory;
|
---|
498 | FileNameEdit.Text := '';
|
---|
499 | DosErrorAPI( FERR_ENABLEHARDERR );
|
---|
500 |
|
---|
501 | exit;
|
---|
502 | end;
|
---|
503 |
|
---|
504 | // No, the text entered is a filename or set of filenames
|
---|
505 | // Break it up into individual filenames at '+' char
|
---|
506 | // Check each file exists
|
---|
507 |
|
---|
508 | FilenameString := TAString.Create;
|
---|
509 | FilenameString.Length := WinQueryWindowTextLength( FileNameEdit.Handle );
|
---|
510 | _WinQueryWindowText( FileNameEdit.Handle,
|
---|
511 | FilenameString.Length + 1, // allow zero term
|
---|
512 | FilenameString.AsPChar );
|
---|
513 |
|
---|
514 | FileNames.Clear;
|
---|
515 |
|
---|
516 | AStringToList( FilenameString, Filenames, '+' );
|
---|
517 |
|
---|
518 | for i := 0 to Filenames.Count - 1 do
|
---|
519 | begin
|
---|
520 | FileName := Filenames[ i ];
|
---|
521 |
|
---|
522 | // Work out directory
|
---|
523 | FilePath := ExtractFilePath( FileName );
|
---|
524 | FilePath := ExpandPath( Directory, FilePath );
|
---|
525 |
|
---|
526 | FileName := AddDirectorySeparator( FilePath )
|
---|
527 | + ExtractFileName( FileName );
|
---|
528 | if RequireFileExists then
|
---|
529 | begin
|
---|
530 | if not FileExists( FileName ) then
|
---|
531 | begin
|
---|
532 | DoErrorDlg( FileNotFoundErrorTitle,
|
---|
533 | FileNotFoundError + Filename );
|
---|
534 | DosErrorAPI( FERR_ENABLEHARDERR );
|
---|
535 | FilenameString.Destroy;
|
---|
536 | exit;
|
---|
537 | end;
|
---|
538 | end;
|
---|
539 | FileNames[ i ] := FileName;
|
---|
540 | end;
|
---|
541 |
|
---|
542 | FilenameString.Destroy;
|
---|
543 |
|
---|
544 | DosErrorAPI( FERR_ENABLEHARDERR );
|
---|
545 |
|
---|
546 | if not FilelistBox.MultiSelect then
|
---|
547 | begin
|
---|
548 | if FileNames.Count > 1 then
|
---|
549 | begin
|
---|
550 | DoErrorDlg( MultiSelectErrorTitle,
|
---|
551 | MultiSelectError );
|
---|
552 | exit;
|
---|
553 | end;
|
---|
554 | end;
|
---|
555 | // Done
|
---|
556 | DismissDlg( mrOK );
|
---|
557 | End;
|
---|
558 |
|
---|
559 | Procedure TFileDialogForm.OnLanguageEvent( Language: TLanguageFile;
|
---|
560 | const Apply: boolean );
|
---|
561 | begin
|
---|
562 | LogEvent(LogI18n, 'TFileDialogForm.OnLanguageEvent apply: "' + BoolToStr(Apply) + '"');
|
---|
563 | Language.LoadComponentLanguage( self, Apply );
|
---|
564 |
|
---|
565 | Language.LL( Apply, InvalidFilterErrorTitle, 'InvalidFilterErrorTitle', 'File Filter Error' );
|
---|
566 | Language.LL( Apply,
|
---|
567 | InvalidFilterError,
|
---|
568 | 'InvalidFilterError',
|
---|
569 | ' is not a valid filename filter. '
|
---|
570 | + 'You cannot use any of these characters: ' );
|
---|
571 | Language.LL( Apply, FileNotFoundErrorTitle, 'FileNotFoundErrorTitle', 'File Not Found' );
|
---|
572 | Language.LL( Apply, FileNotFoundError, 'FileNotFoundError', 'File does not exist:' );
|
---|
573 | Language.LL( Apply, MultiSelectErrorTitle, 'MultiSelectErrorTitle', 'Multi-Select' );
|
---|
574 | Language.LL( Apply, MultiSelectError, 'MultiSelectError', 'You can only select one file' );
|
---|
575 | end;
|
---|
576 |
|
---|
577 | Procedure TFileDialogForm.FileDialogFormOnCreate (Sender: TObject);
|
---|
578 | Begin
|
---|
579 | RegisterForLanguages( OnLanguageEvent );
|
---|
580 |
|
---|
581 | FileMask := '*.*';
|
---|
582 | End;
|
---|
583 |
|
---|
584 | Procedure TFileDialogForm.ReadFiles;
|
---|
585 | var
|
---|
586 | Filenames: TStringList;
|
---|
587 | i: longint;
|
---|
588 |
|
---|
589 | Filename: string;
|
---|
590 | Title: string;
|
---|
591 | begin
|
---|
592 | Filenames := TStringList.Create;
|
---|
593 |
|
---|
594 | DosErrorAPI( FERR_DISABLEHARDERR );
|
---|
595 |
|
---|
596 | ListFilesInDirectory( DirectoryListBox.Directory,
|
---|
597 | FileMask,
|
---|
598 | false,
|
---|
599 | Filenames);
|
---|
600 |
|
---|
601 | Filenames.Sort;
|
---|
602 |
|
---|
603 | FileListBox.Items.BeginUpdate;
|
---|
604 | FileListBox.Items.Clear;
|
---|
605 |
|
---|
606 | for i := 0 to Filenames.Count - 1 do
|
---|
607 | begin
|
---|
608 | Filename := Filenames[ i ];
|
---|
609 |
|
---|
610 | Title := GetHelpFileTitle( AddDirectorySeparator( DirectoryListBox.Directory )
|
---|
611 | + Filename );
|
---|
612 |
|
---|
613 | FileListBox.Items.Add(Filename + StrTAB + Title );
|
---|
614 | end;
|
---|
615 | FileListBox.Items.EndUpdate;
|
---|
616 |
|
---|
617 | DosErrorAPI( FERR_ENABLEHARDERR );
|
---|
618 |
|
---|
619 | Filenames.Destroy;
|
---|
620 | end;
|
---|
621 |
|
---|
622 | // ----------------------------------------------------------------------
|
---|
623 |
|
---|
624 | Var
|
---|
625 | FileDialogForm: TFileDialogForm;
|
---|
626 |
|
---|
627 | procedure EnsureFileDialogFormLoaded;
|
---|
628 | begin
|
---|
629 | if FileDialogForm = nil then
|
---|
630 | FileDialogForm := TFileDialogForm.Create( nil );
|
---|
631 | end;
|
---|
632 |
|
---|
633 | function DoSaveFileDialog( const Caption: string;
|
---|
634 | const Filters: string;
|
---|
635 | const DefaultFilename: string;
|
---|
636 | Var Directory: string;
|
---|
637 | Var Filename: string ): boolean;
|
---|
638 | begin
|
---|
639 | EnsureFileDialogFormLoaded;
|
---|
640 |
|
---|
641 | FileDialogForm.Caption := Caption;
|
---|
642 | FileDialogForm.FilelistBox.MultiSelect := false;
|
---|
643 | FileDialogForm.RequireFileExists := false;
|
---|
644 | FileDialogForm.FilterComboBox.Filter := Filters;
|
---|
645 | FileDialogForm.DirectoryListBox.Directory := Directory;
|
---|
646 | FileDialogForm.DefaultFilename := DefaultFilename;
|
---|
647 | FileDialogForm.KeepCurrentCheckBox.Visible := false;
|
---|
648 |
|
---|
649 | Result := FileDialogForm.ShowModal = mrOK;
|
---|
650 |
|
---|
651 | if Result then
|
---|
652 | begin
|
---|
653 | Directory := FileDialogForm.DirectoryListBox.Directory;
|
---|
654 | Filename := FileDialogForm.Filenames[ 0 ];
|
---|
655 | end;
|
---|
656 |
|
---|
657 | end;
|
---|
658 |
|
---|
659 | function DoOpenFileDialog( const Caption: string;
|
---|
660 | const Filters: string;
|
---|
661 | const DefaultFilename: string;
|
---|
662 | Var Directory: string;
|
---|
663 | Var Filename: string ): boolean;
|
---|
664 | begin
|
---|
665 | EnsureFileDialogFormLoaded;
|
---|
666 |
|
---|
667 | FileDialogForm.Caption := Caption;
|
---|
668 | FileDialogForm.FilelistBox.MultiSelect := false;
|
---|
669 | FileDialogForm.RequireFileExists := true;
|
---|
670 | FileDialogForm.FilterComboBox.Filter := Filters;
|
---|
671 | FileDialogForm.DirectoryListBox.Directory := Directory;
|
---|
672 | FileDialogForm.DefaultFilename := DefaultFilename;
|
---|
673 | FileDialogForm.KeepCurrentCheckBox.Visible := false;
|
---|
674 |
|
---|
675 | Result := FileDialogForm.ShowModal = mrOK;
|
---|
676 |
|
---|
677 | if Result then
|
---|
678 | begin
|
---|
679 | Directory := FileDialogForm.DirectoryListBox.Directory;
|
---|
680 | Filename := FileDialogForm.Filenames[ 0 ];
|
---|
681 | end;
|
---|
682 | end;
|
---|
683 |
|
---|
684 | function DoOpenMultiFileDialog( const Caption: string;
|
---|
685 | const Filters: string;
|
---|
686 | const DefaultFilename: string;
|
---|
687 | Var Directory: string;
|
---|
688 | Var KeepCurrent: boolean;
|
---|
689 | Filenames: TStrings ): boolean;
|
---|
690 | begin
|
---|
691 | EnsureFileDialogFormLoaded;
|
---|
692 |
|
---|
693 | FileDialogForm.Caption := Caption;
|
---|
694 | FileDialogForm.FilelistBox.MultiSelect := true;
|
---|
695 | FileDialogForm.RequireFileExists := true;
|
---|
696 | FileDialogForm.FilterComboBox.Filter := Filters;
|
---|
697 | FileDialogForm.DirectoryListBox.Directory := Directory;
|
---|
698 | FileDialogForm.DefaultFilename := DefaultFilename;
|
---|
699 |
|
---|
700 | FileDialogForm.KeepCurrentCheckBox.Checked := KeepCurrent;
|
---|
701 | FileDialogForm.KeepCurrentCheckBox.Visible := true;
|
---|
702 |
|
---|
703 | Result := FileDialogForm.ShowModal = mrOK;
|
---|
704 |
|
---|
705 | if Result then
|
---|
706 | begin
|
---|
707 | Directory := FileDialogForm.DirectoryListBox.Directory;
|
---|
708 | Filenames.Assign( FileDialogForm.Filenames );
|
---|
709 | KeepCurrent := FileDialogForm.KeepCurrentCheckBox.Checked;
|
---|
710 | end;
|
---|
711 | end;
|
---|
712 |
|
---|
713 | Initialization
|
---|
714 | RegisterClasses ([TFileDialogForm, TEdit, TLabel,
|
---|
715 | TCustomDirectoryListBox, TCustomDriveComboBox,
|
---|
716 | TCustomFilterComboBox, TSplitBar, TButton,
|
---|
717 | TListBox, TMultiColumnListBox, TCheckBox]);
|
---|
718 |
|
---|
719 | RegisterUpdateProcForLanguages( EnsureFileDialogFormLoaded );
|
---|
720 | End.
|
---|