如何构建浏览特定文件格式并展示的长尾词TreeView？

本文共计602个文字，预计阅读时间需要3分钟。

plaintextunitDirTreeView;interfaceuses SysUtils, Classes, Controls, Forms, ComCtrls;type TDirTreeView=class(TTreeView) private FRootPath: string; FExt: string; end;

unitDirTreeView;interfaceusesSysUtils,Classes,Controls,Forms,ComCtrls;typeTDirTreeView 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.

---

测试效果图:

---