Перетаскивание объекта оболочки, часть 4: добавляем красивую иконку

Это перевод Dragging a shell object, part 4: Adding a prettier drag icon. Автор: Реймонд Чен.

Вы могли заметить, что визуально перетаскивание выглядит не очень воодушевляюще. Курсор - это просто прямоугольник с, быть может, плюсиком или стрелочкой; вы даже не знаете, что вы перетаскиваете.

Давайте исправим это. Мы будем таскать иконку файла. Для этого нам нужно добавить изображение в перетаскиваемый объект (data object).

procedure TForm48.FormMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  pdto: IDataObject;
  pds: IDropSource;
  dwEffect: Integer;
  FileName: String;
begin
  FileName := Edit1.Text;
  if SUCCEEDED(GetDataObjectOfFileWithCuteIcon(Handle, FileName, pdto)) then
  begin
    pds := TDropSource.Create;
    ...

Эта новая функция GetDataObjectOfFileWithCuteIcon создаёт объект данных, а затем прикрепляет к нему красивую иконку.

function TForm1.GetDataObjectOfFileWithCuteIcon(Wnd: HWND; const pszPath: String; out ppdto: IDataObject): HRESULT;
var
  pdsh: IDragSourceHelper;
  sdi: SHDRAGIMAGE;
begin
  Result := GetUIObjectOfFile(Wnd, pszPath, IID_IDataObject, ppdto);
  if SUCCEEDED(Result) then
  begin
    if SUCCEEDED(CoCreateInstance(CLSID_DragDropHelper, nil, CLSCTX_ALL, IID_IDragSourceHelper, pdsh)) then
    begin
      if CreateDragImage(pszPath, sdi) then
      begin
        pdsh.InitializeFromBitmap(@sdi, ppdto);
        DeleteObject(sdi.hbmpDragImage);
      end;
    end;
  end;
end;

Мы используем вспомогательный объект оболочки для drag/drop для прикрепления изображения к перетаскиваемому объекту (data object). Вспомогательный объект требует, чтобы перетаскиваемый объект мог принимать произвольные blob-данные, но, к счастью, стандартные объекты оболочки могут это делать.

Неприятной работой тут является создание изображения для перетаскивания. Это не будет интересной частью, и вы не узнаете ничего нового из этой функции. Её просто нужно написать.

function TForm1.CreateDragImage(const pszPath: String; out psdi: SHDRAGIMAGE): Boolean;
var
  sfi: SHFILEINFOW;
  DC: HDC;
  hbmPrev: HBITMAP;
  IL: TImageList;
begin
  IL := TImageList.Create(nil);
  try
    FillChar(psdi, SizeOf(psdi), 0);
    IL.ShareImages := True;
    IL.Handle := SHGetFileInfo(PChar(pszPath), 0, sfi, SizeOf(sfi), SHGFI_SYSICONINDEX);
    if IL.Handle <> 0 then
    begin
      psdi.sizeDragImage.cx := IL.Width;
      psdi.sizeDragImage.cy := IL.Height;
      psdi.ptOffset.x := psdi.sizeDragImage.cx div 2;
      psdi.ptOffset.y := psdi.sizeDragImage.cy div 2;
      psdi.crColorKey := CLR_NONE;
      IL.BlendColor := clNone;
      IL.BkColor := clNone;

      psdi.hbmpDragImage := CreateBitmap(psdi.sizeDragImage.cx, psdi.sizeDragImage.cy, 1, 32, nil);
      if psdi.hbmpDragImage <> 0 then
      begin
        DC := CreateCompatibleDC(HWND_DESKTOP);
        if DC <> 0 then
        try
          hbmPrev := SelectObject(DC, psdi.hbmpDragImage);
          try
            Result := ImageList_DrawEx(IL.Handle, sfi.iIcon, DC, 0, 0, psdi.sizeDragImage.cx, psdi.sizeDragImage.cy, CLR_NONE, CLR_NONE, ILD_NORMAL);
          finally
            SelectObject(DC, hbmPrev);
          end;
        finally
          DeleteDC(DC);
        end
        else
          Result := False;

        if (not Result) and (psdi.hbmpDragImage <> 0) then
        begin
          DeleteObject(psdi.hbmpDragImage);
          psdi.hbmpDragImage := 0;
        end;
      end;
    end;
  finally
    FreeAndNil(IL);
  end;
  Result := (psdi.hbmpDragImage <> 0);
end;

Чтобы создать изображение для перетаскивания, мы просим функцию SHGetFileInfo вернуть нам описатель ImageList и индекс иконки, представляющей файл, в нём. Размер изображений в ImageList копируется в запись SHDRAGIMAGE как размеры битмапа, мы также позиционируем курсор мыши по центру изображения. Поскольку мы создаём изображение с альфа-каналом, нам не нужен цветовой ключ. Наконец, мы создаём DC, чтобы подсунуть ему ARGB-bitmap для рисования на нём иконки.

Если вы запустите эту программу, то вы увидите, что иконка текстового файла перетаскивается вместе с курсором мыши, когда вы начинаете таскать наш файл throwaway.txt по экрану.

В следующий раз мы загрузим этой работой кого-нибудь другого.