FileTree/ufFileTree.pas at main · Zaaphod/FileTree · GitHub

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
unit ufFileTree;

{$mode objfpc}{$H+}

interface

uses
 Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, ComCtrls,
 StdCtrls, IniFiles;

type

 { TfFileTree }

 TfFileTree
 =
  class(TForm)
   bGetSelection: TButton;
   l: TLabel;
   m: TMemo;
    Panel1: TPanel;
    Panel2: TPanel;
    Splitter1: TSplitter;
    tv: TTreeView;
    procedure bGetSelectionClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    slFiles: TStringList;
  public
    procedure tv_addnode_from_key_value( _Key, _Value: String);
    function Get_Selected: String;
  end;

var
 fFileTree: TfFileTree;

implementation

{$R *.lfm}

{ TfFileTree }

procedure TfFileTree.FormCreate(Sender: TObject);
   procedure slFiles_from_ini_file;
   var
      ini: TINIFile;
   begin
        ini:= TINIFile.Create( 'FileTree.ini');
        try
           ini.ReadSectionRaw( 'Files', slFiles);
        finally
               slFiles.Sort;
               FreeAndNil( ini);
               end;
   end;
   procedure tv_from_slFiles;
   var
      i: Integer;
      Key, Value: String;
   begin
        for i:= 0 to slFiles.Count-1
        do
          begin
          Key  := slFiles.Names         [ i];
          Value:= slFiles.ValueFromIndex[ i];

          tv_addnode_from_key_value( Key, Value);
          end;
   end;
begin
     slFiles:= TStringList.Create;
     slFiles_from_ini_file;
     tv_from_slFiles;
end;

procedure TfFileTree.FormDestroy(Sender: TObject);
begin
     FreeAndNil( slFiles);
end;

//duplicated for convenience from uuStrings.pas
function StrToK( Key: String; var S: String): String;
var
   I: Integer;
begin
     I:= Pos( Key, S);
     if I = 0
     then
         begin
         Result:= S;
         S:= '';
         end
     else
         begin
         Result:= Copy( S, 1, I-1);
         Delete( S, 1, (I-1)+Length( Key));
         end;
end;

procedure TfFileTree.tv_addnode_from_key_value(_Key, _Value: String);
const
     Separator='\';
var
   sTreePath: String;
   procedure Recursif( Root: String; Parent: TTreeNode);
   var
      s: String;
      Node: TTreeNode;
   begin
        s:= StrTok( Separator, sTreePath);
        if sTreePath = ''
        then             //terminal case for recursion, add Value
            s:= s + ' ' + _Value;

        if nil = Parent
        then
            Node:= tv.Items.FindNodeWithText( s)
        else
            Node:= Parent.FindNode(s);
        if nil = Node
        then
            Node:= tv.Items.AddChild( Parent, s);

        if sTreePath = ''
        then //terminal case for recursion
            begin
            end
        else
            Recursif( sTreePath, Node);
   end;
begin
     sTreePath:= _Key;
     Recursif( '', nil);

end;

//duplicated for convenience from uuStrings.pas
{ Formate_Liste
Concatène les éléments de S en les séparant par la chaine Separateur
et retourne le résultat.
}
procedure Formate_Liste( var S: String; Separateur, Element: String); overload;
const sys_Vide=''; //duplicated for convenience from u_sys_.pas
begin
     if Element = sys_Vide then exit;

     if S <> sys_Vide
     then
         S:= S + Separateur;

     S:= S + Element;
end;

function TfFileTree.Get_Selected: String;
var
   I: Integer;
begin
     Result:= '';
     for i:=0 to tv.SelectionCount-1
     do
       Formate_Liste( Result, #13#10, tv.Selections[i].GetTextPath);
end;

procedure TfFileTree.bGetSelectionClick(Sender: TObject);
begin
     m.Lines.Text:= Get_Selected;
end;

end.