unit1.pas
来自「用delphi编成的文件管理器」· PAS 代码 · 共 266 行
PAS
266 行
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ExtCtrls, Menus, StdCtrls, FileCtrl, Grids, Outline, DirOutln;
type
TForm1 = class(TForm)
DirectoryOutline1: TDirectoryOutline;
FileListBox1: TFileListBox;
DriveComboBox1: TDriveComboBox;
MainMenu1: TMainMenu;
N1: TMenuItem;
Splitter1: TSplitter;
Splitter2: TSplitter;
N2: TMenuItem;
copy1: TMenuItem;
paste1: TMenuItem;
cut1: TMenuItem;
delete1: TMenuItem;
selectother1: TMenuItem;
open1: TMenuItem;
exit1: TMenuItem;
rename1: TMenuItem;
property1: TMenuItem;
Selectall1: TMenuItem;
procedure FormCreate(Sender: TObject);
procedure DirectoryOutline1Change(Sender: TObject);
procedure DriveComboBox1Change(Sender: TObject);
procedure FileListBox1Change(Sender: TObject);
procedure exit1Click(Sender: TObject);
procedure delete1Click(Sender: TObject);
procedure copy1Click(Sender: TObject);
procedure rename1Click(Sender: TObject);
procedure paste1Click(Sender: TObject);
procedure cut1Click(Sender: TObject);
procedure property1Click(Sender: TObject);
procedure Selectall1Click(Sender: TObject);
procedure selectother1Click(Sender: TObject);
private
{ Private declarations }
dealname:array[0..30] of String;
dealcount:integer;
public
{ Public declarations }
Filename:String;
dealpath:String
end;
var
Form1: TForm1;
implementation
uses Unit2;
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
cut1.Enabled:=false;
copy1.Enabled:=false;
paste1.Enabled:=false;
delete1.Enabled:=false;
rename1.Enabled:=false;
property1.Enabled:=false;
end;
procedure TForm1.DirectoryOutline1Change(Sender: TObject);
begin
FileListBox1.Directory:=DirectoryOutLine1.Directory;
end;
procedure TForm1.DriveComboBox1Change(Sender: TObject);
begin
DirectoryOutline1.Drive:=DriveComboBox1.Drive;
end;
procedure TForm1.FileListBox1Change(Sender: TObject);
begin
if FileName=' ' then
begin
cut1.Enabled:=False;
copy1.Enabled:=False;
paste1.Enabled:=False;
delete1.Enabled:=False;
rename1.Enabled:=False;
property1.Enabled:=False;
end
else
begin
cut1.Enabled:=True;
copy1.Enabled:=True;
paste1.Enabled:=True;
delete1.Enabled:=True;
rename1.Enabled:=True;
property1.Enabled:=True;
end;
if FilelistBox1.SelCount<>1 then
begin
cut1.Enabled:=True;
copy1.Enabled:=True;
paste1.Enabled:=True;
delete1.Enabled:=True;
rename1.Enabled:=True;
property1.Enabled:=True;
end;
end;
procedure TForm1.exit1Click(Sender: TObject);
begin
application.Destroy;
end;
procedure TForm1.delete1Click(Sender: TObject);
var
delFile:String;
begin
delFile:=FilelistBox1.FileName;
if delFile<>' ' then
if MessageDlg('Do you really want to delete '+extractFilename(delFile)+'?',
mtConfirmation,mbYesNoCancel,0)=idYes then
deleteFile(delFile);
FilelistBox1.Update;
end;
procedure TForm1.copy1Click(Sender: TObject);
var
i:integer;
begin
cut1.Checked:=False;
copy1.Checked:=False;
dealcount:=FileListBox1.SelCount;
for i:=0 to (FileListBox1.Items.Count-1)
do
if FileListBox1.Selected[i]=true then
dealname[i]:=FileListBox1.Filename;
end;
procedure TForm1.rename1Click(Sender: TObject);
var
newname:String;
begin
Filename:=extractFilename(FileListBox1.FileName);
if Filename<>' ' then
begin
newname:=InputBox('File Rename','Input the new name for'+Filename,Filename);
if Not renameFile(Filename,newname+extractFileext(Filename)) then
messagedlg('can Not rename'+Filename+'!',mtInformation,[mbOK],0);
end;
FileListBox1.Update;
end;
procedure TForm1.paste1Click(Sender: TObject);
var
F1,F2: TextFile;
S:String;
i:integer;
begin
for i :=0 to dealcount-1 do
if extractFileext(dealname[i])='.txt'then
if Not Fileexists(extractFilename(dealname[i])) then
begin
AssignFile(F1,dealname[i]);
reset(F1);
AssignFile(F2,extractFilename(dealname[i]));
rewrite(F2);
while Not eof(F1)do
begin
Readln(F1,S);
Writeln(F2,S);
end;
closeFile(F1);
closeFile(F2);
end
else
begin
if MessageDlg('There has been a File named'+dealname[i]+'existing.Do you really want to replace it?',
mtConfirmation,mbYesNoCancel,0)=idYes then
begin
if extractFilepath(dealname[i])<>Filelistbox1.Directory
then
begin
deleteFile(extractFilename(dealname[i]));
begin
AssignFile(F1,dealname[i]);
Reset(F1);
AssignFile(F2,extractFilename(dealname[i]));
Rewrite(F2);
While Not eof(F1) do
begin
Readln(F1,S);
Writeln(F2,S);
end;
closeFile(F1);
closeFile(F2);
end
end
else
exit;
end
else
exit;
end;
Filelistbox1.Update;
copy1.checked:=False;
if cut1.Checked=true then
begin
deleteFile(dealname[i]);
cut1.checked:=False;
end;
end;
procedure TForm1.cut1Click(Sender: TObject);
begin
copy1Click(Sender);
cut1.Checked:=True;
copy1.Checked:=false;
end;
procedure TForm1.property1Click(Sender: TObject);
begin
Form2.Caption:='属性';
Form2.Visible:=true;
end;
procedure TForm1.Selectall1Click(Sender: TObject);
var
i:integer;
begin
Filelistbox1.MultiSelect:=true;
Filelistbox1.ExtendedSelect:=true;
for i:=0 to (FileListBox1.Items.Count -1) do
begin
FileListBox1.Selected[i]:=true;
end;
if FileListBox1.SelCount<>1 then
begin
rename1.Enabled:=False;
property1.Enabled:=False;
end;
end;
procedure TForm1.selectother1Click(Sender: TObject);
var
i:integer;
begin
Filelistbox1.MultiSelect:=true;
Filelistbox1.MultiSelect:=true;
for i:=0 to (FileListBox1.Items.Count -1) do
begin
FileListBox1.Selected[i]:=Not FileListBox1.Selected[i];
end;
if FileListBox1.SelCount<>1 then
rename1.Enabled:=False;
property1.Enabled:=False;
end;
end.
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?