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

时间: 2024-08-27 19:35:24

做了一个浏览指定文件格式的 TreeView(方便查看Source目录下的源码)的相关文章

指定一个文件夹自动计算出其总容量 并且进行目录下文件的添加 与指定文件的访问

代码实现: //编写一个程序,指定一个文件夹,能自动计算出其总容量import java.io.*;public class Denglu { public static void main(String[] args) throws IOException { try { InputStreamReader isr=new InputStreamReader(System.in); BufferedReader inp=new BufferedReader(isr);//进行字节字符转换 用于

为了source insight显示android源码正确的“// TODO“做调整

开头写了简单的脚本,后来发现有的目录是带空格的,这样就没法处理了.于是查资料做调整. shell脚本的内容是: #!/bin/bash test=$1 [ "$test" != "" ] && action=echo l="c h cpp java" #owing to folder with space, so the find ... is a little complexif [ "$action" !=

写一个PHP函数,实现扫描并打印出自定目录下(含子目录)的所有jpg文件名

<?php $dir = "E:\照片\\"; //打印文件夹中所有jpg文件 function printJpg($dir,$deep = ""){ $dirSource = dir($dir); while($d = $dirSource->read()){ if($d == "." || $d == ".."){ continue; } if(filetype($dir.$d) == "dir&qu

添加一个时间插件: 1.把插件放到 public目录 下 datetimepicker

<!-- 引入时间插件 --><link href="__PUBLIC__/datetimepicker/jquery-ui-1.9.2.custom.min.css" rel="stylesheet" type="text/css" /><script type="text/javascript" charset="utf-8" src="__PUBLIC__/da

如何在Eclipse中浏览Android源码

Google的Android SDK包括了android.jar,这个Jar文件包含了Android公有API类文件.他们还提供了一个Eclipse插件,这使得开始Android上的开发相当简单.然而,你却不能找到androidSrc.jar这个Jar文件,所以当你想要在Eclipse中看一下Android SDK源代码的时候,你会碰到如图所示的情况: 开源来解救我们了! 这个月早些时候,Google开放了Android的全部源码,顺便说一下,这相当大!不管怎样,为了在Eclipse中浏览源码,

分享一个客户端程序(winform)自动升级程序,思路+说明+源码

做winform的程序,不管用没用过自动更新,至少都想过自动更新是怎么实现的. 我这里共享一个自动更新的一套版本,给还没下手开始写的人一些帮助,也希望有大神来到,给指点优化意见. 本初我是通过socket来传输文件的,后来因为传大文件出现异常,前期又没有定义比较好的协议,后来就改用webservices了. 自动更新分三个部分,服务端(webservice服务,配置与更新),配置客户端(或叫发布客户端),客户端(主程序) 服务端:         ConfigServer.asmx 因为代码共享

[ASP.NET]分析MVC5源码,并实现一个ASP.MVC

本节内容不是MVC入门教程,主要讲MVC原理,实现一个和ASP.NET MVC类似基本原理的项目. MVC原理是依赖于ASP.NET管道事件基础之上的.对于这块,可阅读上节内容 [ASP.NET]谈谈IIS与ASP.NET管道 本节目录: MVC简介 MVC5源码 实现一个MVC MVC简介 随着技术的发展,现在已经将MVC模式等同于三层模式. 如果要严格区分的话,UI层指View和Controller,BLL,DAL层和模型层都属于Model中. 在建立MVC项目的时候,选择空的项目,会建立一

C#获取指定网页源码的几种方法

// WebClient private string GetWebClient(string url) { string strHTML = ""; WebClient myWebClient = new WebClient(); Stream myStream = myWebClient.OpenRead(url); StreamReader sr = new StreamReader(myStream, System.Text.Encoding.GetEncoding("

Linux下载安装一个源码包

下载一个安装包除了yum和rpm之外我们还可以下载源码包 编译并安装 首先下载所有的源码包一定要去官网,为了就是防止源码包被第三方编译 例如我们今天安装一个httpd的源码包,也就是经常说的apache 首先进入官网 apache.org 进入download,并选择一个下载源 找到httpd 点击下载任意一个(右击复制链接地址即可) 如果使用wget下载的时候发现如下情况,代表没有安装wget服务,安装一下即可! 再次下载 下载完成 然后为了统一管理和使用,建议大家养成一个好的习惯把下载的源码