TreeViewにフォルダーをRunTimeでツリー状に表示する方法

解決


yTake  2021-09-03 00:05:16  No: 149822

yTakeです。
FMX環境において、TreeViewにフォルダーをRunTimeでツリー状に表示する方法についてです。

ヘルプなどではサンプルプログラムを参照する様になっていますが、サンプルプログラムではデザイン時にTreeViewにツリー構造構築していて、ランタイムではツリーの展開・閉鎖の動作しか記述されていない様です。
インターネット上も検索しましたが、目ぼしい解説サイトが見つかりません。あっても、VCL用のサイトになっています。
VCLでも使い方は似ていると思われましたが、例えば、VCLでは”TTreeNode”と言うクラスを用いている様ですが、FMXでは”TTreeNode”は存在しない様です。

それでも、何とか、ツリー表示する様に作ってみましたが、思っている結果とは違っています。

"TreeView"と"ListBox"を配置し、"TreeView"にフォルダーツリーを表示して、ダブルクリックで指定されたフォルダーの内容を"ListBox"に表示する様にしたいと思います。
"ListBox"はカラムを3分割して、順にファイル名、作成日or修正日、ファイルサイズを表示させます。
また、1行毎に行頭に"CheckBox"を表示させたいと思います。

"TreeView"にフォルダーはリスト表示されていますが、ツリー状には見えていません。
ダブルクリックでそのフォルダー内容が"ListBox"に表示されていますが、全てのカラムに"CheckBox"が表示されてしまっています。

以下は、そのコードです。
================================
procedure TForm2.FormCreate(Sender: TObject);
var
    path      : string;
    mask      : string;
    option    : TSearchOption;
    dirNames  : TStringDynArray;
    dirName   : string;
    i, j, k   : Word;
    tv1_      : Array of TTreeViewItem;
begin
    path := 'c:\';
    mask := '*.*';
    option := TSearchOption.soTopDirectoryOnly; 

    dirNames  := TDirectory.GetDirectories( path, mask, option );
    SetLength( tv1_, Length( dirnames ));
    k :=  0 ;
    for dirName in dirNames do
    begin
        tv1_[ k ]      :=  TTreeViewItem.Create( self );
        tv1_[ k ].Text :=  dirName;
        TreeView1.AddObject( tv1_[ k ]);
        inc( k );
    end;
end;

procedure TForm2.TreeView1DblClick(Sender: TObject);
var
    path      : string;
    mask      : string;
    option    : TSearchOption;
    fileNames : TStringDynArray;
    fileName  : string;
    i, j, k   : Word;
    fs        : TFileStream;
    tv1, tv2  : TTreeViewItem;
    tm        : TDateTime;
begin
    tv1   :=  TreeView1.Selected;
    mask  := '*.*';
    Option := TSearchOption.soTopDirectoryOnly; 

    fileNames := TDirectory.GetFiles( tv1.Text, mask, Option );
    k :=  0 ;
    for fileName in fileNames do
    begin
        fs      :=  TFileStream.Create( FileName, fmOpenRead );
        tm    :=  TFile.GetCreationTime( FileName );
            ListBox1.Items.Add( FileName );     //  ファイル名
            ListBox1.Items.Add( IntToStr( fs.Size ));       //  ファイルサイズ
            ListBox1.Items.Add( DateTimeToStr( tm ));          //  ファイル作成日
        fs.Free();
        inc( k );
    end;
end;
================================
"TreeView"の"AlternatingRowBackground"プロパティをTrueにしています。
"ListBox"は"ShowCheckBoxes"プロパティをTrueにしています。

改善・改良すべき点など、ご教示願えればと思います。
よろしくお願いします。

当方、
DELPHI XE6 with FMX + Windows10 Pro
です。


AAA  2021-09-04 00:48:35  No: 149823

TreeViewItem の Parent を TreeViewItem にすれば子供にはなるけど


AAA  2021-09-04 00:50:27  No: 149824

NGワードがなにかテスト

var
    T1,T2: TTreeViewItem;
begin
    T1 := TTreeViewItem.Create(Self);
    T1.Text := 'サンプル';


AAA  2021-09-04 00:52:17  No: 149825

NGワードがなにかテスト2
IsExpanded


