TreeViewにフォルダーをRunTimeでツリー状に表示する方法 (ID:149830)

名前

ホームページ(ブログ、Twitterなど)のURL (省略可)

本文

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.

←解決時は質問者本人がここをチェックしてください。

戻る