📄 unit1.~pas
字号:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,Unit2,
Dialogs, ExtCtrls, ComCtrls, ImgList,shellapi, StdCtrls, Buttons, Menus,
Grids, DBGrids;
type
TListFile = class(TForm)
dir: TTreeView;
wfile: TListView;
ImageList1: TImageList;
ImageList2: TImageList;
PopupMenu1: TPopupMenu;
PopupMenu2: TPopupMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
l1: TMenuItem;
zt: TStatusBar;
Splitter1: TSplitter;
Image1: TImage;
N12: TMenuItem;
N13: TMenuItem;
procedure dirCollapsed(Sender: TObject; Node: TTreeNode);
procedure dirExpanded(Sender: TObject; Node: TTreeNode);
procedure wfileDblClick(Sender: TObject);
procedure dirClick(Sender: TObject);
procedure dirEdited(Sender: TObject; Node: TTreeNode; var S: String);
procedure wfileEdited(Sender: TObject; Item: TListItem; var S: String);
procedure dirKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure N1Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N2Click(Sender: TObject);
procedure N7Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure l1Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure N11Click(Sender: TObject);
procedure N8Click(Sender: TObject);
procedure N12Click(Sender: TObject);
procedure N13Click(Sender: TObject);
private
{ Private declarations }
procedure filedir(dirname:string;node:ttreenode);//查找文件
procedure wmdropfiles(var msg:twmdropfiles);message wm_dropfiles;
public
{ Public declarations }
end;
var
listfile: TListFile;
fileinfo:shfileinfo;
f:array [0..0,0..2] of string;
ListItem: TListItem;
filename,names:string;
pathname:string;
node1,node3:ttreenode;
implementation
{$R *.dfm}
function IsValidDir(SearchRec:TSearchRec):Boolean;
begin
if ((SearchRec.Attr=16)or (searchrec.Attr =17)or
(searchrec.Attr =18)or (searchrec.Attr =22)
or (searchrec.Attr =49)or (searchrec.Attr =48))
and (SearchRec.Name<>'.')
and (SearchRec.Name<>'..') then
Result:=True
else
Result:=False;
//showmessage(inttostr(searchrec.Attr ));
end;
////////以上是一个函数，功能是判断一个文件是不是文件夹。
function panel(node:ttreenode):string;
var
str:string;
node2:ttreenode;
begin
try
node2:=node.Parent;//返回父节点
str:=node2.Text+str;
node1:=node2;
filename:=str+'\'+filename;
panel(node2);
except
panel:=filename;
end;
end;
///////一个递归函数，找到node的父节点。
procedure tlistfile.wmdropfiles(var msg:twmdropfiles);
var
numfiles:longint;
i:longint;
buffer:array[0..255] of char;
begin
showmessage('asdfasdf');
end;
////////用兴趣的朋友可以在这处理鼠标拖放，本人没有处理，只是打到了。
procedure tlistfile.filedir(dirname:string;node:ttreenode);
var
searchrec:tsearchrec;
filename:string;
node1:ttreenode;
i:integer;
begin
try
for i:=node.Count -1 downto 0 do
begin
node.Item [i].Delete ; // count为node的子节点数item【i】node 的子节点
end;
except
end;
//更新目录
filename:=dirname+'\*.*';
wfile.Clear;
listfile.ImageList2.Clear;
listitem:=wfile.Items.Add;
listitem.Caption:='..';
if findfirst(filename,faAnyFile,searchrec)=0 then //findfirst查找成功返回0，否则返回错误代码
begin
while findnext(searchrec)=0 do
begin
if IsValidDir(searchrec) then
begin
node1:=listfile.dir.Items.AddChild(node,searchrec.Name );
node1.ImageIndex:=1;
node1.SelectedIndex:=2;
listfile.dir.Items.AddChild(node1,'' );
shgetfileinfo(pchar(dirname+'\'+searchrec.Name ),0,fileinfo,sizeof(fileinfo),shgfi_icon);
listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;//返回文件的图标
listfile.ImageList2.AddIcon(listfile.image1.Picture.Icon);//添加图标
f[0,0]:=searchrec.Name;//+' '+inttostr(searchrec.Attr );
f[0,1]:=inttostr(searchrec.Size);
f[0,2]:=datetimetostr(filedatetodatetime(searchrec.Time ));
listitem:=wfile.Items.Insert(1);
listitem.Caption:=f[0,0];
listitem.SubItems.Add('');
listitem.SubItems.add(f[0,2]);
wfile.Items[1].ImageIndex:=imagelist2.Count-1 ;
wfile.Items[0].ImageIndex:=imagelist2.Count-1;
end
else
begin
if searchrec.Name<>'..' then
begin
f[0,0]:=searchrec.Name;
f[0,1]:=inttostr(searchrec.Size);
f[0,2]:=datetimetostr(filedatetodatetime(searchrec.Time ));
listitem:=listfile.wfile.Items.Add; //创建
listitem.Caption:=f[0,0];
listitem.SubItems.Add(f[0,1]);
listitem.SubItems.Add(f[0,2]);
shgetfileinfo(pchar(dirname+'\'+searchrec.Name ),0,fileinfo,sizeof(fileinfo),shgfi_icon);
listfile.image1.Picture.Icon.Handle:=fileinfo.hIcon;////返回文件图标
listfile.ImageList2.AddIcon(listfile.image1.Picture.Icon);
wfile.Items[wfile.Items.Count-1].ImageIndex:=imagelist2.Count -1;
end;
end;
end;
end;
findclose(searchrec); //释放内存
end;
//////////////以上是查找文件的过程
procedure SelectNode(const Tx: string; Tree: TTreeView);
var www:Boolean;
begin
if Tx = '' then exit;
node3:=tree.Items.GetFirstNode;
while node3<>nil do
begin
if pathname+'\'+node3.Text = tx then
begin //选中的是目录则打开目录
node3.Expanded:=true;
www:=true;
break;
end
else
begin
try
node3:=node3.GetNext;
except
showmessage(tx);
shellexecute(listfile.handle,nil,pchar(tx ),nil,nil,sw_shownormal);
end;
end;
end;
if www=false then
shellexecute(listfile.handle,nil,pchar(tx ),
nil,nil,sw_shownormal);
end;
//以上是一个过程，处理鼠标在listviewh 双击事件过程
//在树中查找
procedure Tlistfile.FormCreate(Sender: TObject);
var
fname:string;
node:ttreenode;
rnode:ttreenode;
begin
dragacceptfiles(handle,true);
application.Title:='文件管理模拟系统';
node:=dir.Items.AddChild(nil,'MFD');
rnode:=dir.Items.AddChild(node,'');
rnode.ImageIndex:=0;
fname:='MFD';
f[0,0]:=fname;
listitem:=wfile.Items.Add;
listitem.Caption:=f[0,0];
listitem.SubItems.Add(f[0,1]);
end;
procedure TListFile.N7Click(Sender: TObject);
begin
mkdir(pathname+'\'+'新建文件夹');
if IOResult<>0 then
MessageDlg('请检查是否重名', mtWarning, [mbOk], 0)
else
begin
listitem:=wfile.Items.Add;
listitem.Caption:='新建文件夹';
listitem.ImageIndex:=0;
filedir(pathname,dir.Selected);
end;
end;///////在wfile上新建文件夹时.
procedure TListFile.N2Click(Sender: TObject);
var node:ttreenode;
s:string;i:integer;
begin
i:=pos(dir.Selected.Text,pathname);
s:=pathname;
delete(s,i,length(dir.Selected.Text ));
//showmessage(s+'新建文件夹');
mkdir(s+'新建文件夹');
node:=dir.Items.AddChild(dir.Selected.Parent,'新建文件夹');
node.ImageIndex:=1;
node.SelectedIndex:=1;
node.EditText;
end;/////////点击新建文件夹时。
procedure TListFile.N3Click(Sender: TObject);
begin
dir.Selected.EditText;
end;
procedure TListFile.N5Click(Sender: TObject);
begin
if deletefile(pathname+'\'+wfile.Selected.Caption) then
begin
filedir(pathname,dir.Selected);
zt.Panels[0].Text:='删除成功';
end
else
begin
zt.Panels[0].Text:='删除不成功';
end;
end;////处理在listview上删除一个对象是删除个文件
procedure TListFile.dirExpanded(Sender: TObject; Node: TTreeNode);
begin
panel(node);
names:=filename; //相对路进名
if filename<>'' then
begin
filedir(filename+node.Text ,node);
pathname:=filename+node.Text;
end
else
begin
filedir(node.Text ,node);
pathname:=node.Text;
end;
filename:='';
end;
procedure TListFile.wfileDblClick(Sender: TObject);
var
i:integer;
begin
try
if (wfile.ItemIndex=0) and (wfile.Selected.Caption<>'MFD') then //返回上级目录
begin
dir.Selected.Collapse(true);
//node3.Expanded:=true;
dir.Selected.Parent.Selected:=true;
dir.OnClick(dir.Selected.Parent);
end
else
SelectNode(pathname+'\'+wfile.Selected.Caption,dir); //打开目录，或文件
except
exit;
end;
//shellexecute(handle,nil,pchar(pathname+'\'+wfile.Selected.Caption ),
//nil,nil,sw_shownormal)
end;
/////////鼠标在listview上双击时
procedure TListFile.dirClick(Sender: TObject);
begin
zt.Panels[0].Text:='';
panel(dir.Selected);
names:=filename;
if filename<>'' then
begin
filedir(filename+dir.Selected.Text,dir.Selected);
pathname:=filename+dir.Selected.Text;
end
else
begin
filedir(dir.Selected.Text ,dir.Selected);
pathname:=dir.Selected.Text;
end;
filename:='';
end;
/////在treeview上单击时
procedure TListFile.dirEdited(Sender: TObject; Node: TTreeNode;
var S: String);
begin
if RenameFile(pathname, names+s) then
zt.Panels[0].Text:='更名成功'
else
zt.Panels[0].Text:='更名不成功';
end;
//////在treeview上改名是更改对应的目录名
procedure TListFile.wfileEdited(Sender: TObject; Item: TListItem;
var S: String);
begin
if movefile(pchar(pathname+'\'+wfile.Selected.Caption),pchar(pathname+'\'+s)) then
zt.Panels[0].Text:='更名成功'
else
zt.Panels[0].Text:='更名不成功';
end;///////更改文件的文件名的事件
procedure TListFile.dirKeyUp(Sender: TObject; var Key: Word;
Shift: TShiftState);
Var
T:TSHFileOpStruct;
P:String;
begin
if key=46 then
begin
With T do
Begin
Wnd:=0;
wFunc:=FO_DELETE;
pFrom:=Pchar(pathname);
pTo:=nil;
fFlags:=FOF_ALLOWUNDO+FOF_NOCONFIRMATION+FOF_NOERRORUI;//标志表明允许恢复，无须确认并不显示出错信息
hNameMappings:=nil;
lpszProgressTitle:='正在删除文件夹...';
fAnyOperationsAborted:=False;
End;
if SHFileOperation(T)=0 then
begin
zt.Panels[0].Text:='删除完毕';
dir.Selected.Delete;
end
else
zt.Panels[0].Text:='删除不成功';
end;
end;//////删除节点时同时删除对应的目录,用户按了键盘上的[Delete]键.
procedure TListFile.N1Click(Sender: TObject);
var key: word;Shift: TShiftState;
begin
if dir.Selected.Text='MFD' then
begin
showmessage('不可删除根目录');
exit;
end
else
begin
key:=46;
dir.OnKeyUp(sender,key,shift);
end;
end;////点击tpopupmemu1的删除时。
//end;
/////////////以上是窗体加载时的事件
procedure TListFile.dirCollapsed(Sender: TObject; Node: TTreeNode);
var I:integer;
begin
for i:=node.Count -1 downto 1 do
begin
node.Item [i].Delete ;
end;
end;
////////当treeview收缩时的事件
procedure TListFile.N6Click(Sender: TObject);
var f:textfile;
begin
assignfile(f,pathname+'\'+'新建文件.txt');
rewrite(f);
closefile(f);
listitem:=wfile.Items.Add;
listitem.Caption:='新建文件.txt';
listitem.EditCaption;
filedir(pathname,dir.Selected);
end;////新建文件时。
procedure TListFile.N9Click(Sender: TObject);
begin
wfile.ViewStyle:=vsIcon;
end;
procedure TListFile.l1Click(Sender: TObject);
begin
wfile.ViewStyle:=vslist;
end;
procedure TListFile.N10Click(Sender: TObject);
begin
wfile.ViewStyle:=vsSmallIcon;
end;
procedure TListFile.N11Click(Sender: TObject);
begin
wfile.ViewStyle:=vsReport;
end;
procedure TListFile.N8Click(Sender: TObject);
begin
wfile.Selected.EditCaption;
dir.Refresh;
end;
procedure TListFile.N12Click(Sender: TObject);
begin
if removedir(pathname+'\'+wfile.Selected.Caption) then
begin
filedir(pathname,dir.Selected);
dir.Selected:=dir.Selected.Parent;
zt.Panels[0].Text:='删除成功';
end
else
begin
showmessage('文件夹非空不可删除');
zt.Panels[0].Text:='删除不成功';
end;
end;////处理在listview上删除一个对象是删除个文件
procedure TListFile.N13Click(Sender: TObject);
var
searchrec:tsearchrec;
path:string;
begin
Application.CreateForm(TFormArr, FormArr);
if findfirst(pathname+'\'+wfile.Selected.Caption,faAnyFile,searchrec)=0 then
begin
FormArr.Label2.Caption:=inttostr(searchrec.Size)+'b';
shgetfileinfo(pchar(pathname+'\'+searchrec.Name ),0,fileinfo,sizeof(fileinfo),shgfi_icon);
formarr.image1.Picture.Icon.Handle:=fileinfo.hIcon;////返回文件图标
formarr.Label4.Caption:=datetimetostr(filedatetodatetime(searchrec.Time));
formarr.Edit1.text:=searchrec.Name;
formarr.label6.caption:=getcurrentdir()+'\'+pathname;
//showmessage(inttostr(searchrec.Attr));
if ((SearchRec.Attr=33)or (searchrec.Attr =3)or
(searchrec.Attr =1)or (searchrec.Attr =19)
or (searchrec.Attr =17)or (searchrec.Attr =51)) then formarr.CheckBox1.Checked:=true; //readonly
if ((SearchRec.Attr=32)or (searchrec.Attr =33)or
(searchrec.Attr =34)or (searchrec.Attr =48)
or (searchrec.Attr =49)or (searchrec.Attr =51)) then formarr.CheckBox2.Checked:=true; //archive 18
if ((SearchRec.Attr=16)or (searchrec.Attr =17)or
(searchrec.Attr =18)or (searchrec.Attr =22)
or (searchrec.Attr =49)or (searchrec.Attr =48)) then formarr.CheckBox3.Checked:=true; //dir
if ((SearchRec.Attr=2)or (searchrec.Attr =3)or
(searchrec.Attr =18)or (searchrec.Attr =34)
or (searchrec.Attr =19)or (searchrec.Attr =51)) then formarr.CheckBox4.Checked:=true; //hide
end;
findclose(searchrec);
FormArr.ShowModal;
end;
end.
⌨️ 快捷键说明
复制代码
Ctrl + C
搜索代码
Ctrl + F
全屏模式
F11
切换主题
Ctrl + Shift + D
显示快捷键
?
增大字号
Ctrl + =
减小字号
Ctrl + -