u_mainform.~pas

来自「很好地delphi书籍源码」· ~PAS 代码 · 共 523 行

unit U_MainForm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Menus, ImgList, ComCtrls, ExtCtrls, StdCtrls, FileCtrl, ToolWin,ShellAPI;

type
  TCommandState=(csCopy,csCut,csNone);
  TMainForm = class(TForm)
    Splitter1: TSplitter;
    ToolBar1: TToolBar;
    Drive1: TDriveComboBox;
    ToolButton1: TToolButton;
    UpDirTB: TToolButton;
    ReFreshTB: TToolButton;
    ToolButton15: TToolButton;
    SmallIconTB: TToolButton;
    ListTB: TToolButton;
    IconTB: TToolButton;
    ReportTB: TToolButton;
    ToolButton6: TToolButton;
    DeleteFileTB: TToolButton;
    CopyFileTB: TToolButton;
    CutFileTB: TToolButton;
    SaveFileTB: TToolButton;
    ToolButton10: TToolButton;
    HelpTB: TToolButton;
    TreeViewPanel: TPanel;
    DirPanel: TPanel;
    TreeView1: TTreeView;
    ListViewPanel: TPanel;
    FilePanel: TPanel;
    ListView1: TListView;
    MainMenu1: TMainMenu;
    FileMenu: TMenuItem;
    OpenMenu: TMenuItem;
    ExitMenu: TMenuItem;
    EditMenu: TMenuItem;
    CutMenu: TMenuItem;
    CopyMenu: TMenuItem;
    PasteMenu: TMenuItem;
    DelMenu: TMenuItem;
    ViewMenu: TMenuItem;
    IconMenu: TMenuItem;
    SmallIconMenu: TMenuItem;
    ListMenu: TMenuItem;
    ReportMenu: TMenuItem;
    HelpMenu: TMenuItem;
    MenuImageList: TImageList;
    ListViewImageList: TImageList;
    PopupMenu1: TPopupMenu;
    O2: TMenuItem;
    N10: TMenuItem;
    PMenuCut: TMenuItem;
    PMenuCopy: TMenuItem;
    PMenuPaste: TMenuItem;
    PMenuDel: TMenuItem;
    N7: TMenuItem;
    PMenuAttr: TMenuItem;
    CreateDirMenu: TMenuItem;
    N1: TMenuItem;
    TreeImageList: TImageList;
    procedure FormCreate(Sender: TObject);
    procedure TreeView1Click(Sender: TObject);
    procedure Drive1Change(Sender: TObject);
    procedure ListView1DblClick(Sender: TObject);
    procedure UpDirTBClick(Sender: TObject);
    procedure TreeView1Change(Sender: TObject; Node: TTreeNode);
    procedure ReFreshTBClick(Sender: TObject);
    procedure DeleteFileTBClick(Sender: TObject);
    procedure CopyFileTBClick(Sender: TObject);
    procedure CutFileTBClick(Sender: TObject);
    procedure SaveFileTBClick(Sender: TObject);
    procedure PMenuAttrClick(Sender: TObject);
    procedure CreateDirMenuClick(Sender: TObject);
    procedure ShowToolButton(Sender: TObject);
  private
    { Private declarations }
    ComState:TCommandState;
    CurrentDir,TargetFile,TargetFN,RenameFN:String;
    procedure  UpdateTreeView;
    procedure  AddDirectory(path:String;fNode:TTreeNode);
    procedure  UpdateListView;
    procedure  ListViewAddDirectory;
    procedure  ListViewAddFile;
  public
     { Public declarations }
  end;

var
  MainForm: TMainForm;
const
  DriveCode:array[0..24] of string=
  ('A:','C:','D:','E:','F:','G:','H:','I:','J:','K:','L:','M:',
   'N:','O:','P:','Q:','R:','S:','T:','U:','V:','W:','X:','Y:','Z:');

implementation

uses AttrUnit,U_AttrForm;

{$R *.DFM}

procedure TMainForm.FormCreate(Sender: TObject);
begin
  CurrentDir:=GetCurrentDir;
  UpdateTreeView;
  UpdateListView;
  ComState:=csNone;
end;

procedure TMainForm.UpdateTreeView ;
var
   i:Integer;
   rNode,mNode:TTreeNode;
begin
   TreeView1.Items.Clear;
   rNode:=TreeView1.Items.Add(nil,'我的电脑');
   rNode.ImageIndex:=0;
   rNode.SelectedIndex:=0;
   for i:=0 to Drive1.Items.Count-1 do
   begin
    mNode:=TreeView1.Items.AddChild(rNode,DriveCode[i]);
                mNode.ImageIndex:=1;
                mNode.SelectedIndex:=1;
                AddDirectory(DriveCode[i],mNode); //在该子结点上加目录
   end;
