Заметки про Drag&Drop в Delphi.

Из достоверных источников стало известно, что в Embarcadero готовиться к выходу Update 4 для Delphi XE2. Судя по описанию, нас снова ждёт пополнение коллекции VCL-стилей и много-много всего по Firemonkey. А раз так, то следующую статью про Firemonkey я решил отложить до выхода апдейта, чтобы не дай бог написать про уже исправленные недочеты (и тем самым ввести Вас в заблуждение) и вместо нового повествования про FMX немного поиграть на баяне рассказать о вещах, про которые информации в Сети много, но тем не менее вопросы всё ещё есть и, видимо долго ещё будут — про интерфейс Drag&Drop и как использовать, на первый взгляд, непонятные интерфейсы типа IDropTarget, IDropObject и т.д. Сподвигли меня на такой шаг два обстоятельства: необходимость и желание самому разобраться, что и как работает в ShellAPI по части реализации Drag&Drop. До этого момента мне как-то не приходилось иметь серьезных дел по части Drag&Drop…ну разве, что иногда реализовывал перетаскивание чего-то куда-то внутри программы. А тут потребовалось сделать так, чтобы приложение могло «ловить» файлы, определять формат, вытягивать из файлов необходимые данные, отсеивать ненужные объекты и т.д. В общем полез я на MSDN, форумы, агрегаторы статей и т.д. и начал, что называется, вникать в вопрос по полной программе. Ну, а кое-какие выдержки из того, что удалось добыть Вы можете прочитать в этой статье.

Содержание

1. Самый распространенный код для Drag&Drop
2. Интерфейсы для реализации Drag&Drop в своей программе
1. IDropTarget
2. IDataObject
3. IDropSource
3. Пример использования IDropTarget
1. Пример работы с контентом объекта
4. Пример использования IDropSource

Самый распространенный код для Drag&Drop

Итак, первый вопрос, который мы рассмотрим, звучит следующим образом: как узнать, что на форму приложения что-то бросили из Проводника? Сейчас для нас не важно необходим ли нам в программе брошенный объект, что это за объект и что он тут у нас в программе делает. Всё, что пока требуется — понять, что кнопка мышки отпущена над нашей формой и объект на неё «упал».

Используя модуль ShellAPI.pas сделать это можно в три операции:

1. Зарегистрировать окно нашего приложения как приемник файлов
2. Обработать сообщение WM_DROPFILES
3. Снять регистрацию перед закрытием программы.

Открываем Delphi, создаем новый проект VCL Application, в главном модуле в секцию uses прописываем ShellAPI и пишем вот такой код:

type
  TfMain = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
    { Private declarations }
  public
    procedure WMDropFiles(var Msg: TWMDropFiles); message WM_DROPFILES;
  end;
 
var
  fMain: TfMain;
 
implementation
 
{$R *.dfm}
 
procedure TfMain.FormCreate(Sender: TObject);
begin
  DragAcceptFiles(Handle,True)
end;
 
procedure TfMain.FormDestroy(Sender: TObject);
begin
  DragAcceptFiles(Handle, False);
end;
 
procedure TfMain.WMDropFiles(var Msg: TWMDropFiles);
begin
  inherited;
  ShowMessage('Что-то упало на форму')
end;
 
end.

Как видите, пока все довольно просто (дальше будет чуть-чуть по-сложнее). Разберемся, что мы тут написали.

Процедура DragAcceptFiles имеет следующее описание:

procedure DragAcceptFiles(Wnd: HWND; Accept: boolean)

Wnd — хэндл окна, которое мы регистрируем в качестве приемника файлов
Accept — параметр, который в случае True говорит, что окно надо зарегистрировать, а False, соответственно, убрать регистрацию.

Этой процедурой мы и воспользовались при создании и уничтожении формы. После того как окно зарегистрировано в качестве приемника файлов, мы уже можем отлавливать и обрабатывать событие WM_DROPFILES. У TWMDropFiles нам потребуется значение параметра Drop:

  TWMDropFiles = record
    Msg: Cardinal;
    MsgFiller: TDWordFiller;
    Drop: THANDLE;
    Unused: LPARAM;
    Result: LRESULT;
  end;

который вернет нам информацию по перетаскиваемому объекту или объектам. Вообще в Сети можно найти массу вариаций на тему «Как перетащить файл из проводника Windows в свою программу?» с использованием приведенного выше скелета. Например, можете посмотреть заметки тут, тут и вот тут. Можно было бы привести ещё кучу ссылок с аналогичным содержимым. Оно, в принципе, и понятно: что может быть проще этого кода? Но давайте немного разовьем нашу идею и сделаем обратную операцию, т.е. решим вопрос «Как, используя Drag&Drop, скопировать файл в Explorer?» Способы получения файлов извне в программу расписаны довольно подробно, а вот обратные операции по перемещению ИЗ программы В Проводник встречаются в Сети намного реже.

