del2copyfrm.~pas

关于利用DELPHI来进行企业级方案解决的著作的附书源码

unit Del2CopyFrm;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, StdCtrls, Buttons, ComCtrls, ShellCtrls, ShellAPI;

type
  TMainForm = class(TForm)
    ShellTreeView1: TShellTreeView;
    BitBtn1: TBitBtn;
    PopupMenu1: TPopupMenu;
    CopyItem: TMenuItem;
    DelItem: TMenuItem;
    procedure CopyItemClick(Sender: TObject);
    procedure DelItemClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  MainForm: TMainForm;

implementation

{$R *.dfm}

procedure TMainForm.CopyItemClick(Sender: TObject);
var
 FromDir,ToDir : String;
 SHFileOPStruct : TSHFileOPStruct;
begin
 if CopyItem.Caption='复制到' then
   begin
    FromDir:= ShellTreeView1.Path;
    Delete(FromDir,Length(FromDir)-1,1);
    ShowMessage('请选择目的文件夹');
    CopyItem.Caption:='粘贴';
   end
  else
    if FromDir<>'' then
     begin
      ToDir:= ShellTreeView1.Path;
      Delete(ToDir,Length(ToDir)-1,1);
      CopyItem.Caption:='复制到';
      with SHFILEOPSTRUCT do
       begin
        Wnd:= Handle;
        WFunc:= FO_COPY;
        pFrom:= PChar(FromDir);
        pTo:= PChar(ToDir);
        fFlags:= FOF_NOCONFIRMMKDIR or FOF_RENAMEONCOLLISION;
        fAnyOperationsAborted:= False;
       end;
       SHFileOperation(SHFileOPStruct);
     end;
end;

procedure TMainForm.DelItemClick(Sender: TObject);
var
 Dir : String;
 SHFileOPStruct : TSHFileOPStruct;
 Confirm: Word;
begin
 Dir:= ShellTreeView1.Path;
 Delete(Dir,Length(Dir)-1,1);
 Confirm:=MessageDlg('你确认删除文件夹'+ Dir +'吗？',mtWarning,[mbYes,mbNo],0);
 if confirm = mrYes then
  begin
   with SHFILEOPSTRUCT do
    begin
     Wnd:= MainForm.Handle;
     WFunc:= FO_DELETE;
     pFrom:= PChar(Dir);
     fFlags:= FOF_ALLOWUNDO;
    end;
    SHFileOperation(SHFileOPStruct);
  end;
end;

end.