TreeViewにフォルダーをRunTimeでツリー状に表示する方法
解決ｙTakeです。
FMX環境において、TreeViewにフォルダーをRunTimeでツリー状に表示する方法についてです。
ヘルプなどではサンプルプログラムを参照する様になっていますが、サンプルプログラムではデザイン時にTreeViewにツリー構造構築していて、ランタイムではツリーの展開・閉鎖の動作しか記述されていない様です。
インターネット上も検索しましたが、目ぼしい解説サイトが見つかりません。あっても、VCL用のサイトになっています。
VCLでも使い方は似ていると思われましたが、例えば、VCLでは”TTreeNode”と言うクラスを用いている様ですが、FMXでは”TTreeNode”は存在しない様です。
それでも、何とか、ツリー表示する様に作ってみましたが、思っている結果とは違っています。
"TreeView"と"ListBox"を配置し、"TreeView"にフォルダーツリーを表示して、ダブルクリックで指定されたフォルダーの内容を"ListBox"に表示する様にしたいと思います。
"ListBox"はカラムを３分割して、順にファイル名、作成日or修正日、ファイルサイズを表示させます。
また、１行毎に行頭に"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
です。
TreeViewItem の Parent を TreeViewItem にすれば子供にはなるけど
NGワードがなにかテスト
var
T1,T2: TTreeViewItem;
begin
T1 := TTreeViewItem.Create(Self);
T1.Text := 'サンプル';
NGワードがなにかテスト2
ＩｓＥｘｐａｎｄｅｄ
TreeViewItem の Parent を TreeViewItem にすれば子供にはなるけど
var
T1,T2: TTreeViewItem;
begin
T1 := TTreeViewItem.Create(Self);
T1.Text := 'AAAAA';
T1.Parent := TreeView1;
T1.ＩｓＥｘｐａｎｄｅｄ := True; //(NGワード回避)
T2 := TTreeViewItem.Create(Self);
T2.Text := 'BBBBB';
T2.Parent := T1;
AAAさん、ありがとうございます。
"TTreeViewItem"でツリー構造を設定するわけですね。
ちょうど、VCLで言うところの"TTreeNode"に相当すると考えて良いのでしょうか。
確かに、ツリー状になりました。
サブフォルダーをどこまでTTreeViewItemに登録するのか、難しいところに思います。
一般的にはどの様にするのでしょう？
参考までに示唆頂けれると幸いです。
ひらがな
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;
フルパスでなく個々のフォルダ名のみ表示の場合
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;
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.
AAAさん
ありがとうございます。
貴重なコーディング例をありがとうございます。
ちょっと時間が掛かりそうです。
試しながら、よく読み込んでみたいと思います。
まだ、不明な点がありますが、取り敢えず、閉じておきます。
また、改めて、投稿させて頂きます。
| ツイート |  |