source: trunk/NewView/FileDialogForm.pas@ 18

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

+ newview source

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