AAA  2021-09-04 00:57:13  No: 149826

TreeViewItem の Parent を TreeViewItem にすれば子供にはなるけど

var
    T1,T2: TTreeViewItem;
begin
    T1 := TTreeViewItem.Create(Self);
    T1.Text := 'AAAAA';
    T1.Parent := TreeView1;
    T1.IsExpanded := True;    //(NGワード回避)

    T2 := TTreeViewItem.Create(Self);
    T2.Text := 'BBBBB';
    T2.Parent := T1;


yTake  2021-09-04 07:38:09  No: 149827

AAAさん、ありがとうございます。

"TTreeViewItem"でツリー構造を設定するわけですね。
ちょうど、VCLで言うところの"TTreeNode"に相当すると考えて良いのでしょうか。

確かに、ツリー状になりました。
サブフォルダーをどこまでTTreeViewItemに登録するのか、難しいところに思います。
一般的にはどの様にするのでしょう?

参考までに示唆頂けれると幸いです。


AAA  2021-09-06 08:18:57  No: 149828

ひらがな

procedure TForm1.Button1Click(Sender: TObject);
begin
    DIR ('C:\' , TreeView1);
end;

procedure TForm1.DIR(APATH: String; AParent: TComponent);
var
    dirNames  : TStringDynArray;
    dirName   : string;
    TreeViewItem: TTreeViewItem;
begin
    try
      dirNames  := TDirectory.GetDirectories(Apath, '*.*', TSearchOption.soTopDirectoryOnly );
      for dirName in dirNames do
      begin
        TreeViewItem := TTreeViewItem.Create(TreeView1);
        TreeViewItem.Text := DirName;
        TreeViewItem.OnApplyStyleLookup := TreeViewItemApplyStyleLookup;
        if AParent is TTreeView     then TreeViewItem.Parent := TTreeView(AParent);
        if AParent is TTreeViewItem then TreeViewItem.Parent := TTreeViewItem(AParent);
      end;
    except
    end;
end;

procedure TForm1.TreeViewItemApplyStyleLookup(Sender: TObject);
var
    TreeViewItem,T2: TTreeViewItem;
begin
    if Sender is TTreeViewItem then
    begin
      TreeViewItem := TTreeViewItem(Sender);
      if TreeViewItem.Tag = 0 then
      begin
        TreeViewItem.Tag := 1;
        DIR (TreeViewItem.Text,TreeViewItem);
      end;

    end;

end;


AAA  2021-09-06 14:22:45  No: 149829

フルパスでなく個々のフォルダ名のみ表示の場合

procedure TForm1.Button1Click(Sender: TObject);
begin
    DRIVE('C:\');
    DRIVE('D:\');
end;

procedure TForm1.DRIVE(ADRIVE: String);
var
    TreeViewItem: TTreeViewItem;
begin
    TreeViewItem := TTreeViewItem.Create(TreeView1);
    TreeViewItem.Text := ADRIVE;
    TreeViewItem.OnApplyStyleLookup := TreeViewItemApplyStyleLookup;
    TreeViewItem.Parent := TreeView1;
end;

procedure TForm1.DIR(APATH: String; AParent: TComponent);
var
    dirNames  : TStringDynArray;
    dirName   : string;
    TreeViewItem: TTreeViewItem;
begin
    try
      dirNames  := TDirectory.GetDirectories(Apath, '*.*', TSearchOption.soTopDirectoryOnly );
      for dirName in dirNames do
      begin
        TreeViewItem := TTreeViewItem.Create(AParent);
        TreeViewItem.Text := ExtractFilename(DirName);
        TreeViewItem.OnApplyStyleLookup := TreeViewItemApplyStyleLookup;
        TreeViewItem.Parent := TTreeViewItem(AParent);
      end;
    except
    end;
end;

procedure TForm1.TreeViewItemApplyStyleLookup(Sender: TObject);
var
    I: Integer;
    S: String;
    TreeViewItem,T2: TTreeViewItem;
begin
    if Sender is TTreeViewItem then
    begin
      TreeViewItem := TTreeViewItem(Sender);
      if TreeViewItem.Tag = 0 then
      begin
        TreeViewItem.Tag := 1;

        T2 := TreeViewItem;
        S  := T2.Text;
        for I:=0 to T2.Level do
        begin
          if T2.Owner is TTreeViewItem then
          begin
            T2 := TTreeViewItem(T2.Owner);
            S := T2.Text + '\' + S;
          end;
        end;

        DIR (S,TreeViewItem);
      end;

    end;

end;


AAA  2021-09-07 13:18:03  No: 149830

TreeView と ListViewぽいやつ(ListBoxで)

unit Unit1;

interface

uses
  System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants,
  FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs,
  FMX.Controls.Presentation, FMX.StdCtrls, FMX.Layouts, FMX.TreeView,
  FMX.Memo.Types, FMX.ScrollBox, FMX.Memo, FMX.ListView.Types,
  FMX.ListView.Appearances, FMX.ListView.Adapters.Base, FMX.ListView,
  FMX.ListBox,System.IOUtils;

type

  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
  private
    { private 宣言 }
  public
    procedure DRIVE(ADRIVE: String);
    procedure DIR(APATH: String; AParent: TComponent);
    procedure TreeViewItemApplyStyleLookup(Sender: TObject);
    procedure TreeViewItemClick(Sender: TObject);
    procedure ListBoxItemClick(Sender: TObject);
    procedure ListBoxItemPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
    procedure ColumnsResized(Sender: TObject);
  end;

var
  Form1: TForm1;
  Column: TPanel;
  Columns: array[0..3] of TPanel;
  ListBoxHeader: TListBoxHeader;
  TreeView: TTreeView;
  ListBox: TListBox;

implementation

{$R *.fmx}

procedure TForm1.ColumnsResized(Sender: TObject);
begin
    ListBox.Repaint;
end;

procedure TForm1.DRIVE(ADRIVE: String);
var
    TreeViewItem: TTreeViewItem;
begin
    TreeViewItem := TTreeViewItem.Create(TreeView);
    TreeViewItem.Text := ADRIVE;
    TreeViewItem.OnApplyStyleLookup := TreeViewItemApplyStyleLookup;
    TreeViewItem.OnClick            := TreeViewItemClick;
    TreeViewItem.Parent := TreeView;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
    I: Integer;
    Splitter: TSplitter;
    Caption: TLabel;
begin

    TreeView := TTreeView.Create(Self);
    TreeView.Align := TAlignLayout.Left;
    TreeView.Width := 200;
    TreeView.Parent := Self;

    Splitter := TSplitter.Create(Self);
    Splitter.Parent := Column;
    Splitter.Width := 3;

    ListBox := TListbox.Create(Self);
    ListBox.Align := TAlignLayout.Client;
    ListBox.Parent := Self;

    ListBoxHeader := TListBoxHeader.Create(Self);
    ListBoxHeader.Height := 25;
    ListBox.ListItems[0].AddObject(ListBoxHeader);

    Column := TPanel.Create(Self);
    Column.Parent := ListBox;
    Column.Align  := TAlignLayout.Top;
    Column.Height := 23;

    Columns[0] := TPanel.Create(Self);
    Columns[0].Parent := Column;
    Columns[0].Align :=TAlignLayout.Left;
    Columns[0].Width := 300;
    Columns[0].OnResized := ColumnsResized;
    Caption := TLabel.Create(Self);
    Caption.Text := 'ファイル名';
    Caption.Align := TAlignLayout.Left;
    Caption.parent := Columns[0];
    Splitter := TSplitter.Create(Self);
    Splitter.Parent := Column;
    Splitter.Width := 3;

    Columns[3] := TPanel.Create(Self);
    Columns[3].Parent := Column;
    Columns[3].Align :=TAlignLayout.Left;
    Columns[3].Width := 150;
    Columns[3].OnResized := ColumnsResized;;
    Caption := TLabel.Create(Self);
    Caption.Text := '日付';
    Caption.Align := TAlignLayout.Left;
    Caption.parent := Columns[3];
    Splitter := TSplitter.Create(Self);
    Splitter.Parent := Column;
    Splitter.Width := 3;

    Columns[2] := TPanel.Create(Self);
    Columns[2].Parent := Column;
    Columns[2].Align :=TAlignLayout.Left;
    Columns[2].Width := 50;
    Columns[2].OnResized := ColumnsResized;
    Caption := TLabel.Create(Self);
    Caption.Text := '属性';
    Caption.Align := TAlignLayout.Left;
    Caption.parent := Columns[2];
    Splitter := TSplitter.Create(Self);
    Splitter.Parent := Column;
    Splitter.Width := 3;

    Columns[1] := TPanel.Create(Self);
    Columns[1].Parent := Column;
    Columns[1].Align :=TAlignLayout.Left;
    Columns[1].Width := 100;
    Columns[1].OnResized := ColumnsResized;
    Caption := TLabel.Create(Self);
    Caption.Text := 'サイズ';
    Caption.Align := TAlignLayout.Left;
    Caption.parent := Columns[1];
    Splitter := TSplitter.Create(Self);
    Splitter.Parent := Column;
    Splitter.Width := 3;

    DRIVE('C:\');
    DRIVE('D:\');

end;

procedure TForm1.DIR(APATH: String; AParent: TComponent);
var
    dirNames  : TStringDynArray;
    dirName   : string;
    TreeViewItem: TTreeViewItem;
begin
    try
      dirNames  := TDirectory.GetDirectories(Apath, '*.*', TSearchOption.soTopDirectoryOnly );
      for dirName in dirNames do
      begin
        TreeViewItem := TTreeViewItem.Create(AParent);
        TreeViewItem.Text := ExtractFilename(DirName);
        TreeViewItem.OnApplyStyleLookup := TreeViewItemApplyStyleLookup;
        TreeViewItem.OnClick            := TreeViewItemClick;
        TreeViewItem.Parent := TTreeViewItem(AParent);
      end;
    except
    end;
end;

procedure TForm1.ListBoxItemPaint(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
var
    I: Integer;
    S: String;
    ListBoxItem: TListBoxItem;
    Flags: TFillTextFlags;
    ATextAlign, AVTextAlign: TTextAlign;
    BRECT: TRectF;
    StringList: TStringList;
begin

    if Sender is TListBoxItem then
    begin
      ListBoxItem := TListBoxItem(Sender);

      Canvas.BeginScene();

      Canvas.ClearRect(ARect,0);

      //              中央    右       左
      //TTextAlign = (Center, Leading, Trailing);

      Flags       := [TFillTextFlag.ftRightToLeft];
      ATextAlign  := TTextAlign.Trailing;
      AVTextAlign := TTextAlign.Center;

      StringList := TStringList.Create;
      StringList.CommaText := ListBoxItem.Text;

      BRect := ARect;
      S := ListBoxItem.Text;
      for I := 0 to 3 do
      begin
        BRect.Left  := Columns[I].Position.X;
        BRect.Right :=  Columns[I].Position.X + Columns[I].Width;
        Canvas.Fill.Color := TAlphaColors.Black;

        ATextAlign  := TTextAlign.Trailing;
        if I = 1 then ATextAlign := TTextAlign.Leading;

        Canvas.FillText(BRect,StringList[I],False,100,Flags,ATextAlign, AVTextAlign);
      end;

      StringList.Free;

      Canvas.EndScene;
    end;

end;

procedure TForm1.ListBoxItemClick(Sender: TObject);
var
    ListBoxItem: TListBoxItem;
begin
    if Sender is TListBoxItem then
    begin
      ListBoxItem := TListBoxItem(Sender);
    end;
end;

procedure TForm1.TreeViewItemClick(Sender: TObject);
var
    I,J: Integer;
    PATH: String;
    TreeViewItem,T2: TTreeViewItem;
    Filenames : TStringDynArray;
    Filename: String;
    ListViewItem: TListViewItem;
    dirNames  : TStringDynArray;
    dirName   : string;

    ListItemView: TListItemView;
    X: TAppearanceListViewItems;

    FN: String;
    AT: TFileAttributes;
    DT: TDateTime;
    SZ: Int64;

    function AttrStr(Attr:  TFileAttributes): String;
    begin
      RESULT := '';
      {$IFDEF MSWINDOWS}
      if TFileAttribute.faArchive  in Attr then RESULT := RESULT + 'A' else RESULT := RESULT + ' ';
      if TFileAttribute.faHidden   in Attr then RESULT := RESULT + 'H' else RESULT := RESULT + ' ';
      if TFileAttribute.faReadOnly in Attr then RESULT := RESULT + 'R' else RESULT := RESULT + ' ';
      if TFileAttribute.faSystem   in Attr then RESULT := RESULT + 'S' else RESULT := RESULT + ' ';
      {$ENDIF}
    end;

    function GetSize(PATH: String): Int64;
    var
      SearchRec: TSearchRec;
    begin
      {$IFDEF MSWINDOWS}
      FindFirst (Filename,faAnyFile,SearchRec);
      RESULT := SearchRec.Size;
      FindClose(SearchRec);
      {$ENDIF}
    end;

    procedure ADD(FN: String; SZ: Int64; AT: TFileAttributes; DT: TDateTime);
    var
      I: Integer;
      ATEXT: String;
    begin
      if SZ = -1 then
      begin
        ATEXT := '"' + FN + '","","' + AttrStr(AT) + '","' + FormatDateTime('YYYY/MM/DD HH:NN:SS',DT) + '"';
      end
      else
      begin
        ATEXT := '"' + FN + '","' + IntToStr(SZ) + '","' + AttrStr(AT) + '","' + FormatDateTime('YYYY/MM/DD HH:NN:SS',DT) + '"';
      end;
      I := ListBox.Items.Add(ATEXT);
      ListBox.ListItems[I].OnClick := ListBoxItemClick;
      ListBox.ListItems[I].OnPaint := ListBoxItemPaint;
    end;

begin
    if Sender is TTreeViewItem then
    begin
      TreeViewItem := TTreeViewItem(Sender);

      T2   := TreeViewItem;
      PATH := T2.Text;
      for I:=0 to T2.Level do
      begin
        if T2.Owner is TTreeViewItem then
        begin

          T2 := TTreeViewItem(T2.Owner);
          if T2.Level = 1 then
          begin
            PATH := T2.Text + '' + PATH;
          end
          else
          begin
            PATH := T2.Text + '\' + PATH;
          end;
        end;
      end;

      try

        dirNames  := TDirectory.GetDirectories(PATH, '*.*', TSearchOption.soTopDirectoryOnly );
        Filenames := TDirectory.GetFiles(PATH,'*.*');

        ListBox.Clear;

        //DIRECTORY
        for Dirname in Dirnames do
        begin
          try
            FN := ExtractFilename(Dirname);
            AT := TDirectory.GetAttributes(Dirname);
            DT := TDirectory.GetCreationTime(Dirname);
            ADD (FN,-1,AT,DT);
          except
          end;
        end;

        //FILE
        for Filename in Filenames do
        begin
          try
            FN := ExtractFilename(Filename);
            AT := TFile.GetAttributes(Filename);
            DT := TFile.GetCreationTime(Filename);
            SZ := GetSize(Filename);
            ADD(FN,SZ,AT,DT);
          except
          end;
        end;

      except

      end;

    end;
end;

procedure TForm1.TreeViewItemApplyStyleLookup(Sender: TObject);
var
    I: Integer;
    S: String;
    TreeViewItem,T2: TTreeViewItem;
begin
    if Sender is TTreeViewItem then
    begin
      TreeViewItem := TTreeViewItem(Sender);
      if TreeViewItem.Tag = 0 then
      begin
        TreeViewItem.Tag := 1;

        T2 := TreeViewItem;
        S  := T2.Text;
        for I:=0 to T2.Level do
        begin
          if T2.Owner is TTreeViewItem then
          begin
            T2 := TTreeViewItem(T2.Owner);
            if T2.Level = 1  then
            begin
              S := T2.Text + '' + S;
            end
            else
            begin
              S := T2.Text + '\' + S;
            end;
          end;
        end;
        DIR (S,TreeViewItem);
      end;
    end;
end;

end.


yTake  2021-09-09 09:07:09  No: 149831

AAAさん
ありがとうございます。
貴重なコーディング例をありがとうございます。
ちょっと時間が掛かりそうです。
試しながら、よく読み込んでみたいと思います。


yTake  2021-10-04 22:35:07  No: 149864

まだ、不明な点がありますが、取り敢えず、閉じておきます。
また、改めて、投稿させて頂きます。


※返信する前に利用規約をご確認ください。








  このエントリーをはてなブックマークに追加