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 + -
显示快捷键?