unit Unit1; interface uses DragDrop, DropSource, DropTarget, DragDropPIDL, PathComboBox, Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, ComCtrls, ActiveX, ShellApi, ShlObj, Buttons, ExtCtrls,StdCtrls, CommCtrl; type TForm1 = class(TForm) ListView1: TListView; Panel1: TPanel; DropPIDLSource1: TDropPIDLSource; Button1: TButton; StatusBar1: TStatusBar; Label1: TLabel; DropPIDLTarget1: TDropPIDLTarget; sbUpLevel: TSpeedButton; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure ListView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure Button1Click(Sender: TObject); procedure ListView1DblClick(Sender: TObject); procedure ListView1KeyPress(Sender: TObject; var Key: Char); procedure DropPIDLTarget1Drop(Sender: TObject; ShiftState: TShiftState; Point: TPoint; var Effect: Integer); procedure sbUpLevelClick(Sender: TObject); procedure DropPIDLTarget1DragOver(Sender: TObject; ShiftState: TShiftState; Point: TPoint; var Effect: Integer); private CurrentShellFolder: IShellFolder; CurrentFolderImageIndex: integer; FImageList: TImageList; FRecyclePIDL: pItemIdList; FIsDragging: boolean; //custom component NOT installed in the IDE... PathComboBox: TPathComboBox; procedure PathComboBoxChange(Sender: TObject); procedure SetCurrentFolder; procedure RefreshListNames; procedure PopulateListview; public { Public declarations } end; var Form1: TForm1; implementation {$R *.DFM} //--------------------------------------------------------------------- // TLVItemData class // (objects used to store extra data with each Listview item) //--------------------------------------------------------------------- type TLVItemData = class SortStr: string; {just used to sort the listview} RelativePIDL: pItemIDList; {each item stores its own PIDLs} AbsolutePIDL: pItemIDList; public destructor Destroy; override; end; destructor TLVItemData.Destroy; begin //nb: ShellMalloc interface declared and assigned in DropSource.pas ShellMalloc.Free(RelativePIDL); ShellMalloc.Free(AbsolutePIDL); inherited; end; //--------------------------------------------------------------------- // Local functions ... //--------------------------------------------------------------------- //Used to sort the listview... function ListviewSort(Item1, Item2: TListItem; lParam: Integer): Integer; stdcall; Begin if (Item1<>nil) and (Item2<>nil) and (Item1<>Item2) then Result:= lstrcmpi( pChar(TLVItemData(Item1.Data).SortStr), pChar(TLVItemData(Item2.Data).SortStr) ) else Result:=0; End; //--------------------------------------------------------------------- //Just used for sorting listview... function GetPathName(Folder: IShellFolder; Pidl: PItemIdList): String; var StrRet: TStrRet; Begin Result:=''; Folder.GetDisplayNameOf(Pidl,SHGDN_FORPARSING,StrRet); case StrRet.uType of STRRET_WSTR: Result:=WideCharToString(StrRet.pOleStr); STRRET_OFFSET: Result:=PChar(UINT(Pidl)+StrRet.uOffset); STRRET_CSTR: Result:=StrRet.cStr; End; end; //--------------------------------------------------------------------- // TForm1 class ... //--------------------------------------------------------------------- procedure TForm1.FormCreate(Sender: TObject); var sfi: TShFileInfo; begin //get access to the shell imagelist... FImageList := TImageList.create(self); FImageList.handle := shgetfileinfo('',0,sfi,sizeof(tshfileinfo), shgfi_sysiconindex or shgfi_smallicon); FImageList.shareimages := true; FImageList.BlendColor := clHighlight; Listview1.SmallImages := FImageList; //Create our custom component... PathComboBox := TPathComboBox.create(self); PathComboBox.parent := self; PathComboBox.top := 35; PathComboBox.left := 2; PathComboBox.width := 434; PathComboBox.ShowVirtualFolders := true; PathComboBox.OnChange := PathComboBoxChange; PathComboBox.path := extractfilepath(paramstr(0)); //SetCurrentFolder; DropPIDLTarget1.register(Listview1); fRecyclePIDL := nil; ShGetSpecialFolderLocation(0,CSIDL_BITBUCKET ,fRecyclePIDL); end; //--------------------------------------------------------------------- procedure TForm1.FormDestroy(Sender: TObject); var i: integer; begin DropPIDLTarget1.unregister; with Listview1.items do for i := 0 to Count-1 do TLVItemData(Item[i].data).free; FImageList.free; ShellMalloc.Free(fRecyclePIDL); end; //--------------------------------------------------------------------- //--------------------------------------------------------------------- // Start a Drag and Drop (DropPIDLSource1.execute) ... //--------------------------------------------------------------------- procedure TForm1.ListView1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); const AllowedAttribMask: Longint = (SFGAO_CANCOPY or SFGAO_CANMOVE); var i: integer; attr: UINT; res: TDragResult; tmpImageList: TImageList; dummyPt: TPoint; DraggingFromRecycle: boolean; attributes: integer; begin //If no files selected then exit... if Listview1.SelCount = 0 then exit; statusbar1.simpletext := ''; if (DragDetectPlus(TWinControl(Sender).Handle, Point(X,Y))) then begin // OK, HOW TO KNOW IF WE'RE DRAGGING FROM THE 'RECYCLE BIN'... DraggingFromRecycle := False; // ILIsEqual() doesn't seem to work in Win95/Win98 ... if ILIsEqual(fRecyclePIDL,PathCombobox.pidl) then DraggingFromRecycle := true else begin // OK, not great but this works in Win95/Win98 ... attributes := integer(GetFileAttributes(pchar(PathCombobox.path))); if (attributes <> -1) and (attributes and FILE_ATTRIBUTE_HIDDEN <> 0) and (attributes and FILE_ATTRIBUTE_SYSTEM <> 0) then DraggingFromRecycle := true; end; // CopyFolderPidlToList automatically deletes anything from a previous dragdrop... DropPIDLSource1.CopyFolderPidlToList(PathComboBox.Pidl); // Fill DropSource1.Files with selected files in ListView1... for i := 0 to Listview1.items.Count-1 do if (Listview1.items.item[i].Selected) then with TLVItemData(Listview1.items.item[i].data) do begin // Make sure the shell allows us to drag each selected file/folder ... attr := AllowedAttribMask; CurrentShellFolder.GetAttributesOf(1,RelativePIDL,attr); // If not allowed to copy and move the quit drag... if (attr and AllowedAttribMask) = 0 then exit; DropPIDLSource1.CopyFilePidlToList(RelativePIDL); if DraggingFromRecycle then DropPIDLSource1.MappedNames.add(Listview1.items.item[i].Caption); end; //Let Listview1 draw the drag image for us ... tmpImageList := TImageList.Create(Self); try tmpImageList.handle := ListView_CreateDragImage(Listview1.Handle, Listview1.Selected.Index, dummyPt); DropPIDLSource1.Images := tmpImageList; DropPIDLSource1.ShowImage := True; statusbar1.SimpleText := 'Dragging ...'; // DropPIDLTarget1.dragtypes := []; // the above line has been commented out to // allow dropping onto self if a subfolder is the droptarget... // see DropPIDLTarget1DragOver() //Do the dragdrop... FIsDragging := True; try res := DropPIDLSource1.Execute; finally FIsDragging := False; end; finally tmpImageList.Free; end; //DropPIDLTarget1.dragtypes := [dtCopy,dtMove]; if res in [drDropCopy, drDropMove] then statusbar1.simpletext := 'Drag and Drop succeeded.' else statusbar1.simpletext := 'Drag and Drop cancelled.'; if (res <> drDropMove) then exit; // This is a real kludge, which also may not be long enough... // See detailed demo for a much better solution. sleep(1000); RefreshListNames; end; end; //--------------------------------------------------------------------- // DropPIDLTarget1 Methods ... //--------------------------------------------------------------------- // If the Listview's droptarget is a system folder then // make sure the target highlighting is done 'cleanly'... // otherwise don't allow the drop. procedure TForm1.DropPIDLTarget1DragOver(Sender: TObject; ShiftState: TShiftState; Point: TPoint; var Effect: Integer); var NewTargetListItem: TListItem; begin NewTargetListItem := Listview1.GetItemAt(Point.X,Point.Y); if (NewTargetListItem = nil) then begin // If a folder was previously a droptarget cancel its droptarget status... if (Listview1.DropTarget <> nil) then begin // Hide the drag image. DropPIDLTarget1.ShowImage := False; try // cancel current droptarget folder as droptarget... Listview1.DropTarget := nil; Listview1.Update; finally // Windows must have time to repaint the invalidated listview // items before we show the drag image again. DropPIDLTarget1.ShowImage := True; end; end; // Only allow a drop into current folder if we ourself are not the source, // and the destination folder isn't virtual... if (FIsDragging) or (PathCombobox.IsVirtualPath) then Effect := DROPEFFECT_NONE; end else if (Listview1.DropTarget = NewTargetListItem) then //Effect := Effect //ie: don't fiddle with Effect else if (TLVItemData(NewTargetListItem.data).sortstr[1] = '1') then begin // only allow file system folders to be targets... // Hide the drag image... DropPIDLTarget1.ShowImage := false; try // Cancel current droptarget folder as droptarget... Listview1.DropTarget := nil; // set the new droptarget folder... Listview1.DropTarget := NewTargetListItem; Listview1.Update; finally // windows must have time to repaint the invalidated listview // items before we show the drag image again. DropPIDLTarget1.ShowImage := True; end; end else Effect := DROPEFFECT_NONE; end; //--------------------------------------------------------------------- procedure TForm1.DropPIDLTarget1Drop(Sender: TObject; ShiftState: TShiftState; Point: TPoint; var Effect: Integer); var i: integer; fos: TShFileOpStruct; strFrom, strTo, DestPath: string; Operation: integer; begin //first, where are we dropping TO... strTo := ''; if (Listview1.DropTarget <> nil) then //dropping into a subfolder... with TLVItemData(Listview1.DropTarget.data) do begin if sortstr[1] = '1' then strTo := copy(sortstr,2,MAX_PATH)+#0#0 else Effect := DROPEFFECT_NONE; //subfolder must be a system folder! end else if PathComboBox.path <> '' then //OK, dropping into current folder... strTo := PathComboBox.path +#0#0 else Effect := DROPEFFECT_NONE; //current folder must be a system folder! Operation := 0; case Effect of DROPEFFECT_COPY: Operation := FO_COPY; DROPEFFECT_MOVE: Operation := FO_MOVE; else Effect := DROPEFFECT_NONE; end; // Only allow a Copy or Move operation... // otherwise stop and signal to source that no drop occured. if Effect = DROPEFFECT_NONE then exit; // now, where are we dropping FROM... strFrom := ''; with DropPIDLTarget1 do begin for i := 0 to Filenames.count-1 do if Filenames[i] = '' then exit else // quit if 'virtual' strFrom := strFrom + Filenames[i]+#0; end; if strFrom = '' then begin //signal to source something wrong... Effect := DROPEFFECT_NONE; exit; end; with fos do begin wnd := self.handle; wFunc := Operation; pFrom := PChar(strFrom); pTo := PChar(strTo); fFlags := FOF_ALLOWUNDO; hNameMappings:= nil; end; try // Copy or move the files SHFileOperation(fos); except // Avoid that an exception interrupts the drag/drop prematurely. on E: Exception do begin Application.ShowException(E); Effect := DROPEFFECT_NONE; exit; end; end; //if dropped files need to be renamed - //(eg if they have been dragged from the recycle bin) ... with DropPIDLTarget1 do if MappedNames.count > 0 then begin if PathComboBox.path[length(PathComboBox.path)] <> '\' then DestPath := PathComboBox.path + '\' else DestPath := PathComboBox.path; for i := 0 to MappedNames.count-1 do begin if fileexists(DestPath+ extractfilename(filenames[i])) then renamefile(DestPath+ extractfilename(filenames[i]), DestPath+MappedNames[i]); end; end; RefreshListNames; end; //--------------------------------------------------------------------- procedure TForm1.SetCurrentFolder; var sfi: tshfileinfo; begin if PathComboBox.Pidl <> nil then begin //Get CurrentShellFolder... //nb: DesktopShellFolder is a Global Variable declared in PathComboBox. if PathComboBox.itemindex = 0 then //Desktop folder CurrentShellFolder := DesktopShellFolder else DesktopShellFolder.BindToObject(PathComboBox.Pidl, nil, IID_IShellFolder, pointer(CurrentShellFolder)); //Get CurrentFolder's ImageIndex... shgetfileinfo(pChar(PathComboBox.Pidl), 0,sfi,sizeof(tshfileinfo), SHGFI_PIDL or SHGFI_ICON); CurrentFolderImageIndex := sfi.iIcon; RefreshListNames; end; // Don't allow a drop onto a virtual folder... if PathComboBox.path <> '' then DropPIDLTarget1.DragTypes := [dtCopy,dtMove] else DropPIDLTarget1.DragTypes := []; sbUpLevel.Enabled := (PathComboBox.ItemIndex <> 0); end; //--------------------------------------------------------------------- procedure TForm1.RefreshListNames; var i: integer; begin with Listview1.items do begin beginupdate; for i := 0 to Count-1 do TLVItemData(Item[i].data).free; clear; screen.cursor := crHourglass; PopulateListview; screen.cursor := crDefault; endupdate; end; end; //--------------------------------------------------------------------- procedure TForm1.PopulateListview; var EnumIdList: IEnumIdList; tmpPIDL: pItemIDList; NewItem: TListItem; ItemData: TLVItemData; sfi: TShFileInfo; Flags, dummy: DWORD; begin if CurrentShellFolder = nil then exit; with Listview1.items do begin //get files and folders... Flags := SHCONTF_FOLDERS or SHCONTF_NONFOLDERS or SHCONTF_INCLUDEHIDDEN; if FAILED(CurrentShellFolder.EnumObjects(0,Flags,EnumIdList)) then exit; while (EnumIdList.Next(1,tmpPIDL,dummy) = NOERROR) do begin NewItem := Add; NewItem.caption := GetPIDLDisplayName(CurrentShellFolder,tmpPIDL); ItemData := TLVItemData.create; NewItem.data := ItemData; ItemData.RelativePIDL := tmpPIDL; ItemData.AbsolutePIDL := ILCombine(PathComboBox.Pidl,tmpPIDL); shgetfileinfo(pChar(ItemData.AbsolutePIDL), 0,sfi,sizeof(tshfileinfo), SHGFI_PIDL or SHGFI_ICON or SHGFI_ATTRIBUTES); NewItem.ImageIndex := sfi.iIcon; //get sort order... if (sfi.dwAttributes and SFGAO_FOLDER)<>0 then begin if (sfi.dwAttributes and SFGAO_FILESYSTEM)<>0 then //file system folder ItemData.SortStr := '1'+ GetPathName(CurrentShellFolder,tmpPIDL) else //virtual folder ItemData.SortStr := '2'+ GetPathName(CurrentShellFolder,tmpPIDL); end else //files ItemData.SortStr := '9'+ GetPathName(CurrentShellFolder,tmpPIDL); end; end; ListView1.CustomSort(@ListviewSort, 0); if Listview1.items.count > 0 then Listview1.items[0].focused := true; end; //--------------------------------------------------------------------- procedure TForm1.PathComboBoxChange(Sender: TObject); begin SetCurrentFolder; caption := PathComboBox.path; end; //--------------------------------------------------------------------- //If a folder double-clicked - open that folder... procedure TForm1.ListView1DblClick(Sender: TObject); var SelItem: TListItem; begin SelItem := Listview1.Selected; if SelItem = nil then exit; with TLVItemData(SelItem.data) do if (sortstr[1] < '9') then //if a folder... PathComboBox.Pidl := AbsolutePIDL; end; //--------------------------------------------------------------------- //If a folder selected - open that folder... procedure TForm1.ListView1KeyPress(Sender: TObject; var Key: Char); var SelItem: TListItem; begin SelItem := Listview1.Selected; if (SelItem = nil) or (ord(Key) <> VK_RETURN) then exit; with TLVItemData(SelItem.data) do if (sortstr[1] < '9') then //if a folder... PathComboBox.Pidl := AbsolutePIDL; end; //--------------------------------------------------------------------- procedure TForm1.sbUpLevelClick(Sender: TObject); var tmpPidl: pItemIdList; begin if PathComboBox.ItemIndex > 0 then begin tmpPidl := ILClone(PathComboBox.Pidl); ILRemoveLastID(tmpPidl); PathComboBox.Pidl := tmpPidl; ShellMalloc.Free(tmpPidl); end; end; //--------------------------------------------------------------------- procedure TForm1.Button1Click(Sender: TObject); begin Close; end; //--------------------------------------------------------------------- //--------------------------------------------------------------------- end.