summaryrefslogtreecommitdiff
path: root/src/gui/selectdirdialog.inc
blob: b9da189b121733453458645e95974fd582103a4c (plain)
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
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
{%mainunit fpg_dialogs.pas}

{$IFDEF read_interface}


  { TfpgSelectDirDialog }

  TfpgSelectDirDialog = class(TfpgBaseDialog)
  private
    tv: TfpgTreeView;
    FRootDir: TfpgString;
    FShowHidden: Boolean;
    function    GetAbsolutePath(Node: TfpgTreeNode): TfpgString;
    procedure   InitializeTreeview;
    procedure   SetRootDir(const AValue: TfpgString);
    procedure   AddDirectories(Node: TfpgTreeNode; Dir: TfpgString);
    procedure   NodeExpanded(Sender: TObject; ANode: TfpgTreeNode);
    function    GetSelectedDir: TfpgString;
    procedure   SetSelectedDir(const AValue: TfpgString);
    {$IFDEF MSWINDOWS}
    procedure   AddWindowsDriveLetters;
    {$ENDIF}
  public
    constructor Create(AOwner: TComponent); override;
    procedure   AfterCreate; override;
    { return the selected directory or set initial selected dir }
    property    SelectedDir: TfpgString read GetSelectedDir write SetSelectedDir;
    { Directory the treeview starts from }
    property    RootDirectory: TfpgString read FRootDir write SetRootDir;
  end;


{$ENDIF read_interface}



{$IFDEF read_implementation}

function TfpgSelectDirDialog.GetAbsolutePath(Node: TfpgTreeNode): TfpgString;
var
  lResult: TfpgString;
begin
  lResult := '';
  while Node <> nil do
  begin
  {$IFDEF UNIX}
    if (Node.Text = PathDelim) then
      lResult := Node.Text + lResult
    else if (Node.Text <> '') then
      lResult := Node.Text + PathDelim + lResult;
  {$ENDIF}
  {$IFDEF MSWINDOWS}
    if (Node.Text <> '') then
    begin
      if (Node.Text[Length(Node.Text)] = PathDelim) then
        lResult := Node.Text + lResult
      else
        lResult := Node.Text + PathDelim + lResult;
    end;
  {$ENDIF}
    Node := Node.Parent;
  end;
  Result := lResult;
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}
  tv.RootNode.Expand;
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;
  while lNode <> nil do
  begin
    AddDirectories(lNode, lNode.Text);
    lNode := lNode.Next;
//    lNode := lNode.GetNextSibling;
  end;

  { Set the original root node as the selected node. }
  tv.Selection := 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
      SysUtils.FindClose(FileInfo);
    end;
  end;  { if Dir... }
  //if Node.Level = 0 then
    //Node.Text := Dir;
end;

procedure TfpgSelectDirDialog.NodeExpanded(Sender: TObject; ANode: TfpgTreeNode);
begin
  if ANode.Count = 0 then
    AddDirectories(ANode, GetAbsolutePath(ANode));
end;

function TfpgSelectDirDialog.GetSelectedDir: TfpgString;
begin
  Result := '';
  if tv.Selection <> nil then
    Result := GetAbsolutePath(tv.Selection);
end;

procedure TfpgSelectDirDialog.SetSelectedDir(const AValue: TfpgString);
var
  s: TfpgString;
  dir: TfpgString;
  i: integer;
  p: integer;
  prevn, nextn: TfpgTreeNode;
begin
  if AValue = '' then
    Exit;
  s := fpgAppendPathDelim(AValue);
  prevn := tv.RootNode;
  nextn := prevn;
  while nextn <> nil do
  begin
    if s = '' then
      break;
    i := UTF8Pos(PathDelim, s);
    if i = 1 then
      dir := PathDelim
    else
      dir := UTF8Copy(s, 1, i-1);
    UTF8Delete(s, 1, i);    // delete leading dir + PathDelim
    if (prevn = tv.RootNode) and (pos(':', dir) > 0) then
      dir += PathDelim;     // Windows drive letter. eg: C:\  or  D:\  etc.
    nextn := prevn.FindSubNode(dir, True);
    if Assigned(nextn) then
    begin
      prevn := nextn;
      prevn.Expand;
      NodeExpanded(self, prevn);
    end;
  end;
  tv.Selection := prevn;
end;

{$IFDEF MSWINDOWS}
procedure TfpgSelectDirDialog.AddWindowsDriveLetters;
const
  MAX_DRIVES = 25;
var
  n: integer;
  drvs: string;
begin
  // making drive list, skipping drives A: and B:
  n := 2;
  while n <= MAX_DRIVES do
  begin
    drvs := chr(n + Ord('A')) + ':\';
    if Windows.GetDriveType(PChar(drvs)) <> 1 then
      TV.RootNode.AppendText(drvs);
    Inc(n);
  end;
end;
{$ENDIF}

constructor TfpgSelectDirDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FShowHidden := False;
end;

procedure TfpgSelectDirDialog.AfterCreate;
begin
  inherited AfterCreate;
  Name := 'fpgSelectDirDialog';
  SetPosition(20, 20, 300, 370);
  WindowTitle := rsSelectaDirectory;
  WindowPosition := wpOneThirdDown;

  tv := TfpgTreeView.Create(self);
  with tv do
  begin
    Name := 'tv';
    SetPosition(FSpacing, FSpacing, 288, 322);
    OnExpand :=@NodeExpanded;
  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;

  InitializeTreeview;
end;


{$ENDIF read_implementation}