一个浏览指定文件格式的 TreeView

 

unit DirTreeView;interfaceuses  SysUtils, Classes, Controls, Forms, ComCtrls;type   TDirTreeView = class(TTreeView)  private    FRootPath: string;    FExt: string;    FFileName: string;  protected    procedure Collapse(Node: TTreeNode); override;    procedure Expand(Node: TTreeNode); override;    procedure Change(Node: TTreeNode); override;  public    constructor Create(AOwner: TComponent; const aRootPath,aExt: string); reintroduce;    procedure OpenList(const aKey: string = '');    property FileName: string read FFileName;  end;implementationfunction DirToTree(aTree: TTreeView; const aRootDir,aDir,aExt: string; const aKey: string=''; aNum: Integer = -1): Boolean;var  sr: TSearchRec;  Node,NodeTemp: TTreeNode;  LRootDir,LDir: string;begin  LRootDir := ExcludeTrailingPathDelimiter(aRootDir);  LDir := ExcludeTrailingPathDelimiter(aDir);  if LRootDir <> '' then LDir := ExcludeTrailingPathDelimiter(LRootDir) + LDir;  if aNum = -1 then Node := nil else Node := aTree.Items[aNum];  if FindFirst(LDir + '\*.*', faAnyFile, sr) = 0 then  begin    repeat      if sr.Name[1] = '.' then Continue;      if (sr.Attr and faDirectory) = faDirectory then      begin          NodeTemp := aTree.Items.AddChild(Node, sr.Name);          NodeTemp.ImageIndex := 0;          NodeTemp.SelectedIndex := 0;          DirToTree(aTree, '', LDir + '\' + sr.Name, aExt, aKey, aTree.Items.Count-1);      end else begin        if aKey <> '' then          if Pos(aKey, StringReplace(LDir + '\' + sr.Name, LRootDir, '', [rfIgnoreCase])) = 0 then            Continue;        if ExtractFileExt(sr.Name) = aExt then        begin          NodeTemp := aTree.Items.AddChild(Node, ChangeFileExt(sr.Name, ''));          NodeTemp.ImageIndex := 1;          NodeTemp.SelectedIndex := 1;        end;      end;      Application.ProcessMessages;    until (FindNext(sr) <> 0);  end;  Result := True;end;{ TDirTreeView }constructor TDirTreeView.Create(AOwner: TComponent; const aRootPath, aExt: string);begin  inherited Create(AOwner);  AutoExpand := True;  ShowButtons := False;  ShowLines := False;  FRootPath := ExcludeTrailingPathDelimiter(aRootPath) + '\';  FExt := aExt;  if FExt[1] = '*' then FExt := StringReplace(FExt, '*.', '.', [rfIgnoreCase]);end;procedure TDirTreeView.Change(Node: TTreeNode);var  n: TTreeNode;  TmpPath: string;begin  if not Node.Selected then Exit;  if Node.ImageIndex <> 1 then Exit;  Cursor := crHourGlass;  n := Node;  TmpPath := n.Text;  while n.Parent <> nil do  begin    TmpPath := n.Parent.Text + '\' + TmpPath;    n := n.Parent;  end;  FFileName := FRootPath + TmpPath + FExt;  Cursor := crDefault;  inherited;end;procedure TDirTreeView.Collapse(Node: TTreeNode);begin  inherited;  Node.ImageIndex := 0;  Node.SelectedIndex := 0;end;procedure TDirTreeView.Expand(Node: TTreeNode);begin  inherited;  Node.ImageIndex := 2;  Node.SelectedIndex := 2;end;procedure TDirTreeView.OpenList(const aKey: string);var  i: Integer;begin  Items.Clear;  DirToTree(Self, FRootPath, '', FExt, aKey);  {取消空文件夹}  Items.BeginUpdate;  for i := Items.Count - 1 downto 0 do  begin    if (not Items[i].HasChildren) and (Items[i].ImageIndex = 0) then      Items[i].Delete    else if aKey <> '' then      Items[i].Expanded := True;  end;  Items.EndUpdate;end;end.

---

测试:
1、在空白窗体上放 Memo1: TMemo; 和 Splitter1: TSplitter;
2、再放 ImageList1: TImageList; 添加三个图标, 分别表示: 文件夹、文件、已打开的文件夹.

---

unit Unit1;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, ComCtrls, ImgList, StdCtrls, ExtCtrls;type  TForm1 = class(TForm)    ImageList1: TImageList;    Memo1: TMemo;    Splitter1: TSplitter;    procedure TreeViewOnChange(Sender: TObject; Node: TTreeNode);    procedure FormShow(Sender: TObject);    procedure FormCreate(Sender: TObject);  end;var  Form1: TForm1;implementation{$R *.dfm}uses DirTreeView;procedure TForm1.FormCreate(Sender: TObject);begin  Memo1.Font.Name := 'Fixedsys';  Memo1.Align := alClient;  Memo1.ScrollBars := ssBoth;end;procedure TForm1.FormShow(Sender: TObject);var  dir: string;begin  dir := GetEnvironmentVariable('Delphi') + '\source';  with TDirTreeView.Create(Self, dir, '.pas') do begin //测试浏览 Delphi 官方源码    Parent := Self;    Align := alLeft;    Width := 200;    Images := ImageList1;    OnChange := TreeViewOnChange;    OpenList(); //其参数是要过滤的关键字  end;end;procedure TForm1.TreeViewOnChange(Sender: TObject; Node: TTreeNode);var  FileName: string;begin  FileName := TDirTreeView(Sender).FileName;  Memo1.Lines.LoadFromFile(FileName);end;end.
 
测试效果图：