一个资源管理器的目录问题 ( 积分: 50 )

  • 主题发起人 主题发起人 一剑飘雪
  • 开始时间 开始时间

一剑飘雪

Unregistered / Unconfirmed
GUEST, unregistred user!
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls;

type
TForm1 = class(TForm)
TreeView1: TTreeView;
ListView1: TListView;
procedure FormCreate(Sender: TObject);
procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
procedure ListView1DblClick(Sender: TObject);
private
procedure AddHDTree;
Procedure AddDirTree(S: string);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
DirPath: string;

procedure TForm1.AddDirTree(S: string);
var
I, Found: Integer;
SearchRec: TSearchRec;
begin
TreeView1.Selected.DeleteChildren;
ListView1.Items.Clear;
S := S + '/*.*';
I := 0;
Found := FindFirst(S, faAnyFile, SearchRec);
while Found = 0 do
begin
if (SearchRec.Attr = faDirectory) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
TreeView1.Items.AddChildObject(TreeView1.Selected, SearchRec.Name, PChar(SearchRec.Name));
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
ListView1.Items.Add;
ListView1.Items.Caption := SearchRec.Name;
Inc(I);
end;

Found := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;

procedure TForm1.AddHDTree;
var
Size: DWORD;
I: Integer;
S: string;
Node: TTreeNode;
Buffer: array[0..255] of char;
begin
Node := TreeView1.Items.Add(nil, '我的电脑');
Size := GetLogicalDriveStrings(255, Buffer);
for I := 0 to Size - 1 do
begin
if Buffer = #0 then
begin
S := Copy(S, 0, Length(S) - 1);
TreeView1.Items.AddChildObject(Node, S, PChar(S) );
S := '';
end else
S := S + Buffer;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
AddHDTree;
end;

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
Path: string;

procedure GetDirPath(Node: TTreeNode);
begin
if Node.Text = '我的电脑' then Exit;
if Node.Parent.Text = '我的电脑' then
begin
AddDirTree(Path);
DirPath := Path;
Exit;
end else
Path := Node.Parent.Text + '/' + Path;
GetDirPath(Node.Parent);
end;

begin
Path := TreeView1.Selected.Text;
GetDirPath(TreeView1.Selected);
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var
FileAttr: Integer;
Path: string;

procedure AddDirFileTree(Node: TTreeNode);
begin

end;

begin
try
FileAttr := FileGetAttr(DirPath + '/' + ListView1.Selected.Caption);
if FileAttr = faDirectory then
DirPath := DirPath + '/' + ListView1.Selected.Caption;

except

end;
end;

end.


我想实现双击右边的目录,然后左边的目录展开,以上是源码,请高手帮我改一下。。。
 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls;

type
TForm1 = class(TForm)
TreeView1: TTreeView;
ListView1: TListView;
procedure FormCreate(Sender: TObject);
procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
procedure ListView1DblClick(Sender: TObject);
private
procedure AddHDTree;
Procedure AddDirTree(S: string);
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

var
DirPath: string;

procedure TForm1.AddDirTree(S: string);
var
I, Found: Integer;
SearchRec: TSearchRec;
begin
TreeView1.Selected.DeleteChildren;
ListView1.Items.Clear;
S := S + '/*.*';
I := 0;
Found := FindFirst(S, faAnyFile, SearchRec);
while Found = 0 do
begin
if (SearchRec.Attr = faDirectory) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
TreeView1.Items.AddChildObject(TreeView1.Selected, SearchRec.Name, PChar(SearchRec.Name));
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
ListView1.Items.Add;
ListView1.Items.Caption := SearchRec.Name;
Inc(I);
end;

Found := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;

procedure TForm1.AddHDTree;
var
Size: DWORD;
I: Integer;
S: string;
Node: TTreeNode;
Buffer: array[0..255] of char;
begin
Node := TreeView1.Items.Add(nil, '我的电脑');
Size := GetLogicalDriveStrings(255, Buffer);
for I := 0 to Size - 1 do
begin
if Buffer = #0 then
begin
S := Copy(S, 0, Length(S) - 1);
TreeView1.Items.AddChildObject(Node, S, PChar(S) );
S := '';
end else
S := S + Buffer;
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
AddHDTree;
end;

procedure TForm1.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
Path: string;

procedure GetDirPath(Node: TTreeNode);
begin
if Node.Text = '我的电脑' then Exit;
if Node.Parent.Text = '我的电脑' then
begin
AddDirTree(Path);
DirPath := Path;
Exit;
end else
Path := Node.Parent.Text + '/' + Path;
GetDirPath(Node.Parent);
end;

begin
Path := TreeView1.Selected.Text;
GetDirPath(TreeView1.Selected);
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var
FileAttr: Integer;
Path: string;

procedure AddDirFileTree(Node: TTreeNode);
begin

end;

begin
try
FileAttr := FileGetAttr(DirPath + '/' + ListView1.Selected.Caption);
if FileAttr = faDirectory then
DirPath := DirPath + '/' + ListView1.Selected.Caption;

except

end;
end;

end.


我想实现双击右边的目录,然后左边的目录展开,以上是源码,请高手帮我改一下。。。
 
后退
顶部