| 1 | Unit DirectoryEdit;
|
|---|
| 2 | // An edit box that will act as a directory
|
|---|
| 3 | // changer, with tab completion and enter
|
|---|
| 4 | // selecting a dir.
|
|---|
| 5 | Interface
|
|---|
| 6 |
|
|---|
| 7 | Uses
|
|---|
| 8 | Classes, Forms, StdCtrls, SysUtils;
|
|---|
| 9 |
|
|---|
| 10 | Type
|
|---|
| 11 | TNotifyDirChange = procedure( NewDir: string ) of object;
|
|---|
| 12 |
|
|---|
| 13 | TDirectoryEdit=Class(TEdit)
|
|---|
| 14 | Protected
|
|---|
| 15 | FDirectory: string;
|
|---|
| 16 | FCompletionBasePath: string;
|
|---|
| 17 | FCompletionIndex: longint;
|
|---|
| 18 | FCompletionStart: string;
|
|---|
| 19 | FOnChangeDir: TNotifyDirChange;
|
|---|
| 20 | FCompletions: TStringList;
|
|---|
| 21 | Procedure SetupComponent; Override;
|
|---|
| 22 | Procedure ScanEvent( Var KeyCode: TKeyCode;
|
|---|
| 23 | RepeatCount: Byte ); override;
|
|---|
| 24 | Procedure CharEvent( Var Key: Char;
|
|---|
| 25 | RepeatCount: Byte ); override;
|
|---|
| 26 | procedure ReadCompletions;
|
|---|
| 27 | Public
|
|---|
| 28 | Destructor Destroy; Override;
|
|---|
| 29 | Published
|
|---|
| 30 | property OnChangeDirectory: TNotifyDirChange read FOnChangeDir write FOnChangeDir;
|
|---|
| 31 | procedure SetDirectory( const Directory: string );
|
|---|
| 32 | End;
|
|---|
| 33 |
|
|---|
| 34 | Exports
|
|---|
| 35 | TDirectoryEdit,'User','diredit.bmp';
|
|---|
| 36 |
|
|---|
| 37 | Implementation
|
|---|
| 38 |
|
|---|
| 39 | Uses
|
|---|
| 40 | PMWIN, BseDos, ACLFileUtility, ACLFindFunctions;
|
|---|
| 41 |
|
|---|
| 42 | Procedure TDirectoryEdit.SetupComponent;
|
|---|
| 43 | Begin
|
|---|
| 44 | Inherited SetupComponent;
|
|---|
| 45 | Name:= 'DirectoryEdit';
|
|---|
| 46 | FCompletionIndex:= 0;
|
|---|
| 47 | FCompletions:= TStringList.Create;
|
|---|
| 48 | End;
|
|---|
| 49 |
|
|---|
| 50 | Destructor TDirectoryEdit.Destroy;
|
|---|
| 51 | Begin
|
|---|
| 52 | Inherited Destroy;
|
|---|
| 53 | End;
|
|---|
| 54 |
|
|---|
| 55 | procedure TDirectoryEdit.SetDirectory( const Directory: string );
|
|---|
| 56 | begin
|
|---|
| 57 | FDirectory := Directory;
|
|---|
| 58 | Text := Directory;
|
|---|
| 59 |
|
|---|
| 60 | // move cursor to end
|
|---|
| 61 | SelStart := Length( Directory );
|
|---|
| 62 | end;
|
|---|
| 63 |
|
|---|
| 64 | procedure TDirectoryEdit.ReadCompletions;
|
|---|
| 65 | Var
|
|---|
| 66 | SearchResults: TSearchData;
|
|---|
| 67 | rc:integer;
|
|---|
| 68 | Drive: string;
|
|---|
| 69 | Begin
|
|---|
| 70 | FCompletions.Clear;
|
|---|
| 71 | Drive := ExtractFileDrive( FCompletionBasePath );
|
|---|
| 72 | if Length( Drive ) < 2 then
|
|---|
| 73 | // must have a drive spec
|
|---|
| 74 | exit;
|
|---|
| 75 |
|
|---|
| 76 | rc:= MyFindFirst( FCompletionBasePath
|
|---|
| 77 | + FCompletionStart
|
|---|
| 78 | + '*',
|
|---|
| 79 | SearchResults );
|
|---|
| 80 | while rc = 0 do
|
|---|
| 81 | begin
|
|---|
| 82 | if ( SearchResults.Attr and faDirectory ) > 0 then
|
|---|
| 83 | if ( SearchResults.Name <> '.' )
|
|---|
| 84 | and ( SearchResults.Name <> '..' ) then
|
|---|
| 85 | FCompletions.Add( SearchResults.Name );
|
|---|
| 86 | rc:= MyFindNext( SearchResults );
|
|---|
| 87 | end;
|
|---|
| 88 | MyFindClose( SearchResults );
|
|---|
| 89 | FCompletions.Sort;
|
|---|
| 90 | End;
|
|---|
| 91 |
|
|---|
| 92 | Procedure TDirectoryEdit.ScanEvent( Var KeyCode: TKeyCode;
|
|---|
| 93 | RepeatCount: Byte );
|
|---|
| 94 | Var
|
|---|
| 95 | Entry: string;
|
|---|
| 96 | rc: longint;
|
|---|
| 97 | Dir: string;
|
|---|
| 98 | NewDirectory: string;
|
|---|
| 99 | Begin
|
|---|
| 100 | if KeyCode = kbTab then
|
|---|
| 101 | begin
|
|---|
| 102 | KeyCode:= kbNull;
|
|---|
| 103 | // want to use tab for completion
|
|---|
| 104 | if FCompletions.Count = 0 then
|
|---|
| 105 | begin
|
|---|
| 106 | // First time, read possible completions
|
|---|
| 107 | FCompletionStart := ExtractFileName( Text );
|
|---|
| 108 | FCompletionBasePath:= ExpandPath( FDirectory,
|
|---|
| 109 | ExtractFilePath( Text ) );
|
|---|
| 110 | ReadCompletions;
|
|---|
| 111 | end;
|
|---|
| 112 |
|
|---|
| 113 | if FCompletionIndex < FCompletions.Count then
|
|---|
| 114 | begin
|
|---|
| 115 | // Display next completion
|
|---|
| 116 | Text:= FCompletionBasePath + FCompletions[ FCompletionIndex ];
|
|---|
| 117 | // Place cursor at end
|
|---|
| 118 | SelStart := Length( Text );
|
|---|
| 119 | inc( FCompletionIndex );
|
|---|
| 120 | end
|
|---|
| 121 | else
|
|---|
| 122 | begin
|
|---|
| 123 | // nothing more
|
|---|
| 124 | Beep( 1000, 50 );
|
|---|
| 125 | end;
|
|---|
| 126 | exit;
|
|---|
| 127 | end;
|
|---|
| 128 |
|
|---|
| 129 | // not a tab
|
|---|
| 130 | FCompletionIndex:= 0;
|
|---|
| 131 | FCompletions.Clear;
|
|---|
| 132 |
|
|---|
| 133 | if KeyCode = kb_VK + VK_NEWLINE then
|
|---|
| 134 | begin
|
|---|
| 135 | KeyCode:= kbNull;
|
|---|
| 136 | // enter key pressed - change dir
|
|---|
| 137 | NewDirectory := ExpandPath( FDirectory,
|
|---|
| 138 | Text );
|
|---|
| 139 | if DirectoryExists( NewDirectory ) then
|
|---|
| 140 | begin
|
|---|
| 141 | SetDirectory( NewDirectory );
|
|---|
| 142 | if Assigned( FOnChangeDir ) then
|
|---|
| 143 | FOnChangeDir( NewDirectory )
|
|---|
| 144 | end
|
|---|
| 145 | else
|
|---|
| 146 | begin
|
|---|
| 147 | Beep( 1000, 50 );
|
|---|
| 148 | end;
|
|---|
| 149 | exit;
|
|---|
| 150 | end;
|
|---|
| 151 |
|
|---|
| 152 | if KeyCode = kbCtrlTab then
|
|---|
| 153 | begin
|
|---|
| 154 | // fake a normal focus shift
|
|---|
| 155 | KeyCode:= kbTab;
|
|---|
| 156 | Parent.ScanEvent( KeyCode, 1 );
|
|---|
| 157 | KeyCode:= kbNull;
|
|---|
| 158 | end;
|
|---|
| 159 |
|
|---|
| 160 | End;
|
|---|
| 161 |
|
|---|
| 162 | Procedure TDirectoryEdit.CharEvent( Var Key: Char;
|
|---|
| 163 | RepeatCount: Byte );
|
|---|
| 164 | Begin
|
|---|
| 165 | FCompletions.Clear;
|
|---|
| 166 | FCompletionIndex:= 0;
|
|---|
| 167 | End;
|
|---|
| 168 |
|
|---|
| 169 | Initialization
|
|---|
| 170 | {Register classes}
|
|---|
| 171 | RegisterClasses([TDirectoryEdit]);
|
|---|
| 172 | End.
|
|---|
| 173 |
|
|---|