Наиболее часто такие вопросы «всплывают» на форумах и вопрошающих отправляют к разного рода компонентам, которые реализуют Drag&Drop во всех его проявлениях. Наиболее часто мне встречались упоминания бесплатных «Drag and Drop Component Suite for Delphi» и платных «DropMaster«. Первые компоненты под Delphi XE2 при установке начали «плеваться» кучей ошибок при компиляции, начиная от неправильно заданных границ массивов до нереализованных интерфейсов и прочих проблем. За вторые отдавать 99 американских президентов, честно сказать, душит большая страшная жаба — задача не настолько глобальная, чтобы за неё платить. Хотя, справедливости ради, стоит отметить, что DropMaster довольно мощные компоненты и, наверное, стоят тех денег, что за них просят.

В итоге, чтобы научить свою программу работать с Windows Explorer в обе стороны полез я снова в Сеть, но на этот раз конкретно на MSDN, чтобы разобраться с тем как вообще работает ShellAPI и откуда берется тот самый хэндл в событии WM_DROPFILES? Не с потолка же он падает? В итоге поиск привел меня к замечательной вводной статье под названием «Transferring Shell Objects with Drag-and-Drop and the Clipboard» с которой и началось мое знакомство с тремя интерфейсами —  IDataObject, IDropTarget и IDropSource. 

Интерфейсы для реализации Drag&Drop в своей программе

Преимуществом при использовании интерфейсов для реализации Drag&Drop является то, что, используя их мы можем «дропать» на форму не только файлы, а вообще всё, что угодно: файлы, куски выделенного текста, HTML-код и т.д. и т.п. Однако, в связи с этим, сопряжены и некоторые сложности реализации Drag&Drop в приложении. Но, как мы увидим ниже, это не такие уж и большие трудности.

Итак, первым делом разберемся с назначением интерфейсов IDataObject, IDropTarget и IDropSource.

IDropTarget

Описание этого интерфейса содержится в модуле ActiveX и имеет следующий вид:

IDropTarget = interface(IUnknown)
 ['{00000122-0000-0000-C000-000000000046}']
 function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult; stdcall;
 function DragOver(grfKeyState: Longint; pt: TPoint;
   var dwEffect: Longint): HResult; stdcall;
 function DragLeave: HResult; stdcall;
 function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
   var dwEffect: Longint): HResult; stdcall;
end;

Метод DragEnter вызывается, когда пользователь в первый раз тянет мышкой какой-нибудь объект над нашей формой, которая зарегистрирована как приемник.

У DragEnter определены следующие параметры:

• dataObj:IDataObject — интерфейс, описывающий тот объект, который пользователь держит мышкой и никак не желает отпускать.
• grfKeyState: Longint — битовая маска, которая содержит информацию о нажатой кнопке мыши и модификаторах (Shift, Ctrl и т.д.). Этот параметр можно использовать, например, для определения будущей операции — перенос, копирование, создание ссылки на объект и т.д.
• dwEffect: LongInt — битовая маска, определяющая вид курсора.

Метод DragOver вызывается, когда пользователь перетаскивает объект над нашей формой. У метода определены следующие параметры:

