1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
|
unit ShortPathEdit;
{$mode objfpc}{$H+}
{$R lazcontrols.res}
interface
uses
Classes, SysUtils, EditBtn, LResources, Dialogs, LazFileUtils;
type
{ TShortPathEdit }
TShortPathEdit = class(TDirectoryEdit)
private
FDirectory : String;
FOnAcceptDir: TAcceptFileNameEvent;
protected
function CreateDialog: TCommonDialog; override;
procedure RunDialog; override;
published
property Directory: String read FDirectory write FDirectory;
property OnAcceptDirectory: TAcceptFileNameEvent read FOnAcceptDir write FonAcceptDir;
end;
procedure Register;
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;
procedure Register;
begin
RegisterComponents('LazControls',[TShortPathEdit]);
end;
end.
|
