Реализация сервера
Приемники OLE-перетаскивания, работающие с файлами, рассчитывают получить данные в формате буфера обмена CF_HDROP. Этот формат используется в первом примере этой главы, он же присутствует и в реализации WM_DROPFILES, хотя этот факт скрыт за DragQueryFile и другими функциями API. Поскольку мы реализуем сервер перетаскивания, нам потребуется способ преобразования списка файлов в данные формата CF_HDROP. У нас уже есть класс TDragDropInfo, который ведет учет файлов из списка, поэтому такой метод было бы разумно включить в этот класс. Новый метод TDragDropInfo.CreateHDrop приведен в листинге 4.4.
Листинг 4.4. TDragDropInfo.CreateHDrop преобразует информацию
о перетаскиваемых файлах
function TDragDropInfo.CreateHDrop : HGlobal;
Данная функция вычисляет требуемый размер данных (он равен размеру записи TDropFiles, определенной в модуле ShlObj, плюс общая длина всех имен файлов), выделяет область памяти и заполняет структуру. Память выделяет ся из глобального пула (global heap) Windows с атрибутом «общая» (GMEM_SHARE), чтобы ее можно было передавать другим приложениям. Обращения к выделенной памяти осуществляются через логический номер типа HGlobal. Имен
но его мы возвращаем вызывающей стороне, которая обязана освободить данные (функцией API GlobalFree) после завершения работы с ними.
Интерфейсы IDropSource и IDataObject реализуются в файле DRAGDROP.PAS (листинг 4.5) объектами TFileDropSource и THDropDataObject соответственно. Объект TFileDropSource выглядит очень просто. Его конструктор просто вызывает конструктор TInterfacedObject, а затем задает начальное значение счетчика ссылок функцией _AddRef. Функция GiveFeedback просто приказывает DoDragDrop использовать стандартные варианты курсора, а QueryContinueDrag проверяет флаг клавиши Escape и состояние кнопок мыши, определяя по ним, следует ли завершить, продолжить или отменить операцию перетаскивания. В общем, ничего необычного.
THDropDataObject выглядит посложнее. Конструктор создает объект TDragDrop Info, который представляет собой пустой список файлов. Затем вызывающая сторона заносит файлы в список методом Add. Деструктор объекта освобожда ет объект TDragDropInfo, если он существует. Из всех методов интерфейса IData Object реализованы только GetData, QueryGetData и EnumFormatEtc. Другие методы возвращают коды, показывающие, что они (методы) не поддерживаются объектом.
QueryGetData просматривает переданную запись TFormatEtc и проверяет, поддерживается ли формат запрашиваемых данных. Если формат поддержи вается, код возврата показывает, что GetData, вероятно, сможет воспроизвес ти данные. EnumFormatEtc создает и возвращает объект IEnumFormatEtc по статическому массиву структур TFormatEtc. Функция GetData проверяет, допустим ли запрашиваемый формат (для чего снова вызывает QueryGetData), убеждается в наличии данных для воспроизведения и затем вызывает TDragDropInfo.Create HDrop. Последний метод создает глобальную область памяти, которая возвращается вызывающей стороне через передаваемую запись TStgMedium. За освобождение данных отвечает вызывающая сторона (то есть клиент перетаски вания).
Листинг 4.5. DRAGDROP.PAS: интерфейсы, необходимые
для работы сервера перетаскивания
{
DRAGDROP.PAS -- реализация OLE-перетаскивания.
Автор: Джим Мишель
Дата последней редакции: 30/05/97
} unit DragDrop; interface uses Windows, ActiveX, Classes, FileDrop; type { TFileDropSource - источник для перетаскивания файлов } TFileDropSource = class (TInterfacedObject, IDropSource) constructor Create; function QueryContinueDrag (fEscapePressed: BOOL; grfKeyState: Longint): HResult; stdcall; function GiveFeedback(dwEffect: Longint): HResult; stdcall; end; { THDropDataObject - объект данных с информацией о перетаскиваемых файлах } THDropDataObject = class(TInterfacedObject, IDataObject) private FDropInfo : TDragDropInfo; public constructor Create(ADropPoint : TPoint; AInClient : Boolean); destructor Destroy; override; procedure Add (const s : String); { из IDataObject } 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; implementation uses EnumFmt; { TFileDropSource } constructor TFileDropSource.Create; begin inherited Create; _AddRef; end; { QueryContinueDrag определяет необходимые действия. Функция предполагает, что для перетаскивания используется только левая кнопка мыши. } function TFileDropSource.QueryContinueDrag ( fEscapePressed: BOOL; grfKeyState: Longint ): HResult; begin if (fEscapePressed) 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 TFileDropSource.GiveFeedback ( dwEffect: Longint ): HResult; begin case dwEffect of DROPEFFECT_NONE, DROPEFFECT_COPY, DROPEFFECT_LINK, DROPEFFECT_SCROLL : Result := DRAGDROP_S_USEDEFAULTCURSORS; else Result := S_OK; end; end; { THDropDataObject } constructor THDropDataObject.Create ( ADropPoint : TPoint; AInClient : Boolean ); begin inherited Create; _AddRef; FDropInfo := TDragDropInfo.Create (ADropPoint, AInClient); end; destructor THDropDataObject.Destroy; begin if (FDropInfo <> nil) then FDropInfo.Free; inherited Destroy; end; procedure THDropDataObject.Add ( const s : String ); begin FDropInfo.Add (s); end; function THDropDataObject.GetData ( const formatetcIn: TFormatEtc; out medium: TStgMedium ): HResult; begin Result := DV_E_FORMATETC; { Необходимо обнулить все поля medium на случай ошибки} medium.tymed := 0; medium.hGlobal := 0; medium.unkForRelease := nil; { Если формат поддерживается, создаем и возвращаем данные } if (QueryGetData (formatetcIn) = S_OK) then begin if (FDropInfo <> nil) then begin medium.tymed := TYMED_HGLOBAL; { За освобождение отвечает вызывающая сторона! } medium.hGlobal := FDropInfo.CreateHDrop; Result := S_OK; end; end; end; function THDropDataObject.GetDataHere ( const formatetc: TFormatEtc; out medium: TStgMedium ): HResult; begin Result := DV_E_FORMATETC; { К сожалению, не поддерживается } end; function THDropDataObject.QueryGetData ( const formatetc: TFormatEtc ): HResult; begin Result := DV_E_FORMATETC; with formatetc do if dwAspect = DVASPECT_CONTENT then if (cfFormat = CF_HDROP) and (tymed = TYMED_HGLOBAL) then Result := S_OK; end; function THDropDataObject.GetCanonicalFormatEtc ( const formatetc: TFormatEtc; out formatetcOut: TFormatEtc ): HResult; begin formatetcOut.ptd := nil; Result := E_NOTIMPL; end; function THDropDataObject.SetData ( const formatetc: TFormatEtc; var medium: TStgMedium; fRelease: BOOL ): HResult; begin Result := E_NOTIMPL; end; { EnumFormatEtc возвращает список поддерживаемых форматов } function THDropDataObject.EnumFormatEtc ( dwDirection: Longint; out enumFormatEtc: IEnumFormatEtc ): HResult; const DataFormats: array [0..0] of TFormatEtc = ( ( cfFormat : CF_HDROP; ptd : Nil; dwAspect : DVASPECT_CONTENT; lindex : -1; tymed : TYMED_HGLOBAL; ) ); DataFormatCount = 1; begin { Поддерживается только Get. Задать содержимое данных нельзя } if dwDirection = DATADIR_GET then begin enumFormatEtc := TEnumFormatEtc.Create (@DataFormats, DataFormatCount, 0); Result := S_OK; end else begin enumFormatEtc := nil; Result := E_NOTIMPL; end; end; { Функции Advise не поддерживаются } function THDropDataObject.DAdvise ( const formatetc: TFormatEtc; advf: Longint; const advSink: IAdviseSink; out dwConnection: Longint ): HResult; begin Result := OLE_E_ADVISENOTSUPPORTED; end; function THDropDataObject.DUnadvise ( dwConnection: Longint ): HResult; begin Result := OLE_E_ADVISENOTSUPPORTED; end; function THDropDataObject.EnumDAdvise ( out enumAdvise: IEnumStatData ): HResult; begin Result := OLE_E_ADVISENOTSUPPORTED; end; initialization OleInitialize (Nil); finalization OleUninitialize; end.Последнее, что осталось сделать, — создать форму, которая сможет воспользоваться этим новым модулем. Я взял форму из предыдущего примера и добавил на нее компонент-метку (TLabel) с текстом "D:\TESTO.TXT". Если щелкнуть на этом компоненте, начинается операция перетаскивания OLE. Вы можете перетащить и бросить файл на список в форме или в окно Windows Explorer. В первом случае имя файла просто отображается в списке, а во втором файл копируется в указанное место1. Текст процедуры TForm1.Label1MouseDown, инициирующей перетаскивание, приведен в листинге 4.6.
Листинг 4.6. Начало операции перетаскивания
procedure TForm1.Label1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); var DropSource : TFileDropSource; DropData : THDropDataObject; rslt : HRESULT; dwEffect : DWORD; DropPoint : TPoint; begin if (Button = mbLeft) then begin { Создаем объект-источник... } DropSource := TFileDropSource.Create; { ...и объект данных } DropPoint.x := 0; DropPoint.y := 0; DropData := THDropDataObject.Create (DropPoint, True); DropData.Add (Label1.Caption); {DoDragDrop управляет операцией и по мере надобности
1 Разумеется, чтобы Windows было что копировать, следует предварительно создать файл с указанным именем в корневом каталоге диска D:. — Примеч. ред.
вызывает методы IDropSource и IDropTarget.
} rslt := DoDragDrop (DropData, DropSource, DROPEFFECT_COPY, dwEffect); if ((rslt <> DRAGDROP_S_DROP) and (rslt <> DRAGDROP_S_CANCEL)) then begin case rslt of E_OUTOFMEMORY : ShowMessage ('Out of memory'); else ShowMessage ('Something bad happened'); end; end; { Освобождаем использованные ресурсы после завершения работы } DropSource.Free; DropData.Free; end; end;