• grfKeyState: Longint — как и в предыдущем случае, содержит информацию о зажатой кнопке мыши и клавишах-модификаторах;
• pt: TPoint — точка на форме над которой в данный момент находится курсор;
• dwEffect: Longint — определяет тип операции, который будет произведен над объектом после того как пользователь отпустит кнопку мыши (копирование, перемещение, создание ссылки на объект и т.д. Все возможные варианты, которые может принимать этот параметр рассмотрены в MSDN.

Метод DragLeave вызывается в том случае, если пользователь не бросил объект на форму и вывел курсор мыши за её пределы. Этот метод не имеет никаких параметров.

Метод Drop сообщает нам, что пользователь отпустил кнопку мыши и объект «упал» на форму. У метода определены следующие параметры:

• dataObj: IDataObject — указатель на объект, который был перемещен на форму
• grfKeyState: Integer — информация о клавишах-модификаторах, которые были зажаты в момент «броска»;
• pt: TPoint — точка над которой был брошен объект;
• dwEffect: Integer — как и в случае с DragOver, определяет тип операции.

IDataObject

Как и для предыдущего интерфейса, реализация IDataObject содержится в модуле ActiveX.pas и выглядит следующим образом:

IDataObject = interface(IUnknown)
 ['{0000010E-0000-0000-C000-000000000046}']
 function GetData(const formatetcIn: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
 function GetDataHere(const formatetc: TFormatEtc; out medium: TStgMedium): HResult; stdcall;
 function QueryGetData(const formatetc: TFormatEtc): HResult; stdcall;
 function GetCanonicalFormatEtc(const formatetc: TFormatEtc; out formatetcOut: TFormatEtc): HResult; stdcall;
 function SetData(const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL): HResult; stdcall;
 function EnumFormatEtc(dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc): HResult; stdcall;
 function DAdvise(const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint): HResult; stdcall;
 function DUnadvise(dwConnection: Longint): HResult; stdcall;
 function EnumDAdvise(out enumAdvise: IEnumStatData): HResult; stdcall;
  end;

Этот интерфейс необходим нам, чтобы получить информацию о перетаскиваемом объекте. Нам нет необходимости реализовывать этот интерфейс в нашей программе, т.к. Windows сама будет его предоставлять ссылку на него через методы IDropTarget. Всё, что от нас будет требоваться — это получить информацию об объекте (формат, расположение файла и т.д.). Наиболее важными для нас сегодня буду следующие методы:

Метод GetData — используется для получения информации по объекту. Метод содержит следующие параметры:

• formatetcIn: TFormatEtc — входной параметр, определяющий формат объекта и целевое устройство, используемое при работе с объектом; об этом параметре мы ещё поговорим ниже.
• outmedium: TStgMedium — содержит ссылку на структуру, содержащую информацию о перетаскиваемом объекте. Описание структуры  TStgMedium приведено ниже.

Метод QueryGetData -определяет возможность получения данных по объекту с заданными в параметре formatetc свойствами. Этот метод необходимо вызывать до запроса данных с помощью GetData.

Метод EnumFormatEtc — возвращает ссылку на объект для перечисления поддерживаемых объектом форматов данных. Метод имеет следующие параметры:

• dwDirection: Longint — определяет направление потока данных и должен содержать одно из значений, определенных в DATADIR;
• out enumFormatEtc: IEnumFormatEtc — ссылка на объект для перечисления поддерживаемых форматов.

IDropSource

Этот интерфейс следует реализовывать в том случае, если Ваше приложение будет выступать в качестве источника данных для Drag&Drop.

Интерфейс IDropSource имеет следующее описание:

 IDropSource = interface(IUnknown)
 ['{00000121-0000-0000-C000-000000000046}']
   function QueryContinueDrag(fEscapePressed: BOOL; grfKeyState: Longint): HResult; stdcall;
   function GiveFeedback(dwEffect: Longint): HResult; stdcall;
 end;

Метод GiveFeedback предоставляет пользователю визуальную информацию о перетаскивании. Проще говоря, в этом методе можно определить вид курсора при перетаскивании объекта.

Входной параметр dwEffect должен содержать одно из значений, определенных в перечислителе DROPEFFECT.

Метод QueryContinueDrag определяет может ли продолжаться операция Drag&Drop. Метод содержит следующие параметры:

• fEscapePressed: BOOL — определяет была ли нажата клавиша Esc после предыдущего вызова QueryContinueDrag ;
• grfKeyState: Longint — текущее состояние клавиш-модификаторов.

Как видите, реализовав три представленных выше интерфейса в своей программе, мы можем организовать Drag&Drop в обе стороны — получать объекты и обрабатывать их в программе, а также формировать собственные объекты для передачи их во вне, например, на основании данных программы формировать файлы и копировать их в какую-либо директорию.

Теперь, когда мы немного познакомились с интерфейсами, можно перейти к практическим примерам их использования.

Пример использования IDropTarget

Для начала рассмотрим пример в котором наше приложение будет выступать в роли приёмника данных. Пример, показанный в самом начале, реализовывал прием файлов программой. В этом примере мы посмотрим как принимать не только файлы, но и другие данные.

Для начала определимся как будет работать наше приложение. Чтобы сильно не нагружать нашу программу компонентами, пусть приложение будет содержать всего 1 компонент на главной форме — TMemo. Если мы будем перетаскивать на форму файл (или группу файлов), то в Memo будет отображаться список переданных файлов, если же будем перетаскивать текст — то Memo просто будет его отображать.

Главная форма приложения будет иметь следующий незатейливый вид:

Для примера, реализуем интерфейс IDropTarget в главной форме нашего приложения. Так как TForm уже реализует IInterface, то нам нет необходимости реализовывать его методы, а можно сосредоточиться на методах необходимого нам интерфейса.

Для начала приведем описание главной формы нашего приложения к следующему виду:

type
  Tfmain = class(TForm, IDropTarget)
    Memo1: TMemo;
  protected
    function DragEnter(const dataObj: IDataObject; grfKeyState: Longint;
      pt: TPoint; var dwEffect: Longint): HResult; stdcall;
    function DragOver(grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
    function DragLeave: HResult; stdcall;
    function Drop(const dataObj: IDataObject; grfKeyState: Longint; pt: TPoint;
      var dwEffect: Longint): HResult; stdcall;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Прежде, чем мы сможем использовать Drag&Drop, нам необходимо зарегистрировать нашу форму как приемник данных. Для этого используется функция RegisterDragDrop из модуля ActivaX:

function RegisterDragDrop(wnd:HWND; pDropTarget:LPDROPTARGET):HRESULT;

• wnd:HWND — это хэндл окна, которое будет зарегистрировано в качестве приемника.
• pDropTarget:LPDROPTARGET — ссылка на объект, реализующий интерфейс IDropTarget.

Перед вызовом этой функции нам необходимо вызвать метод OleInitialize.

Соответственно, чтобы перед выходом из программы нам необходимо вызвать обратные методы. Сначала:

function RevokeDragDrop(wnd: hwnd):HRESULT;

и в заключении OleUninitialize. Чтобы не отвлекаться в дальнейшем на эти операции, напишем обработчика OnCreate и OnDestroy для нашей формы:

procedure Tfmain.FormCreate(Sender: TObject);
begin
  OleInitialize(nil);
  RegisterDragDrop(Handle,Self);
end;
 
procedure Tfmain.FormDestroy(Sender: TObject);
begin
  RevokeDragDrop(Handle);
  OleUninitialize;
end;

Теперь приступим к методам IDropTarget. Начнем с методов DragEnter,  DragOver и DragLeave. Так как сейчас мы не будем каким-либо образом отфильтровывать объекты, которые пользователь переносит на форму, то код этих методов будет предельно прост:

function Tfmain.DragEnter(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
begin
  dwEffect:=DROPEFFECT_COPY;
  Result:=S_OK;
end;
 
function Tfmain.DragLeave: HResult;
begin
  Result:=S_OK;
end;
 
function Tfmain.DragOver(grfKeyState: Integer; pt: TPoint;
  var dwEffect: Integer): HResult;
begin
 Caption:='X = '+IntToStr(pt.X)+' Y = '+IntToStr(pt.Y);
 dwEffect:=DROPEFFECT_COPY;
 Result:=S_OK;
end;

А вот на последнем методе — Drop мы остановимся более подробно, так как именно в нем будет описана вся механика приёма объекта. для начала напишем метод, которые будет возвращать нам список перетянутых на форму файлов. Как говорилось выше, для этого можно воспользоваться методом GetData у IDataObject. Вначале приведу весь код функции:

procedure GetFileList(const DataObj: IDataObject;const FileList: TStrings);
var
  FmtEtc: TFormatEtc;
  Medium: TStgMedium;
  FileCount: Integer;
  I: Integer;
  FileNameLength: Integer;
  FileName: string;
begin
  FmtEtc.cfFormat := CF_HDROP;
  FmtEtc.ptd := nil;
  FmtEtc.dwAspect := DVASPECT_CONTENT;
  FmtEtc.lindex := -1;
  FmtEtc.tymed := TYMED_HGLOBAL;
  if DataObj.GetData(FmtEtc, Medium)=S_OK then
  try
    try
      FileCount := DragQueryFile(Medium.hGlobal, $FFFFFFFF, nil, 0);
      for I := 0 to FileCount-1 do
      begin
        FileNameLength := DragQueryFile(Medium.hGlobal, I, nil, 0);
        SetLength(FileName, FileNameLength);
        DragQueryFile(Medium.hGlobal, I, PChar(FileName), FileNameLength + 1);
        FileList.Add(FileName);
      end;
    finally
      DragFinish(Medium.hGlobal);
    end;
  finally
    ReleaseStgMedium(Medium);
  end;
end;

Рассмотрим весь код метода по порядку. В начале мы заполняем структуру TFormatEtc, чтобы запросить информацию по объекту. Рассмотрим теперь состав этой структуры детально.

Итак, TFormatEtc имеет следующее описание:

tagFORMATETC = record
    cfFormat: TClipFormat;
    ptd: PDVTargetDevice;
    dwAspect: Longint;
    lindex: Longint;
    tymed: Longint;
  end;
  TFormatEtc = tagFORMATETC;

cfFormat: TClipFormat — интересующий нас формат данных и может представлять собой формат буфер обмена. К примеру, этот параметр может содержать значение CF_TEXT. Кроме того, параметр cfFormat может содержать и ряд других идентификаторов, про которые можно получить информацию в этой статье на MSDN. В приведенном выше методе мы использовали идентификатор CF_HDROP — формат буфера обмена, используемый при передаче группы файлов в приемник.

ptd: PDVTargetDevice — ссылка на структуру DVTARGETDEVICE, определяющую тип устройства. В приведенном выше примере мы определили значение этого поля как nil, т.к. наш формат данных никаким образом не зависит от типа устройства и нам не важно используется ли или нет это устройство.

dwAspect: Longint — определяет насколько подробными должны быть данные. Этот параметр может принимать одно из следующих значений:

• DVASPECT_CONTENT — обеспечивает представление объекта таким образом, чтобы его можно было отобразить в OLE-контейнере. Используя этот идентификатор можно, например, открыть файл PowerPoint или Word.
• DVASPECT_THUMBNAIL — обеспечивает представление эскиза документа. Эскиз представляет собой метафайл размером 120х120 пикселей и глубиной цвета 16 бит.
• DVASPECT_ICON — обеспечиват предоставление иконки объекта.
• DVASPECT_DOCPRINT — обеспечивает представление объекта на экране, как если бы он был напечатан на принтере с использованием команды Печать в меню. Данные могут представлять собой последовательность страниц.

lindex: Longint — часть данных, которые должны быть предоставлены. В нашем случае используется наиболее общее значение -1 при котором будут возвращены все данные по объекту.

tymed: Longint — определяет тип носителя передаваемых данных и может принимать одно из значений перечислителя TYMED. В нашем случае использовался один из идентификаторов — TYMED_HGLOBAL, который сообщает, что все данные будут передаваться через глобальную память и будут доступны через глобальный дескриптор памяти типа HGLOBAL.

Сформировав структуру TFormatEtc мы выполнили метод IDataObject.GetData и получили в ответ новую структуру типа TStgMedium.

Рассмотрим, что представляет из себя эта структура. TStgMedium имеет следующее описание:

tagSTGMEDIUM = record
    tymed: Longint;
    case Integer of
      0: (hBitmap: HBitmap; unkForRelease: Pointer{IUnknown});
      1: (hMetaFilePict: THandle);
      2: (hEnhMetaFile: THandle);
      3: (hGlobal: HGlobal);
      4: (lpszFileName: POleStr);
      5: (stm: Pointer{IStream});
      6: (stg: Pointer{IStorage});
  end;
  TStgMedium = tagSTGMEDIUM;

tymed: Longint как и в случае TFormatEtc определяет тип носителя. В нашем случае мы просили разместить данные в памяти, следовательно при успешном выполнении GetData этот параметр будет также равен TYMED_HGLOBAL.

второй параметр, в зависимости от tymed содержит либо указатель, либо хэндл на объект. В нашем случае второй параметр будет hGlobal: HGlobal.

Следующий шаг, который мы сделали в нашем методе GetFileList — это запросили количество файлов, которые содержатся в DataObj:

FileCount := DragQueryFile(Medium.hGlobal, $FFFFFFFF, nil, 0);

Этот метод содержится в модуле ShellAPI.pas. DragQueryFile содержит следующие параметры:

hDrop : HDROP — входной параметр, определяющий идентификатор структуры, содержащей имена файлов. В нашем случае этим идентификатором будет выступать поле структуры TStgMedium.hGlobal.

iFile : UINT — индекс файла имя которого мы запрашиваем. Здесь мы использовали значение $FFFFFFFF при котором метод возвращает количество брошенных файлов.

lpszFile : LPTSTR — адрес буфера в котором будет содержаться имя файла. При запросе количества файлов нас этот параметр не интересует, поэтому он был установлен в значение nil.

cch: UINT — размер в символах буфера lpszFile.

Следующий наш шаг — это цикл:

for I := 0 to FileCount-1 do
  begin
    FileNameLength := DragQueryFile(Medium.hGlobal, I, nil, 0);
    SetLength(FileName, FileNameLength);
    DragQueryFile(Medium.hGlobal, I, PChar(FileName), FileNameLength + 1);
    FileList.Add(FileName);
  end;

Здесь мы, используя всё ту же функцию DragQueryFile вначале запрашиваем размер буфера в качестве которого выступает переменная FileName, после чего снова вызываем DragQueryFile и получаем имя файла. Здесь стоит отметить, что структура, содержащая имена брошенных на форму файлов, выглядит в памяти следующим образом (пример для двух файлов):

c:\temp1.txt'\0'c:\temp2.txt'\0''\0'

И в заключении мы освободили память, занимаемую объектами:

  finally
     DragFinish(Medium.hGlobal);
  end;
finally
  ReleaseStgMedium(Medium);
end;

Воспользуемся теперь этой функцией в нашем тестовом приложении. Дописываем метод Drop:

function Tfmain.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
begin
  GetFileList(dataObj,Memo1.Lines);
  Result:=S_OK;
end;

Теперь можно запустить приложение и попробовать переместить сразу несколько файлов на форму. При этом в Memo должны отобразиться имена брошенных файлов:

Двигаемся дальше. Следующий момент работы с IDropTarget — это отображение контента документа в нашей программе.

Пример работы с контентом объекта

Для начала определимся с решением вопроса: как узнать какого формата данные содержаться в объекте, который собираются бросить на форму?

Для ответа на этот вопрос мы можем воспользоваться, например, методом EnumFormatEtc у IDataObject. Напишем ещё один метод для перечисления поддерживаемых объектом форматов данных:

procedure EnumDataFormats(const DataObj: IDataObject;const FormatList: TStrings);
var
  Enum: IEnumFormatEtc;
  FormatEtc: TFormatEtc;
  Buffer: array[0..255] of Char;
begin
  if DataObj.EnumFormatEtc(DATADIR_GET, Enum)=S_OK then
    while Enum.Next(1, FormatEtc, nil) = S_OK do
     begin
       case FormatEtc.cfFormat of
         CF_TEXT: FormatList.Add('CF_TEXT');
         CF_BITMAP: FormatList.Add('CF_BITMAP');
         CF_METAFILEPICT: FormatList.Add('CF_METAFILEPICT');
         CF_SYLK: FormatList.Add('CF_SYLK');
         CF_DIF: FormatList.Add('CF_DIF');
         CF_TIFF: FormatList.Add('CF_TIFF');
         CF_OEMTEXT: FormatList.Add('CF_TIFF');
         CF_DIB : FormatList.Add('CF_DIB');
         CF_PALETTE: FormatList.Add('CF_PALETTE');
         CF_PENDATA: FormatList.Add('CF_PENDATA');
         CF_RIFF: FormatList.Add('CF_RIFF');
         CF_WAVE: FormatList.Add('CF_WAVE');
         CF_UNICODETEXT: FormatList.Add('CF_UNICODETEXT');
         CF_ENHMETAFILE: FormatList.Add('CF_ENHMETAFILE');
         CF_HDROP: FormatList.Add('CF_HDROP');
         CF_LOCALE: FormatList.Add('CF_LOCALE');
       else
         if GetClipBoardFormatName(FormatEtc.cfFormat, Buffer, 255) > 0 then
           FormatList.Add(Buffer);
       end;
     end;
end;

Рассмотрим код этого метода.

   if DataObj.EnumFormatEtc(DATADIR_GET, Enum)=S_OK then

Условие в котором проверяется успешно ли выполнен метод EnumFormatEtc. Если условие истинно, то в переменной Enum будет содержаться ссылка на объект, с помощью которого можно перечислить все поддерживаемые форматы. Для одного объекта IDataObject может быть определено несколько форматов, причем не только известных нам по работе с Clipboard CF_, но и других, поддерживаемых системой. Весь список поддерживаемых форматов Вы можете посмотреть вот в этой статье MSDN.

Далее в методе выполняется Case в котором значение идентификатора cfFormat сравнивается вначале с форматами CF_ и, если совпадений не обнаружено, то, используя метод GetClipboardFormatName из Windows.pas получаем имя формата.

Проверим работу метода. Для этого преобразуем метод Drop следующим образом:

function Tfmain.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
begin
//  GetFileList(dataObj,Memo1.Lines);
  Memo1.Lines.Clear;
  EnumDataFormats(dataObj,Memo1.Lines);
  Result:=S_OK;
end;

Теперь запустим наше приложение, поперетаскиваем на форму различные файлы и посмотрим, что выдаст нам метод EnumDataFormats. При перетаскивании файла были получены следующие значения:

• Shell IDList Array
• CF_HDROP
• FileName
• FileNameW

Что в полной мере соответствует действительности. Можете поэкспериментировать — открыть, скажем, doc-файл, выделить текст и перетащить его на форму — программа «скажет», что поддерживаются форматы CF_TEXT, CF_UNICODETEXT и ещё большой список имен форматов.

С форматами более менее определились. Теперь попробуем реализовать вторую части примера. Кто уже забыл — напомню: вторая часть заключается в том, чтобы показать не имя файла, а содержимое, перетаскиваемого объекта в Memo.

Здесь нам надо решить ещё один маленький вопрос: как определить, что объект поддерживает необходимый нам формат данных, например, CF_TEXT?

Для ответа на этот вопрос мы могли бы немного модифицировать наш метод EnumDataFormats и в цикле перебирать все форматы, но это будет лишней тратой ресурсов, так как IDataObject имеет замечательный метод QueryGetData, который и поможет нам ответить на вопрос без использования циклов. Напишем небольшую функцию проверки:

function GetFormatEtc(fmt: TClipFormat):TFormatEtc;
begin
  Result.cfFormat:=fmt;
  Result.ptd:=nil;
  Result.dwAspect:=DVASPECT_CONTENT;
  Result.lindex:=-1;
  Result.tymed:=TYMED_HGLOBAL;
end;
 
function IsRightFormat(DataObj:IDataObject; fmt: TClipFormat):boolean;
begin
  Result:=DataObj.QueryGetData(GetFormatEtc(fmt))=S_OK;
end;

Теперь напишем метод, который будет получать из памяти текст:

function GetText(const DataObj: IDataObject;
  const Fmt: TClipFormat): string;
var
  Medium: TStgMedium;
  PText: PChar;
begin
  if DataObj.GetData(GetFormatEtc(Fmt), Medium) = S_OK then
  begin
    Assert(Medium.tymed = TYMED_HGLOBAL);
    try
      PText := GlobalLock(Medium.hGlobal);
      try
        Result := PText;
      finally
        GlobalUnlock(Medium.hGlobal);
      end;
    finally
      ReleaseStgMedium(Medium);
    end;
  end
  else
    Result := '';
end;

И, наконец, приведем к окончательному виду метод Drop:

function Tfmain.Drop(const dataObj: IDataObject; grfKeyState: Integer;
  pt: TPoint; var dwEffect: Integer): HResult;
begin
  if IsRightFormat(dataObj,CF_UNICODETEXT) then
    Memo1.Lines.Add(GetText(dataObj,CF_UNICODETEXT))
  else
    GetFileList(dataObj,Memo1.Lines);
  Result:=S_OK;
end;

Теперь приложение будет работать следующим образом: если на форму бросают Текст в формате Unicode, например из MS Word, то в Memo будет выводится этот текст, иначе программа попытается вывести список файлов, брошенных на форму. Пример работы приложения представлен ниже:

Это приложение можно доработать как угодно — назначить действия программы в зависимости от принимаемых форматов, сделать копирование файлов в папку и т.д. и т.п., но, думаю, что представленных выше примеров будет достаточно, чтобы понять основные моменты по работе с IDropTarget и перейти к реализации обратной операции — Drag&Drop из приложения в Windows Explorer.

Пример использования IDropSource

Здесь нам предстоит «научить» нашу программу отправлять данные во вне. Для начала попробуем решить следующий вопрос: как с помощью Drag&Drop перемещать файлы из программы в проводник?

Первое, что нам необходимо — это каким-либо образом реализовать интерфейс IDropSource. Разу уж начали с главной формы приложение, то её и продолжим модифицировать. Изменяем описание класса формы следующим образом:

type
  Tfmain = class(TForm, IDropTarget, IDropSource)
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  protected
    [...]
    function QueryContinueDrag(fEscapePressed: BOOL;
      grfKeyState: Longint): HResult; stdcall;
    function GiveFeedback(dwEffect: Longint): HResult; stdcall;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

Для начала определимся как будут выглядеть методы QueryContinueDrag и GiveFeedback. Здесь всё довольно просто:

function Tfmain.GiveFeedback(dwEffect: Integer): HResult;
begin
  Result := DRAGDROP_S_USEDEFAULTCURSORS;
end;
 
function Tfmain.QueryContinueDrag(fEscapePressed: BOOL;
  grfKeyState: Integer): HResult;
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
    Result := S_OK;
end;

В GiveFeedback, используя DRAGDROP_S_USEDEFAULTCURSORS мы указываем, что операция прошла успешно и просим систему установить курсор по умолчанию.
В QueryContinueDrag мы последовательно проверяем какая кнопка мыши нажата и была ли нажата клавиша Esc и в зависимости от этого определяем — продолжать или нет операцию Drag&Drop.

А вот далее идёт самое сложно — как сделать так, чтобы Windows поняла, что мы хотим «выбросить» из своей программы в проводник? Т.е. научиться формировать IDataObject? Поиски по Сети привели меня к примеру такого метода на сайте Articles.org. Функция преобразования списка файлов в IDataObject выглядит следующим образом:

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;

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

type
  PArrayOfPItemIDList = ^TArrayOfPItemIDList;
  TArrayOfPItemIDList = array [0 .. 0] of PItemIDList;

Здесь определяется ссылка на объект, содержащий список ссылок на перемещаемые объекты, т.е. в нашем случае, перемещаемыми объектами будут файлы.

Malloc: IMalloc;

Интерфейс, реализующий методы управления памятью (выделение, освобождение, управление).

  Root: IShellFolder;
  Folder: IShellFolder;

Интерфейсы управления директориями.

FolderPidl: PItemIDList;

Ссылка на идентификатор объекта.

Теперь посмотрим, что делается в самом методе и походу дела попробуем подкорректировать исходник и привести его вид к современному состоянию API. Итак, вначале мы получаем ссылку на интерфейс IMalloc, используя вот такой метод:

SHGetMalloc(Malloc)

И этот код прекрасно работает в Windows 7. Однако, судя по примечанию на MSDN этот метод устарел и его использовать не рекомендуется. Ок, воспользуемся теми методами, которые ещё не устарели. Заменим это строку на эквивалентную:

  OleCheck(CoGetMAlloc(1,Malloc));

1 в первом параметре используется, согласно описанию метода CoGetMAlloc на MSDN. Следующий шаг — получение ссылки на интерфейс IShellFolder для рабочего стола:

SHGetDesktopFolder(Root)

Для чего мы получили ссылку на этот интерфейс посмотрим чуть ниже. На следующем шаге выполянется метод

Root.ParseDisplayName(0, nil, PWideChar(WideString(Directory)), chEaten, FolderPidl, dwAttributes)

Смотрим, что он из себя представляет. Метод ParseDisplayName имеет следующее описание:

function ParseDisplayName(
  in wnd:HWND;
  in pbcReserved:pointer;
  in pszDisplayName: PWideChar;
  out pchEaten:Cardinal;
  out ppidl:PItemIDList;
  in, out pdwAttributes:Cardinal;
):HRESULT;

wnd:HWND — дескриптор окна. Мы должны указывать этот параметр в том случае, если используем какой-либо диалог для выбора директории. В остальных случаях (как в нашем) можно указывать nil.
pbcReserved:pointer — опциональный параметр, представляющий собой ссылку на интерфейс IBindCtx.
pszDisplayName: PWideChar — ссылка на строку, содержащую путь к директории или файлу.
pchEaten:Cardinal — возвращает количество символов pszDisplayName, которые были преобразованы в результате выполнения метода.
ppidl:PItemIDList — указатель на идентификатор объекта, который был получен в результате выполнения метода.
pdwAttributes:Cardinal — битовая маска аттрибутов объекта. Если необходимо задать аттрибуты, то используются значения SFGAO_.

Следующий шаг — выполнение метода:

Root.BindToObject(FolderPidl, nil, IShellFolder, Pointer(Folder))

Метод BindToObject выполняется в том случае, когда клиенту (приложению) необходимо получить ссылку на конкретный объект, обычно это интерфейс IShellFolder. BindToObject имеет следующее описание:

function BindToObject(
  in pidl:PItemIDList;
  in pbcReserved:pointer;
  in riid: TGUID;
  out ppvOut: pointer;
):HRESULT;

pidl:PItemIDList — идентификатор объекта для которого необходимо получить ссылку.
pbcReserved:pointer — см. описание в параметрах ParseDisplayName
riid: TGUID — идентификатор интерфейса, который должен быть возвращен
ppvOut: pointer — указатель на интерфейс.

Следующий шаг, после того как получили интерфейс — создание списка идентификаторов:

  FileCount := Files.Count;
  p := AllocMem(SizeOf(PItemIDList) * FileCount);
  [...]
  for i := 0 to FileCount - 1 do
    begin
      OleCheck(Folder.ParseDisplayName(0, nil, PWideChar(WideString(Files[i])
        ), chEaten, p^[i], dwAttributes));
     end;

После того, как список идентификаторов успешно собран вызывается метод:

Folder.GetUIObjectOf(0, FileCount, p^[0], IDataObject, nil, Pointer(Result))

Метод GetUIObjectOf возвращает ссылку на объект, который можно использовать для дальнейших операций над файлами и директориями, т.е. ссылку на IDataObject. GetUIObjectOf имеет следующее описание:

function GetUIObjectOf(
  in hwndOwner:HWND;
  in cidl: cardinal;
  in apidl: PArrayOfPItemIDList;
  in riid: TGUID;
  in, out  rgfReserved:pointer;
  out ppv: pointer;
):HRESULT;

hwndOwner:HWND — ссылка на окно с диалогом.
cidl: cardinal — количество файлов или директорий, определенных в списке apidl
apidl: PArrayOfPItemIDList — список идентификаторов объектов
riid: TGUID — идентификатор интерфейса, который должен быть возвращен
rgfReserved:pointer — зарезервированный параметр (в настоящее время не используется)
ppv: pointer — ссылка на объект, полученный в результате выполнения метода. В нашем случае — это ссылка на IDataObject.
И в завершение методы очищаем память, занятую нашими объектами:

[...]
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;

Вот такой замечательный метод получения IDataObject. В изученной мной статье метод вызывается в обработчике OnMouseMove компонента TFileListBox (вкладка Win 3.1). Обработчик выглядит следующим образом:

const
  Threshold = 5;
var
  SelFileList: TStrings;
  i: Integer;
  DataObject: IDataObject;
  Effect: Integer;
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;

Здесь стоит отметить использование DoDragDrop. Этот метод в MSDN имеет следующее описание:

function DoDragDrop(
  in pDataObj: IDataObject;
  in pDropSource: IDropSource;
  in dwOKEffects: integer;
  out pdwEffect:integer;
):HRESULT;

pDataObj: IDataObject объект для Drag&Drop.
pDropSource: IDropSource — источник данных. В нашем случае — это форма приложения.
dwOKEffects, pdwEffect: integer — параметры, определяющие операцию Drag&Drop (копирование, создание ссылки, перемещение и т.д.). Полный перечень значений этих параметров можно найти на MSDN.

Оставшаяся часть кода статьи в целом будет понятна даже новичку в Delphi, поэтому приводить её в этой статье я не буду. Кому потребуется — вот ссылка на оригинал. Остается только заметить, что пример полностью рабочий и позволяет без проблем перемещать файлы из вашей программы в любую директорию Windows. Можете поэкспериментировать с параметрами DROPEFFECT_ и посмотреть как создавать ссылки на файлы, перемещать файлы из одной директории в другую, отменять Drag&Drop и т.д.

Вот такие получились «Заметки про Drag&Drop«…а думал статейка будет мелкой. Надеюсь, что информация, которую я собрал из разных уголков Сети и как-то систематизировал в этой заметке окажется полезной не только для меня, но и для Вас.

До следующих встреч в онлайне.