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
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
|
{%mainunit fpg_dialogs.pas}
{$IFDEF read_interface}
{ TfpgSelectDirDialog }
TfpgSelectDirDialog = class(TfpgBaseDialog)
private
lblTitle: TfpgLabel;
tv: TfpgTreeView;
FDir: TfpgString;
FRootDir: TfpgString;
procedure lblTitleDblClicked(Sender: TObject; AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
function GetAbsolutePath(Node: TfpgTreeNode): TfpgString;
procedure InitializeTreeview;
procedure SetDir(const AValue: TfpgString);
procedure SetRootDir(const AValue: TfpgString);
procedure AddDirectories(Node: TfpgTreeNode; Dir: TfpgString);
public
procedure AfterCreate; override;
{ return the selected directory }
function SelectedDir: TfpgString;
{ The selected/opened directory }
property Directory: TfpgString read FDir write SetDir;
{ Directory the treeview starts from }
property RootDirectory: TfpgString read FRootDir write SetRootDir;
end;
{$ENDIF read_interface}
{$IFDEF read_implementation}
procedure TfpgSelectDirDialog.lblTitleDblClicked(Sender: TObject;
AButton: TMouseButton; AShift: TShiftState; const AMousePos: TPoint);
begin
InitializeTreeview;
end;
function TfpgSelectDirDialog.GetAbsolutePath(Node: TfpgTreeNode): TfpgString;
begin
Result := '';
while Node <> nil do
begin
if Node.Text = PathDelim then
Result := Node.Text + Result
else
Result := Node.Text + PathDelim + Result;
Node := Node.Parent;
end;
end;
procedure TfpgSelectDirDialog.InitializeTreeview;
begin
{ I'm not sure what we should set these to. Maybe another Config option? }
{$IFDEF UNIX}
RootDirectory := '/';
{$ENDIF}
{$IFDEF MSWINDOWS}
RootDirectory := 'C:\';
{$ENDIF}
end;
procedure TfpgSelectDirDialog.SetDir(const AValue: TfpgString);
begin
if FDir=AValue then exit;
FDir:=AValue;
end;
procedure TfpgSelectDirDialog.SetRootDir(const AValue: TfpgString);
var
RootNode: TfpgTreeNode;
lNode: TfpgTreeNode;
begin
{ Clear the list }
tv.RootNode.Clear;
FRootDir := AValue;
{$IFDEF MSWINDOWS}
{ Add Windows drive letters }
AddWindowsDriveLetters;
{$ENDIF}
{ Remove the path delimeter unless this is root. }
if FRootDir = '' then
FRootDir := PathDelim;
if (FRootDir <> PathDelim) and (FRootDir[length(FRootDir)] = PathDelim) then
FRootDir := copy(FRootDir, 1, length(FRootDir) - 1);
{ Find or Create the root node and add it to the Tree View. }
RootNode := tv.RootNode.FindSubNode(FRootDir + PathDelim, False);
// RootNode := TV.Items.FindTopLvlNode(FRootDir + PathDelim);
if RootNode = nil then
// RootNode := TV.Items.Add(nil, FRootDir);
RootNode := tv.RootNode.AppendText(FRootDir);
{ Add the Subdirectories to Root nodes }
// lNode := TV.Items.GetFirstNode;
lNode := RootNode;
writeln('Directories found:');
while lNode <> nil do
begin
write('.');
AddDirectories(lNode, lNode.Text);
lNode := lNode.Next;
// lNode := lNode.GetNextSibling;
end;
writeln(' ');
{ Set the original root node as the selected node. }
tv.Selection := RootNode;
// TV.Selected := RootNode;
end;
{ Adds Subdirectories to a passed node if they exist }
procedure TfpgSelectDirDialog.AddDirectories(Node: TfpgTreeNode; Dir: TfpgString);
var
FileInfo: TSearchRec;
NewNode: TfpgTreeNode;
i: integer;
FCurrentDir: TfpgString;
//used to sort the directories.
SortList: TStringList;
begin
if Dir <> '' then
begin
FCurrentDir := Dir;
FCurrentDir := fpgAppendPathDelim(FCurrentDir);
i := length(FCurrentDir);
FCurrentDir := FCurrentDir + AllFilesMask;
try
if fpgFindFirst(FCurrentDir, faAnyFile or $00000080, FileInfo) = 0 then
begin
try
SortList := TStringList.Create;
SortList.Sorted := True;
repeat
// check if special file
if (FileInfo.Name = '.') or (FileInfo.Name = '..') or (FileInfo.Name = '') then
Continue;
{ If hidden files or directories must be filtered, we test for
dot files, considered hidden under unix type OS's. }
//if not FShowHidden then
//if (FileInfo.Name[1] in ['.']) then
//Continue;
{ if this is a directory then add it to the tree. }
if ((faDirectory and FileInfo.Attr) > 0) then
begin
{ If this is a hidden file and we have not been requested to show
hidden files then do not add it to the list. }
//if ((faHidden and FileInfo.Attr) > 0) and not FShowHidden then
//continue;
SortList.Add(FileInfo.Name);
end;
until fpgFindNext(FileInfo) <> 0;
for i := 0 to SortList.Count - 1 do
begin
NewNode := Node.AppendText(SortList[i]);
// NewNode := TV.Items.AddChild(Node, SortList[i]);
// if subdirectories then indicate so.
{ Todo: Fix this by adding HasChildren to Treeview }
// NewNode.HasChildren := fpgHasSubDirs(fpgAppendPathDelim(Dir) + NewNode.Text, FShowHidden);
end;
finally
SortList.Free;
end;
end; { if FindFirst... }
finally
FindClose(FileInfo);
end;
end; { if Dir... }
//if Node.Level = 0 then
//Node.Text := Dir;
end;
procedure TfpgSelectDirDialog.AfterCreate;
begin
inherited AfterCreate;
Name := 'fpgSelectDirDialog';
SetPosition(20, 20, 300, 370);
WindowTitle := 'Select a Directory'; { TODO : Localize this!! }
WindowPosition := wpScreenCenter;
lblTitle := CreateLabel(self, FSpacing, FSpacing, rsEnterNewDirectory);
lblTitle.OnDoubleClick :=@lblTitleDblClicked;
tv := TfpgTreeView.Create(self);
with tv do
begin
Name := 'tv';
SetPosition(FSpacing, 28, 288, 300);
end;
// reposition buttons
btnCancel.Left := Width-FDefaultButtonWidth-FSpacing;
btnCancel.Top := Height - FSpacing - btnCancel.Height;
btnOK.Left := btnCancel.Left-FDefaultButtonWidth-FSpacing;
btnOK.Top := btnCancel.Top;
// now reset tab order
tv.TabOrder := 1;
btnOK.TabOrder := 2;
btnCancel.TabOrder := 3;
end;
function TfpgSelectDirDialog.SelectedDir: TfpgString;
begin
Result := '';
if tv.Selection <> nil then
Result := GetAbsolutePath(tv.Selection);
end;
{$ENDIF read_implementation}
|
