Blog de Serge Girard (aka SergioMaster)

Au risque de réinventer une roue existante que je n'aurais pas trouvée, j'ai décidé de créer mon dialogue.

Il y a tout d'abord une première particularité à l'utilisation du TTreeview Firemonkey la création des éléments est vraiment différente de celle de VCL.
Je vous livre mon secret pour optimiser le chargement : ne pas tout balayer mais seulement les répertoires enfants mais quand même indiquer s'il y a des branches possibles grâce à un élément fantôme.

Code Delphi :

Sélectionner tout - Visualiser dans une fenêtre à part

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
procedure TForm1.AddDirectories(ParentNode: TTreeviewItem; const Path: string);
var
  SubDirs: TStringDynArray;
  SubDir: string;
  NewNode: TTreeviewItem;
  HasChildren: Boolean;
begin
  if DirectoryExists(Path) then
  begin
    NewNode:=nil;
    SubDirs := TDirectory.GetDirectories(Path, '*.*',
      TSearchOption.soTopDirectoryOnly);                // un seul répertoire à la fois
      if Sizeof(subdirs) > 0 then
    begin
      for SubDir in SubDirs do
      begin
        if not DirectoryExists(subdir) then continue;
        try
          HasChildren := Length(TDirectory.GetDirectories(SubDir)) > 0;
          NewNode := TTreeViewItem.Create(ParentNode);
          NewNode.Parent := ParentNode;
          NewNode.Text := TPath.GetFileName(SubDir); // Nom seul, sans le chemin
          NewNode.ImageIndex := 0;
          NewNode.TagString := StrNew(PChar(SubDir)); // Chemin complet stocké
          NewNode.OnClick := TreeViewItemClick;
          // Vérifie si ce sous-dossier a lui-même des enfants
          // pour afficher ou non le bouton [+]
        except
          HasChildren := False;
        end;
 
        if HasChildren then
          // Nœud fantôme : déclenche l'affichage du bouton [+]
         begin
           NoeudFantome(NewNode);
         end;
      end;
    end;
  end;
end;
 
procedure TForm1.NoeudFantome(ParentNode: TTreeViewItem);
var
  NewNode: TTreeviewItem;
begin
  NewNode := TTreeViewItem.Create(ParentNode);
  NewNode.ImageIndex := -1;
  NewNode.Parent := ParentNode;
end;
 
procedure TForm1.TreeViewItemClick(Sender: TObject);
begin
  var path := TTreeViewItem(sender).TagString;
 
  if (TTreeViewItem(sender).Count>0) AND (TTreeViewItem(sender).ItemByIndex(0).ImageIndex=-1) then
  begin
    TreeView1.BeginUpdate;
    FreeAndnil(TTreeViewItem(sender).ItemByIndex(0));
    AddDirectories(TTreeviewItem(sender), TTreeViewItem(sender).TagString);
    TTreeviewItem(Sender).Expand;
    TreeView1.EndUpdate;
  end;
 
end;

Si on en reste là quand nous voulons obtenir les sous-répertoires en utilisant l'extenseur, nous verrons l'élément fantôme pas la suite de l'arborescence.



Le problème avec le TTreeView en Firemonkey est qu'il manque certains évènements défini en VCL comme le OnExpanding et si l'on utilise l'extenseur, l'évènement TreeViewItem.OnClick n'est pas déclenché.

Donc comment procéder ? J'ai testé plusieurs solutions en commençant par le surclassement de TTreeViewItem.
Puis j'ai fait des tentatives de désactivation du bouton extenseur en accédant au style de l'élément.



Celles-ci paraissaient prometteuses mais, hélas, pas toujours efficace. Dans l'image suivante l'extenseur de TreeviewItem6 devrait être grisé.



Cependant la piste du style se révèle être la bonne si l'on utilise les spécificités des styles Firemonkey, à savoir la méthode de recherche d'un style d'élément (stylelookup).
J'ai commencé par déposer un nouveau TStyleBook sur le formulaire.
Puis j'ai ouvert le style en cours pour copier le l'élément nommé treeviewitemstyle afin de le coller dans ce nouveau Stylebook.
J'ai ensuite renommé ce dernier en treeviewitemghosted.
J'ai ensuite changé le comportement du bouton en mettant simplement la propriété HitTest à false.
Enfin, pour que l'affichage du texte soit correct quelque soit le style en cours, j'ai supprimé TText pour le remplacer par un TLabel.

Code Delphi :

Sélectionner tout - Visualiser dans une fenêtre à part

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
procedure TForm1.AddDirectories(ParentNode: TTreeviewItem; const Path: string);
var
  SubDirs: TStringDynArray;
  SubDir: string;
  NewNode: TTreeviewItem;
  HasChildren: Boolean;
begin
  if DirectoryExists(Path) then
  begin
    NewNode:=nil;
    SubDirs := TDirectory.GetDirectories(Path, '*.*',
      TSearchOption.soTopDirectoryOnly);
      if Sizeof(subdirs) > 0 then
    begin
      for SubDir in SubDirs do
      begin
        if not DirectoryExists(subdir) then continue;
        try
          HasChildren := Length(TDirectory.GetDirectories(SubDir)) > 0;
          NewNode := TTreeViewItem.Create(ParentNode);
          NewNode.Parent := ParentNode;
          NewNode.Text := TPath.GetFileName(SubDir); // Nom seul, sans le chemin
          NewNode.ImageIndex := 0;
          NewNode.TagString := StrNew(PChar(SubDir)); // Chemin complet stocké
          NewNode.OnClick := TreeViewItemClick;
          // Vérifie si ce sous-dossier a lui-même des enfants
          // pour afficher ou non le bouton [+]
        except
          HasChildren := False;
        end;

        if HasChildren then
          // Nœud fantôme : déclenche l'affichage du bouton [+]
         begin
          newNode.StyleLookup:='treeviewitemghosted';
          NoeudFantome(NewNode);
         end;
      end;
    end;
  end;
end;
end;

procedure TForm1.TreeViewItemClick(Sender: TObject);
begin
  var path := TTreeViewItem(sender).TagString;
  if TTreeViewItem(sender).StyleLookup.EndsWith('ghosted') then
  begin
    TreeView1.BeginUpdate;
    TTreeViewItem(sender).StyleLookup:=''; // style en cours
    TTreeViewItem(sender).NeedStyleLookup; // ne pas oublier
    FreeAndnil(TTreeViewItem(sender).ItemByIndex(0));
    AddDirectories(TTreeviewItem(sender), TTreeViewItem(sender).TagString);
    TTreeviewItem(Sender).Expand;
    TreeView1.EndUpdate;
  end;
  
end;
end;

Le résultat final



Le prochain billet parlera de comment j'ai traité la liste (TListBox) droite