...Drag and Drop files from your application to Windows Explorer?

R.Kleinpeter

{This example will show you how your application

will be able to copy files from your application to

Windows Explorer using Drag'n Drop.

Exactly the way it is done by the OS itself!

Create a new application containing just one unit,

called 'Unit1'. Drop a FileListBox and a DirectoryListBox on to the form,

leave their names the way they are.

Connect FileListBox1 with DirectoryListBox1 by setting the FileList-property of

DirectoryListBox1. Make sure that the MultiSelect-property of FileListBox1 is set to 'True'!

The best thing you can do now is to replace all text with the code below:}

//---------------------------------------------

unit Unit1;

interface

uses

 Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,

 Dialogs,

 StdCtrls, FileCtrl, ActiveX, ShlObj, ComObj;

type

 TForm1 = class(TForm, IDropSource)

   FileListBox1: TFileListBox;

   DirectoryListBox1: TDirectoryListBox;

   procedure FileListBox1MouseDown(Sender: TObject; Button:

     TMouseButton;

     Shift: TShiftState; X, Y: Integer);

   procedure FileListBox1MouseMove(Sender: TObject; Shift: TShiftState;

     X,

     Y: Integer);

 private

   FDragStartPos: TPoint;

   function QueryContinueDrag(fEscapePressed: BOOL;

     grfKeyState: Longint): HResult; stdcall;

   function GiveFeedback(dwEffect: Longint): HResult; stdcall;

 public

 end;

var

 Form1: TForm1;

implementation

{$R *.DFM}

function GetFileListDataObject(const Directory: string; Files:

 TStrings):

 IDataObject;

type

 PArrayOfPItemIDList = ^TArrayOfPItemIDList;

 TArrayOfPItemIDList = array[0..0] of PItemIDList;

var

 Malloc: IMalloc;

 Root: IShellFolder;

 FolderPidl: PItemIDList;

 Folder: IShellFolder;

 p: PArrayOfPItemIDList;

 chEaten: ULONG;

 dwAttributes: ULONG;

 FileCount: Integer;

 i: Integer;

begin

 Result := nil;

 if Files.Count = 0 then

   Exit;

 OleCheck(SHGetMalloc(Malloc));

 OleCheck(SHGetDesktopFolder(Root));

 OleCheck(Root.ParseDisplayName(0, nil,

   PWideChar(WideString(Directory)),

   chEaten, FolderPidl, dwAttributes));

 try

   OleCheck(Root.BindToObject(FolderPidl, nil, IShellFolder,

     Pointer(Folder)));

   FileCount := Files.Count;

   p := AllocMem(SizeOf(PItemIDList) * FileCount);

   try

     for i := 0 to FileCount - 1 do

     begin

       OleCheck(Folder.ParseDisplayName(0, nil,

         PWideChar(WideString(Files[i])), chEaten, p^[i],

         dwAttributes));

     end;

     OleCheck(Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject,

       nil,

       Pointer(Result)));

   finally

     for i := 0 to FileCount - 1 do begin

       if p^[i] <> nil then Malloc.Free(p^[i]);

     end;

     FreeMem(p);

   end;

 finally

   Malloc.Free(FolderPidl);

 end;

end;

function TForm1.QueryContinueDrag(fEscapePressed: BOOL;

 grfKeyState: Longint): HResult; stdcall;

begin

 if fEscapePressed or (grfKeyState and MK_RBUTTON = MK_RBUTTON) then

 begin

   Result := DRAGDROP_S_CANCEL

 end else if grfKeyState and MK_LBUTTON = 0 then

 begin

   Result := DRAGDROP_S_DROP

 end else

 begin

   Result := S_OK;

 end;

end;

function TForm1.GiveFeedback(dwEffect: Longint): HResult; stdcall;

begin

 Result := DRAGDROP_S_USEDEFAULTCURSORS;

end;

procedure TForm1.FileListBox1MouseDown(Sender: TObject;

 Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

 if Button = mbLeft then

 begin

   FDragStartPos.x := X;

   FDragStartPos.y := Y;

 end;

end;

procedure TForm1.FileListBox1MouseMove(Sender: TObject; Shift:

 TShiftState;

 X, Y: Integer);

const

 Threshold = 5;

var

 SelFileList: TStrings;

 i: Integer;

 DataObject: IDataObject;

 Effect: DWORD;

begin

 with Sender as TFileListBox do

 begin

   if (SelCount > 0) and (csLButtonDown in ControlState)

     and ((Abs(X - FDragStartPos.x) >= Threshold)

     or (Abs(Y - FDragStartPos.y) >= Threshold)) then

     begin

     Perform(WM_LBUTTONUP, 0, MakeLong(X, Y));

     SelFileList := TStringList.Create;

     try

       SelFileList.Capacity := SelCount;

       for i := 0 to Items.Count - 1 do

         if Selected[i] then SelFileList.Add(Items[i]);

       DataObject := GetFileListDataObject(Directory, SelFileList);

     finally

       SelFileList.Free;

     end;

     Effect := DROPEFFECT_NONE;

     DoDragDrop(DataObject, Self, DROPEFFECT_COPY, Effect);

   end;

 end;

end;

initialization

 OleInitialize(nil);

finalization

 OleUninitialize;

end.

- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -

{

As you might have seen, TForm1 is not only a member of class TForm,

but also of class IDropSource!

Now make sure that the two FileListBox events

'OnMouseMove' and 'OnMouseDown' are set correctly.

Run your application and try out the Drag and Drop feature!

You can select multiple items to drag and press escape to cancel.

The cursor will show you what action will take place.

}