source: trunk/NewView/FileDialogForm.pas@ 82

Last change on this file since 82 was 82, checked in by RBRi, 18 years ago

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