做了一个浏览指定文件格式的 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 = -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;

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 := 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.

测试效果图:


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