unit ShortPathEdit; {$mode objfpc}{$H+} interface uses Classes, SysUtils, // LCL EditBtn, Dialogs, // LazUtils LazFileUtils; type { TShortPathEdit } TShortPathEdit = class(TDirectoryEdit) private FDirectory : String; FOnAcceptDir: TAcceptFileNameEvent; protected function CreateDialog: TCommonDialog; override; published procedure RunDialog; override; property Directory: String read FDirectory write FDirectory; property OnAcceptDirectory: TAcceptFileNameEvent read FOnAcceptDir write FonAcceptDir; end; implementation function TShortPathEdit.CreateDialog: TCommonDialog; begin Result:=TSelectDirectoryDialog.Create(Self); if DirPathExists(Directory) then begin TSelectDirectoryDialog(Result).InitialDir:=Directory; TSelectDirectoryDialog(Result).FileName:=''; end else begin TSelectDirectoryDialog(Result).InitialDir:=RootDir; TSelectDirectoryDialog(Result).FileName:=Directory; end; // Set some common things. Result.Title := DialogTitle; end; procedure TShortPathEdit.RunDialog; var D: String; Dlg: TCommonDialog; B: Boolean; begin Dlg:=CreateDialog; try B:=Dlg.Execute; if B then D:=GetDialogResult(Dlg); finally Dlg.Free; end; if B then begin if Assigned(FOnAcceptDir) then begin FOnAcceptdir(Self,D); if (D<>'') then Directory:=D; end else Directory:=D; end; end; end.