end;

procedure TMainForm.AddDirectory(path:String;fNode:TTreeNode);
var
  sr:TSearchRec ;
  mNode:TTreeNode;
begin
 if FindFirst(path+'\*.*',faDirectory,sr)=0 then
  begin
    if (sr.Attr=faDirectory)and(sr.Name<>'.')and (sr.Name<>'..') then
    begin
        mNode:=TreeView1.Items.AddChild(fNode,sr.Name);
        mNode.ImageIndex:=2;
        mNode.SelectedIndex:=2;
        AddDirectory(path+sr.Name,mNode);
    end;
  while (FindNext(sr)=0)do
   begin
     if (sr.Attr=faDirectory)and(sr.Name<>'.')and(sr.Name<>'..') then
     begin
         mNode:=TreeView1.Items.AddChild(fNode,sr.Name);
         mNode.ImageIndex:=2;
         mNode.SelectedIndex:=2;
        AddDirectory(path+'\'+sr.Name,mNode);
      end;
   end;
   FindClose(sr);
 end;
end;

procedure TMainForm.UpdateListView;
begin
  ListView1.Items.Clear;
  ListViewAddDirectory;
  ListViewAddFile;
end;

procedure TMainForm.ListViewAddDirectory;
var
 mItem:TListItem;
 sr:   TSearchRec;
begin
  if FindFirst(CurrentDir+'\*.*',faDirectory,sr)=0 then
  begin
    if (sr.Attr=faDirectory)and(sr.Name<>'.')and(sr.Name<>'..')then
    begin
      mItem:=ListView1.Items.Add;
      mItem.Caption:=sr.Name;
      mItem.ImageIndex:=0;
      mItem.SubItems.Add('');
      mItem.SubItems.Add('文件目录');
      mItem.SubItems.Add('');
    end;
  end;
  while (FindNext(sr)=0) do
  begin
    if (sr.Attr=faDirectory)and(sr.Name<>'.')and(sr.Name<>'..')then
    begin
      mItem:=ListView1.Items.Add();
      mItem.Caption:=sr.Name;
      mItem.ImageIndex:=0;
      mItem.SubItems.Add('');
      mItem.SubItems.Add('文件目录');
      mItem.SubItems.Add('');
     end;
   end;
 FindClose(sr);
end;

procedure TMainForm.ListViewAddFile;
var
  Size:DWord;
  mItem:TListItem;
  sr   :TSearchRec;
  Fileext :String ;
begin
  if FindFirst(CurrentDir+'\*.*',0,sr)=0 then
  begin
    if sr.Attr<>faDirectory then
    begin
      fileext:=LowerCase(ExtractFileExt(sr.Name));
      Size:=sr.Size div 1024;
      if (fileext='.exe') then
      begin
        mItem:=ListView1.Items.Add();
        mItem.Caption:=sr.Name;
        mItem.ImageIndex:=3;
        mItem.SubItems.Add(IntToStr(Size)+' KB');
        mItem.SubItems.Add('应用程序文件');
        mItem.SubItems.Add('');
      end else if(fileext='.txt')or(fileext='.doc')then
      begin
         mItem:=ListView1.Items.Add();
         mItem.Caption:=sr.Name;
         mItem.ImageIndex:=3;
         mItem.SubItems.Add(IntToStr(Size)+' KB');
         mItem.SubItems.Add('文档文件');
         mItem.SubItems.Add('');
      end else if(fileext='.bmp')or(fileext='.jpg')or(fileext='.gif')then
      begin
         mItem:=ListView1.Items.Add();
         mItem.Caption:=sr.Name;
         mItem.ImageIndex:=4;
         mItem.SubItems.Add(IntToStr(Size)+' KB');
         mItem.SubItems.Add('图像文件');
         mItem.SubItems.Add('');
       end else
       begin
         mItem:=ListView1.Items.Add();
         mItem.Caption:=sr.Name;
         mItem.ImageIndex:=1;
         mItem.SubItems.Add(IntToStr(Size)+' KB');
         mItem.SubItems.Add(fileext+' 文件');
         mItem.SubItems.Add('');
       end;
   end;
  while FindNext(sr)=0 do
  begin
    if (sr.Attr<>faDirectory)then
    begin
      fileext:=LowerCase(ExtractFileExt(sr.Name));
      Size:=sr.Size div 1024;
      if (fileext='.exe') then
      begin
        mItem:=ListView1.Items.Add();
        mItem.Caption:=sr.Name;
        mItem.ImageIndex:=3;
        mItem.SubItems.Add(IntToStr(Size)+' KB');
        mItem.SubItems.Add('应用程序文件');
        mItem.SubItems.Add('');
       end
       else if(fileext='.txt')or(fileext='.doc')then
       begin
         mItem:=ListView1.Items.Add();
         mItem.Caption:=sr.Name;
         mItem.ImageIndex:=2;
         mItem.SubItems.Add(IntToStr(Size)+' KB');
         mItem.SubItems.Add('文档文件');
         mItem.SubItems.Add('');
       end
       else if(fileext='.bmp')or(fileext='.jpg')or(fileext='.gif')then
       begin
         mItem:=ListView1.Items.Add();
         mItem.Caption:=sr.Name;
         mItem.ImageIndex:=4;
         mItem.SubItems.Add(IntToStr(Size)+' KB');
         mItem.SubItems.Add('图像文件');
         mItem.SubItems.Add('');
       end else
       begin
         mItem:=ListView1.Items.Add();
         mItem.Caption:=sr.Name;
         mItem.ImageIndex:=1;
         mItem.SubItems.Add(IntToStr(Size)+' KB');
         mItem.SubItems.Add(fileext+' 文件');
         mItem.SubItems.Add('');
       end;
     end;
    end;
  end;
  FindClose(sr);
end;

procedure TMainForm.TreeView1Click(Sender: TObject);
var
  dir: string;
  dName:array[0..19] of string;
  i,j:Integer;
  mNode:TTreeNode;
begin
  i:=0;
  mNode:=TreeView1.Selected;
  if mNode=nil then  exit;
  if (mNode.Text<>'我的电脑')then
  begin
    repeat
      dName[i]:=mNode.Text;
      mNode:=mNode.Parent;
      i:=i+1;
    until (mNode.Text='我的电脑');
    dir:=dName[i-1];
    for j:=i-2 downto 0 do
      dir:=dir+'\'+dName[j];
    CurrentDir:=dir;
  end;
  UpdateListView;
end;

procedure TMainForm.Drive1Change(Sender: TObject);
begin
  if Drive1.ItemIndex=1 then exit;
  CurrentDir:=Drive1.Drive+':';
  UpdateListView;
end;

procedure TMainForm.ListView1DblClick(Sender: TObject);
var
  FileStr:string;
begin
  if (ListView1.SelCount=1) then
  begin
    if (ListView1.Selected.ImageIndex=1) then
    begin
      CurrentDir:=CurrentDir+'\'+ListView1.Selected.Caption;
      UpdateListView;
    end else
    begin
      FileStr:=CurrentDir+'\'+ListView1.Selected.Caption;
      ShellExecute(Handle,'open',Pchar(FileStr),nil,nil,SW_SHOWNORMAL);
    end;
  end;
end;

procedure TMainForm.UpDirTBClick(Sender: TObject);
var
  i: integer;
  Dir:string;
begin
  i:=Length(CurrentDir);
  while (i>0) do
  begin
    if (CurrentDir[i]='\') then
    begin
      Dir:=Copy(CurrentDir,1,i-1);
      CurrentDir:=Dir;
      UpdateListView;
      break;
    end;
    i:=i-1;
  end;
end;

procedure TMainForm.TreeView1Change(Sender: TObject; Node: TTreeNode);
var
 i:integer;
begin
  if  TreeView1.Selected.Text='A:' then
    Drive1.ItemIndex:=0;
  for i:=1 to Drive1.Items.Count-1 do
  if  TreeView1.Selected.Text=DriveCode[i] then
   begin
     Drive1.ItemIndex:=i+1;
     break;
   end;
end;

procedure TMainForm.ReFreshTBClick(Sender: TObject);
begin
  UpdateListView();
end;

procedure TMainForm.CutFileTBClick(Sender: TObject);
begin
  if (ListView1.SelCount=1)then
  begin
   TargetFile:=CurrentDir+'\'+ListView1.Selected.Caption;
   TargetFN:=ListView1.Selected.Caption;
   ComState:=csCut;
  end;
end;

procedure TMainForm.CopyFileTBClick(Sender: TObject);
begin
  if (ListView1.SelCount=1)then
  begin
   TargetFile:=CurrentDir+'\'+ListView1.Selected.Caption;
   TargetFN:=ListView1.Selected.Caption;
   ComState:=csCopy;
  end;
end;

procedure TMainForm.SaveFileTBClick(Sender: TObject);
begin
   if (ComState=csCopy)then
   begin
    if Application.MessageBox('真的要将文件拷贝到当前目录吗','确认',
        MB_OKCANCEL + MB_DEFBUTTON1)=IDOK then
    begin
     CopyFile(PChar(TargetFile),PChar(CurrentDir+'\'+TargetFN),false);
     UpdateListView();
    end;
   end
   else if (ComState=csCut) then
    if Application.MessageBox('真的要将文件移到当前目录吗','确认',
        MB_OKCANCEL + MB_DEFBUTTON1)=IDOK then
     begin
       MoveFile(PChar(TargetFile),PChar(CurrentDir+'\'+TargetFN));
       TargetFile:=CurrentDir+'\'+TargetFN;
       ComState:=csCopy;
       UpdateListView();
     end;
end;

procedure TMainForm.DeleteFileTBClick(Sender: TObject);
var
  FileName:String;
begin
 {$I-}
  if (ListView1.SelCount=1) and (ListView1.Selected.ImageIndex<>1)  then
  begin
      FileName:=CurrentDir+'\'+ListView1.Selected.Caption;
      if Application.MessageBox('真的要删除文件吗','删除确认',
        MB_OKCANCEL + MB_DEFBUTTON1)=IDOK then
      begin
        DeleteFile(FileName);
        UpdateListView();
      end;
  end;
  if (ListView1.SelCount=1) and (ListView1.Selected.ImageIndex=1)  then
  begin
     FileName:=CurrentDir+'\'+ListView1.Selected.Caption;
     if Application.MessageBox('真的要删除选定的目录吗?','删除确认',
        MB_OKCANCEL + MB_DEFBUTTON1)=IDOK then
     begin
        RmDir(FileName);
        if IOResult <> 0 then
        MessageDlg('删除的目录必须为空!', mtWarning, [mbOk], 0);
        UpdateListView();
      end;
  end;
end;


procedure TMainForm.PMenuAttrClick(Sender: TObject);
var
    Attr, NewAttr :Integer;
    FileName: String ;
begin
  if (ListView1.SelCount=1)then
  begin
    FileName:=CurrentDir+'\'+ListView1.Selected.Caption;
    AttrForm.FileDirName.Caption := FileName ;
    AttrForm.FilePathName.Caption := CurrentDir+'\';
    Attr := FileGetAttr(FileName);
    if  Attr and faReadOnly = faReadOnly  then
      AttrForm.ReadOnly.Checked := true;
    if  Attr and faArchive = faArchive  then
      AttrForm.Archive.Checked := true;
    if  Attr and faSysFile =  faSysFile  then
      AttrForm.System.Checked :=  true;
    if  Attr and faHidden = faHidden   then
      AttrForm.Hidden.Checked := true;
    if (AttrForm.ShowModal=IDOK)   then
    begin
       NewAttr := 0;
       if (AttrForm.ReadOnly.Checked)then
         NewAttr := NewAttr or faReadOnly;
       if (AttrForm.Archive.Checked)then
         NewAttr := NewAttr or faArchive;
       if (AttrForm.System.Checked)then
          NewAttr := NewAttr or faSysFile;
       if (AttrForm.Hidden.Checked)then
          NewAttr := NewAttr or faHidden ;
       FileSetAttr(FileName, NewAttr);
    end;
  end;
end;
procedure TMainForm.CreateDirMenuClick(Sender: TObject);
var
  NewDir:string;
  sr:TSearchRec;
begin
  if InputQuery('提示','新建目录名', NewDir) then
  begin
    NewDir:=CurrentDir+'\'+NewDir;
    if FindFirst(NewDir,faDirectory	,sr)<>0 then
    begin
      MkDir(NewDir);
      UpdateListView;
    end;
  end;
end;

procedure TMainForm.ShowToolButton(Sender: TObject);
var
  Choose:byte;
begin
  if (Sender is TToolButton) then
     Choose:=(Sender as TToolButton).Tag
  else if (Sender is TMenuItem) then
     Choose:=(Sender as TMenuItem).Tag;
  case Choose of
    1: ListView1.ViewStyle:=vsIcon;
    2: ListView1.ViewStyle:=vsSmallIcon;
    3: ListView1.ViewStyle:=vsList;
    4: ListView1.ViewStyle:=vsReport;
  end;
  IconMenu.Checked:=ListView1.ViewStyle=vsIcon;
  SmallIconMenu.Checked:=ListView1.ViewStyle=vsSmallIcon;
  ListMenu.Checked:=ListView1.ViewStyle=vsList;
  ReportMenu.Checked:=ListView1.ViewStyle=vsReport;
end;

end.