unit1.pas

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

        // 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(TLVCompare(@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.