dropfile.pas

来自「Drag files and Drop to delphi forms 0402」· PAS 代码 · 共 707 行 · 第 1/2 页

unit DropFile;

interface

{$include DragDrop.inc}

uses
  DragDrop,
  DropTarget,
  DropSource,
  DragDropFile,
  ImgList,
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Buttons, ExtCtrls, FileCtrl, Outline, DirOutln, CommCtrl,
  ComCtrls, Grids, ActiveX, ShlObj, ComObj, Menus;

type
  // This thread is used to watch for and display changes in
  // DirectoryOutline.directory
  TDirectoryThread = class(TThread)
  private
    FListView: TListView;
    FDirectory: string;
    FWakeupEvent: THandle; //Used to signal change of directory or terminating
    FFiles: TStrings;
  protected
    procedure ScanDirectory;
    procedure UpdateListView;
    procedure SetDirectory(Value: string);
    procedure ProcessFilenameChanges(fcHandle: THandle);
  public
    constructor Create(ListView: TListView; Dir: string);
    procedure Execute; override;
    destructor Destroy; override;
    procedure WakeUp;
    property Directory: string read FDirectory write SetDirectory;
  end;

  TFormFile = class(TForm)
    DriveComboBox: TDriveComboBox;
    DirectoryOutline: TDirectoryOutline;
    Memo1: TMemo;
    ListView1: TListView;
    btnClose: TButton;
    StatusBar1: TStatusBar;
    DropFileTarget1: TDropFileTarget;
    Panel1: TPanel;
    DropSource1: TDropFileSource;
    ImageListMultiFile: TImageList;
    DropDummy1: TDropDummy;
    PopupMenu1: TPopupMenu;
    MenuCopy: TMenuItem;
    MenuCut: TMenuItem;
    N1: TMenuItem;
    MenuPaste: TMenuItem;
    ImageListSingleFile: TImageList;
    procedure DriveComboBoxChange(Sender: TObject);
    procedure DirectoryOutlineChange(Sender: TObject);
    procedure btnCloseClick(Sender: TObject);
    procedure MenuCutOrCopyClick(Sender: TObject);
    procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure DropSource1Feedback(Sender: TObject; Effect: Integer;
      var UseDefaultCursors: Boolean);
    procedure DropFileTarget1Enter(Sender: TObject;
      ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
    procedure DropFileTarget1Drop(Sender: TObject; ShiftState: TShiftState;
      Point: TPoint; var Effect: Integer);
    procedure DropFileTarget1GetDropEffect(Sender: TObject;
      ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
    procedure PopupMenu1Popup(Sender: TObject);
    procedure MenuPasteClick(Sender: TObject);
    procedure DropSource1Paste(Sender: TObject; Action: TDragResult;
      DeleteOnPaste: Boolean);
    procedure DropSource1AfterDrop(Sender: TObject;
      DragResult: TDragResult; Optimized: Boolean);
    procedure ListView1CustomDrawItem(Sender: TCustomListView;
      Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
  private
    SourcePath: string;
    IsEXEfile: boolean;
    DirectoryThread: TDirectoryThread;
  public
  end;

var
  FormFile: TFormFile;

implementation

{$R *.DFM}

// CUSTOM CURSORS:
// The cursors in DropCursors.res are exactly the same as the default cursors.
// Use DropCursors.res as a template if you wish to customise your own cursors.
// For this demo we've created Cursors.res - some coloured cursors.
{$R Cursors.res}
const
  crCopy = 101;
  crMove = 102;
  crLink = 103;
  crCopyScroll = 104;
  crMoveScroll = 105;
  crLinkScroll = 106;

//----------------------------------------------------------------------------
// Miscellaneous utility functions
//----------------------------------------------------------------------------

function AddSlash(path: string): string;
begin
  if (path = '') or (path[length(path)]='\') then
    Result := path
  else
    Result := path +'\';
end;

procedure CreateLink(SourceFile, ShortCutName: String);
var
  IUnk: IUnknown;
  ShellLink: IShellLink;
  IPFile: IPersistFile;
  tmpShortCutName: string;
  WideStr: WideString;
  i: integer;
begin
  IUnk := CreateComObject(CLSID_ShellLink);
  ShellLink := IUnk as IShellLink;
  IPFile  := IUnk as IPersistFile;
  with ShellLink do
  begin
    SetPath(PChar(SourceFile));
    SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));
  end;
  ShortCutName := ChangeFileExt(ShortCutName,'.lnk');
  if FileExists(ShortCutName) then
  begin
    ShortCutName := copy(ShortCutName, 1, length(ShortCutName)-4);
    i := 1;
    repeat
      tmpShortCutName := ShortCutName +'(' + inttostr(i)+ ').lnk';
      inc(i);
    until not FileExists(tmpShortCutName);
    WideStr := tmpShortCutName;
  end
  else WideStr := ShortCutName;
  IPFile.Save(PWChar(WideStr), False);
end;

//----------------------------------------------------------------------------
// TFormFile methods
//----------------------------------------------------------------------------

procedure TFormFile.FormCreate(Sender: TObject);
begin
  // Load custom cursors...
  Screen.cursors[crCopy] := LoadCursor(hinstance, 'CUR_DRAG_COPY');
  Screen.cursors[crMove] := LoadCursor(hinstance, 'CUR_DRAG_MOVE');
  Screen.cursors[crLink] := LoadCursor(hinstance, 'CUR_DRAG_LINK');
  Screen.cursors[crCopyScroll] := LoadCursor(hinstance, 'CUR_DRAG_COPY_SCROLL');
  Screen.cursors[crMoveScroll] := LoadCursor(hinstance, 'CUR_DRAG_MOVE_SCROLL');
  Screen.cursors[crLinkScroll] := LoadCursor(hinstance, 'CUR_DRAG_LINK_SCROLL');
end;

procedure TFormFile.FormDestroy(Sender: TObject);
begin
  if (DirectoryThread <> nil) then
  begin
    DirectoryThread.Terminate;
    DirectoryThread.WakeUp;
    DirectoryThread.WaitFor;
    DirectoryThread.Free;
  end;
end;

procedure TFormFile.btnCloseClick(Sender: TObject);
begin
  Close;
end;

procedure TFormFile.DriveComboBoxChange(Sender: TObject);
begin
  // Manual synchronization to work around bug in TDirectoryOutline.
  DirectoryOutline.Drive := DriveComboBox.Drive;
end;

procedure TFormFile.DirectoryOutlineChange(Sender: TObject);
begin
  if (DirectoryThread = nil) then
    DirectoryThread := TDirectoryThread.Create(ListView1, DirectoryOutline.Directory)
  else
    DirectoryThread.Directory := DirectoryOutline.Directory;
end;

procedure TFormFile.ListView1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
  i: integer;
  Filename: string;
  Res: TDragResult;
  p: TPoint;
begin
  // If no files selected then exit...
  if ListView1.SelCount = 0 then
    Exit;

  // Wait for user to move cursor before we start the drag/drop.
  if (DragDetectPlus(TWinControl(Sender))) then
  begin
    Statusbar1.SimpleText := '';
    DropSource1.Files.Clear;
    // DropSource1.MappedNames.Clear;

    // Fill DropSource1.Files with selected files in ListView1
    for i := 0 to Listview1.Items.Count-1 do
      if (Listview1.Items[i].Selected) then
      begin
        Filename :=
          AddSlash(DirectoryOutline.Directory)+Listview1.Items[i].Caption;
        DropSource1.Files.Add(Filename);
        // The TDropFileSource.MappedNames list can be used to indicate to the
        // drop target, that the files should be renamed once they have been
        // copied. This is the technique used when dragging files from the
        // recycle bin.
        // DropSource1.MappedNames.Add('NewFileName'+inttostr(i+1));
      end;

    // Select an appropriate drag image.
    // If only one file has been selected, create a dynamic drag image based on
    // the list view selection, otherwise use a static drag image.
    if (ListView1.SelCount = 1) then
    begin
      ImageListSingleFile.Handle := ListView_CreateDragImage(ListView1.Handle,
        ListView1.Selected.Index, p);
      DropSource1.Images := ImageListSingleFile;
      DropSource1.ImageHotSpotX := X-ListView1.Selected.Left;
      DropSource1.ImageHotSpotY := Y-ListView1.Selected.Top;
    end else
    begin
      DropSource1.Images := ImageListMultiFile;
      DropSource1.ImageHotSpotX := 16;
      DropSource1.ImageHotSpotY := 16;
    end;


    // Temporarily disable the list view as a drop target so we don't drop on
    // ourself.
    DropFileTarget1.Dragtypes := [];
    try

      // OK, now we are all set to go. Let's start the drag...
      Res := DropSource1.Execute;

    finally
      // Enable the list view as a drop target again.
      DropFileTarget1.Dragtypes := [dtCopy,dtMove,dtLink];
    end;

    // Note:
    // The target is responsible, from this point on, for the
    // copying/moving/linking of the file but the target feeds
    // back to the source what (should have) happened via the
    // returned value of Execute.

    // Feedback in Statusbar1 what happened...
    case Res of
      drDropCopy: StatusBar1.SimpleText := 'Copied successfully';
      drDropMove: StatusBar1.SimpleText := 'Moved successfully';
      drDropLink: StatusBar1.SimpleText := 'Linked successfully';
      drCancel: StatusBar1.SimpleText := 'Drop was cancelled';
      drOutMemory: StatusBar1.SimpleText := 'Drop cancelled - out of memory';
    else
      StatusBar1.SimpleText := 'Drop cancelled - unknown reason';
    end;

  end;
end;

procedure TFormFile.ListView1CustomDrawItem(Sender: TCustomListView;
  Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
begin
  // Items which have been "cut to clipboard" are drawn differently.
  if boolean(Item.Data) then
    Sender.Canvas.Font.Style := [fsStrikeOut];
end;

procedure TFormFile.PopupMenu1Popup(Sender: TObject);
begin
  MenuCopy.Enabled := (Listview1.SelCount > 0);
  MenuCut.Enabled := MenuCopy.Enabled;

  // Enable paste menu if the clipboard contains data in any of
  // the supported formats
  MenuPaste.Enabled := DropFileTarget1.CanPasteFromClipboard;
end;

// Demonstrates CopyToClipboard and CutToClipboard methods.
procedure TFormFile.MenuCutOrCopyClick(Sender: TObject);
var
  i: integer;
  Filename: string;
  Status: boolean;
  Operation: string;
begin
  if Listview1.SelCount = 0 then
  begin
    StatusBar1.SimpleText := 'No files have been selected!';
    exit;
  end;

  DropSource1.Files.clear;
  for i := 0 to Listview1.Items.Count-1 do
    if (Listview1.Items[i].Selected) then
    begin
      Filename :=
        AddSlash(DirectoryOutline.Directory)+Listview1.Items[i].Caption;
      DropSource1.Files.Add(Filename);

      // Flag item as "cut" so it can be drawn differently.
      if (Sender = MenuCut) then
        Listview1.items.Item[i].Data := pointer(True)
      else
        Listview1.items.Item[i].Data := pointer(False);
    end else
      Listview1.items.Item[i].Data := pointer(False);

  Listview1.Invalidate;

  // Transfer data to clipboard.
  if (Sender = MenuCopy) then
  begin
    Status := DropSource1.CopyToClipboard;
    Operation := 'copied';
  end else
  if (Sender = MenuCut) then
  begin
    Status := DropSource1.CutToClipboard;
    Operation := 'cut';
  end else
    Status := False;

  if (Status) then
    StatusBar1.SimpleText :=
      Format('%d file(s) %s to clipboard.',[DropSource1.Files.Count, Operation]);
end;

procedure TFormFile.MenuPasteClick(Sender: TObject);
begin
  // PasteFromClipboard fires an OnDrop event, so we don't need to do
  // anything special here.
  DropFileTarget1.PasteFromClipboard;
end;