做了一个浏览指定文件格式的 TreeView（方便查看Source目录下的源码）

unit DirTreeView;
 
interface
 
uses
  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;
 
implementation
 
function DirToTree(aTree: TTreeView; const aRootDir,aDir,aExt: string; const aKey: string=''; aNum: Integer = -): 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 = - then Node := nil else Node := aTree.Items[aNum];
 
  if FindFirst(LDir + '\*.*', faAnyFile, sr) =  then
  begin
    repeat
      if sr.Name[] = '.' then Continue;
      if (sr.Attr and faDirectory) = faDirectory then
      begin
          NodeTemp := aTree.Items.AddChild(Node, sr.Name);
          NodeTemp.ImageIndex := ;
          NodeTemp.SelectedIndex := ;
          DirToTree(aTree, '', LDir + '\' + sr.Name, aExt, aKey, aTree.Items.Count-);
      end else begin
        if aKey <> '' then
          if Pos(aKey, StringReplace(LDir + '\' + sr.Name, LRootDir, '', [rfIgnoreCase])) =  then
            Continue;
        if ExtractFileExt(sr.Name) = aExt then
        begin
          NodeTemp := aTree.Items.AddChild(Node, ChangeFileExt(sr.Name, ''));
          NodeTemp.ImageIndex := ;
          NodeTemp.SelectedIndex := ;
        end;
      end;
      Application.ProcessMessages;
    until (FindNext(sr) <> );
  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[] = '*' 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 <>  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 := ;
  Node.SelectedIndex := ;
end;
 
procedure TDirTreeView.Expand(Node: TTreeNode);
begin
  inherited;
  Node.ImageIndex := ;
  Node.SelectedIndex := ;
end;
 
procedure TDirTreeView.OpenList(const aKey: string);
var
  i: Integer;
begin
  Items.Clear;
  DirToTree(Self, FRootPath, '', FExt, aKey);
  {取消空文件夹}
  Items.BeginUpdate;
  for i := Items.Count -  downto  do
  begin
    if (not Items[i].HasChildren) and (Items[i].ImageIndex = ) 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;
 
interface
 
uses
  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 := ;
    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.

---

测试效果图:

http://www.cnblogs.com/del/archive/2011/07/07/2100069.html