source: trunk/NewView/FileDialogForm.pas@ 417

Last change on this file since 417 was 105, checked in by RBRi, 19 years ago

%more stringutils refactoring
  • Property svn:eol-style set to native
File size: 19.3 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 FileUtilsUnit,
126 ACLDialogs,
127 ACLString,
128 AStringUtilityUnit,
129 ControlsUtility,
130 SettingsUnit,
131 HelpFile,
132 StringUtilsUnit,
133 DebugUnit;
134
135Imports
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
148end;
149
150Procedure TFileDialogForm.FileDialogFormOnSetupShow (Sender: TObject);
151Begin
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;
173End;
174
175Procedure TFileDialogForm.FilterComboBoxOnChange (Sender: TObject);
176Begin
177 FileMask := FilterComboBox.Mask;
178 FileNameEdit.Text := FileMask;
179 ReadFiles;
180End;
181
182Procedure TFileDialogForm.DirectoryListBoxOnChange (Sender: TObject);
183Begin
184 ReadFiles;
185End;
186
187Procedure TFileDialogForm.CancelButtonOnEnter (Sender: TObject);
188Begin
189 CompletionsListBox.Hide;
190End;
191
192Procedure TFileDialogForm.OKButtonOnEnter (Sender: TObject);
193Begin
194 CompletionsListBox.Hide;
195End;
196
197Procedure TFileDialogForm.FilterComboBoxOnEnter (Sender: TObject);
198Begin
199 CompletionsListBox.Hide;
200End;
201
202Procedure TFileDialogForm.FileListBoxOnEnter (Sender: TObject);
203Begin
204 CompletionsListBox.Hide;
205End;
206
207Procedure TFileDialogForm.DirectoryListBoxOnEnter (Sender: TObject);
208Begin
209 CompletionsListBox.Hide;
210End;
211
212Procedure TFileDialogForm.DriveComboBoxOnEnter (Sender: TObject);
213Begin
214 CompletionsListBox.Hide;
215End;
216
217Procedure TFileDialogForm.CompletionsListBoxOnExit (Sender: TObject);
218Begin
219End;
220
221Procedure TFileDialogForm.FilenameEditOnChange (Sender: TObject);
222Begin
223 if FocussingFile then
224 exit;
225 ShowCompletions;
226End;
227
228Procedure TFileDialogForm.FilenameEditOnExit (Sender: TObject);
229Begin
230End;
231
232Procedure TFileDialogForm.WMCheckFocus( Var Msg: TMessage );
233begin
234end;
235
236Procedure TFileDialogForm.FilenameEditOnScan (Sender: TObject;
237 Var KeyCode: TKeyCode);
238Begin
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;
256End;
257
258Procedure TFileDialogForm.CompletionsListBoxOnScan (Sender: TObject;
259 Var KeyCode: TKeyCode);
260Begin
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;
280End;
281
282Procedure TFileDialogForm.ShowCompletions;
283var
284 i: integer;
285 search: string;
286 filename: string;
287 ShowList: boolean;
288 tmpNameAndTitle: string;
289Begin
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
328End;
329
330Procedure TFileDialogForm.FileListBoxOnItemSelect (Sender: TObject;
331 Index: LongInt);
332Begin
333 OKButton.Click;
334End;
335
336Procedure TFileDialogForm.FileDialogFormOnDismissDlg (Sender: TObject);
337Begin
338 WriteWindowPos( self );
339 Settings.FileDialogSplit := Split;
340End;
341
342Procedure TFileDialogForm.FileDialogFormOnResize (Sender: TObject);
343Begin
344 LayoutControls;
345End;
346
347Procedure TFileDialogForm.SplitBarOnChange (NewSplit: LongInt);
348Begin
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;
357End;
358
359Procedure TFileDialogForm.LayoutControls;
360var
361 SplitX: longint;
362 LeftPaneWidth: longint;
363 RightPaneWidth: longint;
364 RightPaneX: longint;
365begin
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;
388end;
389
390Procedure TFileDialogForm.FileListBoxOnDblClick (Sender: TObject);
391Begin
392 OKButton.Click;
393End;
394
395Procedure TFileDialogForm.FileDialogFormOnShow (Sender: TObject);
396Begin
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;
418End;
419
420Procedure TFileDialogForm.FileDialogFormOnDestroy (Sender: TObject);
421Begin
422 FileNames.Destroy;
423End;
424
425Procedure TFileDialogForm.FileListBoxOnItemFocus (Sender: TObject;
426 Index: LongInt);
427var
428 FileIndex: longint;
429 NameAndTitle: string;
430 FilenamesString: TAString;
431Begin
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;
448End;
449
450Procedure TFileDialogForm.OKButtonOnClick (Sender: TObject);
451var
452 FileNameText: string;
453 FileName: string;
454 Directory: string;
455 NewDirectory: string;
456 FilePath: string;
457 FilenameString: TAString;
458 i: longint;
459Begin
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 );
557End;
558
559Procedure TFileDialogForm.OnLanguageEvent( Language: TLanguageFile;
560 const Apply: boolean );
561begin
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' );
575end;
576
577Procedure TFileDialogForm.FileDialogFormOnCreate (Sender: TObject);
578Begin
579 RegisterForLanguages( OnLanguageEvent );
580
581 FileMask := '*.*';
582End;
583
584Procedure TFileDialogForm.ReadFiles;
585var
586 Filenames: TStringList;
587 i: longint;
588
589 Filename: string;
590 Title: string;
591begin
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;
620end;
621
622// ----------------------------------------------------------------------
623
624Var
625 FileDialogForm: TFileDialogForm;
626
627procedure EnsureFileDialogFormLoaded;
628begin
629 if FileDialogForm = nil then
630 FileDialogForm := TFileDialogForm.Create( nil );
631end;
632
633function DoSaveFileDialog( const Caption: string;
634 const Filters: string;
635 const DefaultFilename: string;
636 Var Directory: string;
637 Var Filename: string ): boolean;
638begin
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
657end;
658
659function DoOpenFileDialog( const Caption: string;
660 const Filters: string;
661 const DefaultFilename: string;
662 Var Directory: string;
663 Var Filename: string ): boolean;
664begin
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;
682end;
683
684function DoOpenMultiFileDialog( const Caption: string;
685 const Filters: string;
686 const DefaultFilename: string;
687 Var Directory: string;
688 Var KeepCurrent: boolean;
689 Filenames: TStrings ): boolean;
690begin
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;
711end;
712
713Initialization
714 RegisterClasses ([TFileDialogForm, TEdit, TLabel,
715 TCustomDirectoryListBox, TCustomDriveComboBox,
716 TCustomFilterComboBox, TSplitBar, TButton,
717 TListBox, TMultiColumnListBox, TCheckBox]);
718
719 RegisterUpdateProcForLanguages( EnsureFileDialogFormLoaded );
720End.
Note: See TracBrowser for help on using the repository browser.