Глава 4. Перетаскивание: как это делается в OLE

Оказывается, перетаскивание файлов из File Manager — всего лишь частный случай более общего интерфейса перетаскивания OLE. С помощью интерфейса OLE ваше приложение может превратиться в сервер перетаскивания, способный передавать другим приложени ям не только файлы, но и данные других типов.

Знания — забавная штука. Точнее, даже не сами знания, а то, как они нам достаются. Мне почти всегда приходится изучать что-то новое методом проб и ошибок, хотя, если бы у меня был выбор (или, возможно, всего лишь чуть лучшая подготовка), я бы охотно предпочел другой метод. Тот, кто попытает ся написать приложение с поддержкой перетаскивания OLE на основе скудной информации, содержащейся в документации OLE и Windows Software Development Kit (SDK), пройдет полноценный курс выживания в экстремаль ных условиях. Я могу предъявить шрамы, доказывающие справедливость этих слов. 

Что такое OLE? 

За те несколько лет, что прошли с момента выхода первой версии, технология OLE несколько раз подвергалась усовершенствованиям и переимено ваниям. Кроме термина «OLE» использовались термин «OCX» и с недавних пор — «ActiveX». Эта технология, как бы ее ни называли, построена на основе спецификации COM (Component Object Model, многокомпонентная модель объекта), которая и представляет в данном случае наибольший интерес. COM — это просто способ определения интерфейса, который полностью скрывает его реализацию. Спецификация интерфейса COM похожа на интерфейс ную часть модуля Delphi — вы знаете, что делает интерфейс, но не видите, как он это делает. 

OLE в Windows — всего лишь набор частично реализованных спецификаций COM. Это нужно твердо усвоить. Например, интерфейс перетаскивания состоит из четырех основных интерфейсов: IDropTarget, IDropSource, IDataObject и IEnumFormatEtc. Но ни один из этих интерфейсов не реализован! Существуют функции, которые вызывают эти интерфейсы, однако вы сами должны написать код, который реализует эти интерфейсы и возвращает функциям Windows необходимые данные. OLE лишь определяет общие контуры — а вся грязная работа по их заполнению достается вам. 

Наследование OLE и TInterfacedObject 

Все объекты OLE наследуют такое поведение от IUnknown. Тем не менее они не обязаны наследовать реализацию этого поведения. Понятие наследования в OLE относится к спецификации интерфейса, а не к реализующему интерфейс коду. Тот факт, что все интерфейсы OLE являются производными от IUnknown, говорит лишь о том, что любой интерфейс OLE должен реализовать три функции, определенные в IUnknown. Это ни в коем случае не означает, что реализации IDropTarget и IDropSource имеют общий код, аналогично тому как объекты TControl и TWinControl совместно пользуются, например, кодом процедуры WMLButtonDown. Если бы вам захотелось реализовать эти два интерфейса на каком-нибудь другом, не объектно-ориентированном языке программирования, для каждой реализации понадобились бы свои собственные функции QueryInterface, AddRef и Release, каждая из которых могла бы при необходимости обратиться к общему коду. 

Delphi заметно упрощает работу с интерфейсами OLE (как, впрочем, и со всем остальным, что относится к Windows). В Delphi определен класс TInterfaced Object, который реализует интерфейс IUnknown и может использоваться в качестве базового класса для простых объектов OLE. Конечно, приятно знать, как работает интерфейс IUnknown, и все же, поверьте, — намного приятнее иметь возможность не задумываться об этом. Наши реализации всех четырех интерфейсов, используемых при перетаскивании, будут являться потомками TInterfacedObject. 

Замечание

В Delphi 2 интерфейсы OLE были реализованы с помощью модуля OLE2.PAS. В целях совместимости этот модуль был сохранен и в Delphi 3. Однако весь новый код следует писать на основе ACTIVEX.PAS и TInterfacedObject. Конечно, вы можете по-прежнему пользоваться OLE2, но это будет намного сложнее. Работая с таким великолепным инструментом, как Delphi, следует в полной мере использовать все достоинства новых технологий, предусмотренных в нем. 

Требования к перетаскиванию OLE 

Мы реализуем все три интерфейса, чтобы наше приложение могло выполнять функции как клиента (приемника), так и сервера (источника). 

Обязанности клиента 

1. Инициализировать библиотеки OLE вызовом OleInitialize. 
2. Создать экземпляр объекта, реализующего интерфейс IDropTarget. 
3. Заблокировать созданный экземпляр вызовом CoLockObjectExternal. 
4. Вызвать процедуру RegisterDragDrop, передав ей логический номер окна-приемника и экземпляр интерфейсного объекта IDropTarget. 
5. После завершения работы — снять блокировку с объекта, вызвать Revoke DragDrop, чтобы сообщить OLE о прекращении приема сбрасываемых данных, и вызвать OleUninitialize для завершения работы с библиотеками OLE.

1. Метод DragEnter вызывается в тот момент, когда курсор мыши входит в пределы окна. Метод должен определить тип перетаскиваемых данных и вернуть информацию о том, может ли окно принять данные, и если может, то как. Кроме того, DragEnter может предоставлять пользователю визуальную индикацию (например, изменять внешний вид курсора) и тем самым сообщать, разрешено ли в данный момент сбрасывание данных. 
2. Метод DragLeave вызывается, когда курсор мыши покидает пределы окна или пользователь отменяет операцию перетаскивания. Он должен освободить все ссылки на перетаскиваемые данные, а также устранить все признаки визуальной индикации перетаскивания. 
3. Метод DragOver вызывается при каждом перемещении курсора мыши внутри окна. Он может использоваться для организации визуальной индикации, а также сообщать OLE о том, разрешается ли сбрасывание данных в определенной точке окна. Метод DragOver многократно вызывается во время перетаскивания, поэтому он должен работать максимально быстро, в нем не должно происходить ничего лишнего. 
4. Метод Drop вызывается при завершении перетаскивания. Drop передает данные окну-приемнику, устраняет все признаки визуальной индикации и освобождает объект данных. Кроме того, он должен передать OLE информацию о статусе, чтобы можно было проинформировать объект-источник о завершении операции.

{ 

FILEDROP.PAS -- реализация простейшего приемника OLE. 

Автор: Джим Мишель 

Дата последней редакции: 28/05/97 

}
unit FileDrop;

interface

uses Windows, ActiveX, Classes;
type
  { TDragDropInfo слегка изменился по 
  сравнению с FMDD2.PAS }
  TDragDropInfo = class (TObject)
  private
    FInClientArea : Boolean;
    FDropPoint : TPoint;
    FFileList : TStringList;
  public
    constructor Create (ADropPoint : TPoint; 
    AInClient : Boolean);
    destructor Destroy; override;
    procedure Add (const s : String);

    property InClientArea : Boolean read 
    FInClientArea;
    property DropPoint : TPoint read 
    FDropPoint;
    property Files : TStringList read 
    FFileList;
  end;

  TFileDropEvent = procedure 
  (DDI : TDragDropInfo) 
  of object;

  { TFileDropTarget знает, как принимать 
  сброшенные файлы }
  TFileDropTarget = class (TInterfacedObject, 
  IDropTarget)
  private
    FHandle : HWND;
    FOnFilesDropped : TFileDropEvent;
  public
    constructor Create (Handle: HWND; 
    AOnDrop: TFileDropEvent);
    destructor Destroy; override;

    { из IDropTarget }
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;

    property OnFilesDropped : TFileDropEvent
      read FOnFilesDropped 
      write FOnFilesDropped;
  end;

implementation

uses ShellAPI;

{ TDragDropInfo }

constructor TDragDropInfo.Create
    (
      ADropPoint : TPoint;
      AInClient : Boolean
    );
begin
  inherited Create;
  FFileList := TStringList.Create;
  FDropPoint := ADropPoint;
  FInClientArea := AInClient;
end;

destructor TDragDropInfo.Destroy;
begin
  FFileList.Free;
  inherited Destroy;
end;

procedure TDragDropInfo.Add
    (
      const s : String
    );
begin
  Files.Add (s);
end;

{ TFileDropTarget }

constructor TFileDropTarget.Create
    (
      Handle: HWND;
      AOnDrop: TFileDropEvent
    );
begin
  inherited Create;
  _AddRef;
  FHandle := Handle;
  FOnFilesDropped := AOnDrop;
  ActiveX.CoLockObjectExternal(Self, 
  true, false);
  ActiveX.RegisterDragDrop (FHandle, Self);
end;

{ Destroy снимает блокировку с объекта 
и разрывает связь с ним }
destructor TFileDropTarget.Destroy;
var
  WorkHandle: HWND;
begin
  {
    Если значение FHandle не равно 0, 
    значит, связь с окном все 
    еще существует. Обратите внимание 
    на то, что FHandle необходимо
    прежде всего присвоить 0, потому 
    что CoLockObjectExternal и
    RevokeDragDrop вызывают Release, 
    что, в свою очередь, может
    привести к вызову Free и зацикливанию 
    программы.
    Подозреваю, что этот фрагмент не 
    совсем надежен. Если объект будет
    освобожден до того, как 
    счетчик ссылок упадет до 0,
    может возникнуть исключение.
  }
  if (FHandle <> 0) then
  begin
    WorkHandle := FHandle;
    FHandle := 0;
    ActiveX.CoLockObjectExternal 
    (Self, false, true);
    ActiveX.RevokeDragDrop (WorkHandle);
  end;

  inherited Destroy;
end;

function TFileDropTarget.DragEnter
    (
      const dataObj: IDataObject;
      grfKeyState: Longint;
      pt: TPoint;
      var dwEffect: Longint
    ): HResult; stdcall;
begin
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;

function TFileDropTarget.DragOver
    (
      grfKeyState: Longint;
      pt: TPoint;
      var dwEffect: Longint
    ): HResult; stdcall;
begin
  dwEffect := DROPEFFECT_COPY;
  Result := S_OK;
end;

function TFileDropTarget.DragLeave: 
HResult; stdcall;
begin
  Result := S_OK;
end;

{
  Обработка сброшенных данных.
}
function TFileDropTarget.Drop
    (
      const dataObj: IDataObject;
      grfKeyState: Longint;
      pt: TPoint;
      var dwEffect: Longint
    ): HResult; stdcall;
var
  Medium : TSTGMedium;
  Format : TFormatETC;
  NumFiles: Integer;
  i : Integer;
  rslt : Integer;
  DropInfo : TDragDropInfo;
  szFilename : array [0..MAX_PATH] of char;
  InClient : Boolean;
  DropPoint : TPoint;
begin
  dataObj._AddRef;
  {
    Получаем данные.  Структура TFormatETC 
    сообщает 
    dataObj.GetData, как получить данные 
    и в каком формате
    они должны храниться (эта информация 
    содержится в 
    структуре TSTGMedium).
  }
  Format.cfFormat := CF_HDROP;
  Format.ptd      := Nil;
  Format.dwAspect := DVASPECT_CONTENT;
  Format.lindex   := -1;
  Format.tymed    := TYMED_HGLOBAL;

  { Заносим данные в структуру Medium }
  rslt := dataObj.GetData (Format, Medium);

  {
    Если все прошло успешно, далее 
    действуем, как при операции файлового
    перетаскивания FMDD.
  }
  if (rslt = S_OK) then
  begin
    { Получаем количество файлов и 
    прочие сведения }
    NumFiles := DragQueryFile 
    (Medium.hGlobal, $FFFFFFFF, NIL, 0);
    InClient := DragQueryPoint 
    (Medium.hGlobal, DropPoint);

    { Создаем объект TDragDropInfo }
    DropInfo := TDragDropInfo.Create 
    (DropPoint, InClient);

    { Заносим все файлы в список }
    for i := 0 to NumFiles - 1 do
    begin
      DragQueryFile (Medium.hGlobal, i, 
      szFilename,
                     sizeof(szFilename));
      DropInfo.Add (szFilename);
    end;
    { Если указан обработчик, вызываем его }
    if (Assigned (FOnFilesDropped)) then
    begin
      FOnFilesDropped (DropInfo);
    end;

    DropInfo.Free;
  end;
  if (Medium.unkForRelease = nil) then
    ReleaseStgMedium (Medium);

  dataObj._Release;
  dwEffect := DROPEFFECT_COPY;
  result := S_OK;
end;

initialization
  OleInitialize (Nil);

finalization
  OleUninitialize;

end.

Обратите внимание на то, что функции OleInitialize и OleUninitialize вызываются соответственно в секциях initialization и finalization данного модуля. Тем самым мы гарантируем, что библиотеки OLE будут инициализи рованы до первого обращения к ним из модуля и деинициализированы лишь после того, как работа с ними будет закончена. 

Перед тем как переходить к подробному обсуждению реализации, давайте построим простейшую форму, в которой прием сброшенных данных организован с помощью объекта TOleDropTarget. Эта форма во многом похожа на остальные примеры, использованные в предыдущей главе. На ней присутствует всего один компонент — список, на который можно сбрасывать файлы из Windows Explorer. В листинге 4.2 содержатся методы этой формы. 

{ 

DRAGFRM1.PAS -- Прием файлов средствами OLE 

Автор: Джим Мишель 

Дата последней редакции: 28/05/97 

}

unit dragfrm1;
interface

uses
  Windows, Messages, SysUtils, Classes, 
  Graphics, Controls, Forms,
  Dialogs, StdCtrls, FileDrop;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; 
    var Action: TCloseAction);
  private
    { Private declarations }
    FDropTarget: TFileDropTarget;
    procedure OnFilesDropped 
    (DropInfo: TDragDropInfo);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  { Создаем приемник }
  FDropTarget := TFileDropTarget.Create 
  (Listbox1.Handle, OnFilesDropped);
end;

procedure TForm1.FormClose(Sender: TObject; 
var Action: TCloseAction);
begin
  FDropTarget.Free;
end;

{
  OnFilesDropped вызывается 
  при получении файлов
  объектом TFileDropTarget.
}
procedure TForm1.OnFilesDropped 
(DropInfo: TDragDropInfo);
var
  i : Integer;
begin
  { Заносим все файлы в список }
  for i := 0 to DropInfo.Files.Count-1 
  do begin
    Listbox1.Items.Add (DropInfo.Files[i]);
  end;
end;

end.

Если откомпилировать и запустить эту программу, вы сможете перетаски вать файлы из Windows Explorer или File Manager и бросать их на компонент -список. Имена файлов отображаются в списке, как это происходило в примере из предыдущей главы. 

Как работает программа 

Другой класс, TFileDropTarget, реализует интерфейс IDropTarget. Определение этого класса выглядит так: 

TFileDropTarget = class (TInterfacedObject, IDropTarget) 

Если вы по уши влюблены в C++, не спешите торжествовать. Если же вы полагаете, что множественное наследование изобрел сам дьявол для искушения начинающих программистов, не торопитесь убегать с воплями ужаса. То, что вы здесь видите, не является множественным наследованием. Этот странный фрагмент говорит: «TFileDropTarget является потомком TInterfaced Object и реализует интерфейс IDropTarget». Один класс действительно может реализовывать несколько интерфейсов, но ситуация не имеет ничего общего со множественным наследованием. 

В файле ACTIVEX.PAS, находящемся в каталоге Delphi Source\RTL\WIN, содержится следующее объявление интерфейса IDropTarget: 

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;

Первая строка лишь сообщает о том, что интерфейс IDropTarget является наследником IUnknown. Следующая строка определяет глобально-уникальный идентификатор интерфейса (Globally Unique Identifier, GUID). GUID представляет собой 128-битное число, уникальное для каждого типа объекта. Фирма Microsoft назначила GUID всем стандартным интерфейсам OLE. Существуют программы (и даже функция API), генерирующие новые GUID. С точки зрения статистики крайне маловероятно, чтобы два сгенерированных GUID совпали. В любом случае для использования готовых интерфейсов OLE вовсе не обязательно разбираться в механике GUID, но если вы собираетесь создавать собственные интерфейсы, обязательно научитесь генерировать GUID и работать с ними в программах. 

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

Следовательно, интерфейсы чем-то похожи на классы — они тоже описывают поведение объектов. Но в отличие от классов интерфейсы не имеют категорий доступа (private, public, protected и т. д.) и не объявляют переменных или свойств. Кроме того (и опять же в отличие от классов), интерфейсы не имеют обязательных реализаций. Ни в ACTIVEX.PAS, ни в каком другом месте вы не найдете такой строки: 

function IDropTarget.DragLeave : HResult; 

Во всем листинге 4.1 заслуживает внимания лишь одна часть приемника — метод TFileDropTarget.Drop, вызываемый OLE при сбрасывании файлов пользователем. Эта функция должна получить данные от объекта и передать их окну. Передача происходит в процедуре события FOnFilesDropped, вызываемой Drop после получения данных. Эта функция и принцип ее действия очень напоминают TFMDDEvent из предыдущей главы. 

С другой стороны, с получением данных дело обстоит несколько сложнее. 

Чтобы получить перетаскиваемые данные, Drop заполняет структуру TFormatETC, которая описывает представление данных, и передает ее вместе со структурой TStgMedium методу GetData объекта данных. GetData форматирует данные в соответствии с содержимым структуры TFormatETC и возвращает их в структуре TStgMedium. Затем Drop может работать с данными, что в нашем случае означает создание структуры TDragDropInfo. Когда метод Drop завершает обработку данных, он должен освободить структуру TStgMedium. Последний момент чрезвычайно важен — особенно если вы занимаетесь реализацией источника. За освобождение данных отвечает клиент , то есть приемник. Это означает, что реализация GetData из объекта данных должна предоставить копию данных, а не сами данные. Возможно, сейчас это кажется вам очевидным. Мне это тоже кажется очевидным… после того, как я потратил почти два дня на отладку программы! 

Как ни странно, приведенная реализация приемника оказалась проще, чем вариант из главы 3. Видимо, мы нередко склонны преувеличивать сложность задач. И все же признаюсь, что на освоение COM и TInterfacedObject у меня ушло немало времени — намного больше, чем на обработку WM_DROPFILES. 

Что дальше? 

Хочу быть сервером! 

Замечание

Конечно, мои трудности отчасти были обусловлены недостатком опыта работы с OLE и COM, но я твердо убежден в том, что больше всего проблем вызвали излишняя сложность интерфейса и совершенно неудовлетворительная документация. Я достаточно хорошо владею C и C++, так что меня уже не пугает документация Windows SDK, качество которой варьируется от нулевого до условно-полезного. С другой стороны, примеры из SDK не назовешь понятными или полезными даже для опытного программиста на C++. Вместо изощренных примеров OLE, которые пытаются объяснить все сразу и в итоге не объясняют толком ничего, гораздо больше пользы принесли бы простые программы, просто и наглядно поясняющие конкретные концепции. Изучение файла OLECTNRS.PAS (из каталога Delphi Source\VCL) дало мне больше, чем все примеры Microsoft SDK. 

Обязанности сервера 

1. На основании действий пользователя определить, что были выделены данные для перетаскивания. 
2. Вызвать OleInitialize, чтобы инициализировать библиотеки OLE. 
3. Создать экземпляр объекта, реализующего интерфейс IDropSource. Этот объект управляет пользовательским интерфейсом во время операции перетаскивания. 
4. Создать экземпляр объекта, реализующего интерфейс IDataObject. Этот объект содержит перетаскиваемые данные. 
5. Начать операцию перетаскивания, вызвав функцию OLE DoDragDrop и передав ей объекты IDropSource и IDataObject. DoDragDrop управляет операцией перетаскивания и вызывает методы объектов IDropSource и IDropTarget для всех окон, зарегистрированных функцией RegisterDragDrop, над которыми проходит курсор мыши во время перетаскивания. 
6. Сгенерировать признаки визуальной индикации на время перетаски вания — например, изменить внешний вид курсора. 
7. Выполнить необходимые действия с исходными данными на основании результатов перетаскивания. Например, результатом операции перемещения (move) является удаление исходных данных. 
8. После возврата из DoDragDrop уничтожить экземпляры объектов IDataObject и IDropSource. 
9. Вызвать OleUnitialize, чтобы завершить работу с библиотеками OLE.

Требования к интерфейсу IDropSource 

1. Следить за состоянием клавиатуры или кнопок мыши и определять, что следует делать дальше — продолжить, завершить или отменить перетаскивание. 
2. Реагировать на перемещение курсора мыши, изменяя его внешний вид или предоставляя другие признаки визуальной индикации.

IDropSource = interface(IUnknown) 

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

Метод QueryContinueDrag вызывается функцией DoDragDrop при каждом изменении состояния клавиатуры или кнопок мыши во время операции перетаскивания. На основании переменных fEscapePressed и grfKeyState он определяет дальнейшие действия — продолжение, завершение или отмену операции. 

Метод GiveFeedback вызывается функцией DoDragDrop при каждом изменении состояния мыши во время перетаскивания. Основная задача GiveFeedback — предоставление визуальной индикации хода операции. Чаще всего такая индикация сводится к изменению внешнего вида курсора. DoDragDrop вызывает GiveFeedback после вызова методов DragEnter, DragLeave или DragOver интерфейса IDropSource и передает ему значение DROPEFFECT, возвращаемое методом IDRopTarget. 

Интерфейс IDropSource обычно выглядит очень просто, особенно если учесть, что OLE определяет стандартное поведение, которое несложно реализовать. 

Интерфейс IDataObject хранит данные 

Интерфейс IDataObject предоставляет средства для передачи данных и сообщений об изменениях. Его методы предназначены для занесения данных в объект, представления их в различных (как правило, зависящих от конкретного устройства) форматах, возврата информации о поддерживаемых форматах и уведомления других объектов об изменении данных. Хотя для перетаскивания файлов в окно Windows Explorer или File Manager необходимо полностью реализовать лишь три метода IDataObject, в совокупности эти три метода оказываются весьма объемными. 

Итак, чтобы создать сервер для перетаскивания файлов, нужно реализовать три метода IDataObject: QueryGetData, GetData и EnumFormatEtc. А чтобы реализовать метод EnumFormatEtc, понадобится реализовать и интерфейс IEnumFormatEtc. Я же говорил, что с реализацией интерфейсов все стремительно усложняется. 

Метод QueryGetData вызывается приемником перетаскивания. Ему передается структура TFormatEtc, которая описывает формат данных, желательный для приемника. QueryGetData должен сообщить приемнику о том, может ли объект представить данные в требуемом формате. Он возвращает S_OK в том случае, если последующий вызов GetData с большой долей вероятности закончится успешно. В некоторых случаях (например, при нехватке памяти) последующий вызов GetData все равно может закончиться неудачей. 

Когда приемник хочет получить данные, он вызывает метод GetData. Приемник передает структуру TFormatEtc с описанием желательного формата данных и структуру TStgMedium, в которую GetData поместит запрашиваемые данные. Вызывающая сторона (то есть приемник) должна освободить структуру TStgMedium после того, как обработка данных будет завершена. Этот момент чрезвычайно важен. Поскольку клиент уничтожает данные, возвращаемые GetData, метод должен передавать копию данных объекта. Если GetData передаст настоящие данные, клиент благополучно уничтожит их, и следующая попытка клиента (или самого объекта-источника) обратиться к данным приведет к катастрофе. 

Метод EnumFormatEtc сообщает о том, в каких форматах объект может воспроизвести свои данные. Информация передается в виде объекта IEnum FormatEtc, а это означает, что для реализации IDataObject нам придется реализовать и интерфейс IEnumFormatEtc. Среди примеров OLE SDK приведено немало реализаций IEnumFormatEtc — но все они написаны на C или C++ и выглядят, мягко говоря, устрашающе. К счастью, классы TOleForm и TOleContainer из OLECNTNRS.PAS содержат более простой вариант, которым я воспользовался как шаблоном для своей реализации. После этого примеры IEnumFormatEtc из OLE SDK начали обретать для меня смысл, но без OLECTRNS.PAS я бы до сих пор рвал на себе волосы от отчаяния. 

Интерфейс IEnumFormatEtc содержит четыре метода: Next, Skip, Reset и Clone, с помощью которых приложения могут перебирать и просматривать поддержи ваемые форматы данных, а также копировать список этих форматов. Универсальная реализация IEnumFormatEtc выглядит очень сложно, поскольку она должна уметь динамически выделять память под структуры TFormatEtc и копировать внутренние данные, содержащиеся в этих структурах. Такие сложности нам не нужны, поэтому предполагается, что рабочий массив TFormatEtc содержит статические данные. Для наших целей сойдет и так, но во многих приложениях это условие приведет к излишне строгим ограничениям. Предлагае мая реализация IEnumFormatEtc приведена в листинге 4.3. 

{ 

ENUMFMT.PAS -- реализация интерфейса IEnumFormatEtc. 

Автор: Джим Мишель 

Дата последней редакции: 30/05/97 

Приведенная реализация IEnumFormatEtc недостаточно надежна. 

Она предполагает, что список FormatList, поддерживаемый объектом 

TEnumFormatEtc, хранится в виде статического массива. Для простых 

объектов наподобие сервера для перетаскивания файлов этого достаточно, но во многих 

приложениях такое ограничение оказывается неприемлемым. 

}
unit EnumFmt;

interface

uses Windows, ActiveX;

type
  { TFormatList -- массив записей TFormatEtc }
  PFormatList = ^TFormatList;
  TFormatList = array[0..1] of TFormatEtc;

  TEnumFormatEtc = class (TInterfacedObject, 
  IEnumFormatEtc)
  private
    FFormatList: PFormatList;
    FFormatCount: Integer;
    FIndex: Integer;
  public
    constructor Create
      (FormatList: PFormatList; FormatCount, 
      Index: Integer);
    { IEnumFormatEtc }
    function Next
      (celt: Longint; out elt; 
      pceltFetched: PLongint): HResult; stdcall;
    function Skip (celt: Longint) : HResult; 
    stdcall;
    function Reset : HResult; stdcall;
    function Clone (out enum : IEnumFormatEtc) : 
    HResult; stdcall;
  end;

implementation

constructor TEnumFormatEtc.Create
    (
      FormatList: PFormatList;
      FormatCount, Index : Integer
    );
begin
  inherited Create;
  FFormatList := FormatList;
  FFormatCount := FormatCount;
  FIndex := Index;
end;

{
  Next извлекает заданное количество 
  структур TFormatEtc
  в передаваемый массив elt.
  Извлекается celt элементов, начиная с 
  текущей позиции в списке.
}
function TEnumFormatEtc.Next
    (
      celt: Longint;
      out elt;
      pceltFetched: PLongint
    ): HResult;
var
  i : Integer;
  eltout : TFormatList absolute elt;
begin
  i := 0;

  while (i < celt) and (FIndex < 
  FFormatCount) do
  begin
    eltout[i] := FFormatList[FIndex];
    Inc (FIndex);
    Inc (i);
  end;

  if (pceltFetched <> nil) then
    pceltFetched^ := i;

  if (I = celt) then
    Result := S_OK
  else
    Result := S_FALSE;
end;

{
  Skip пропускает celt элементов списка, 
  устанавливая текущую позицию
  на (CurrentPointer + celt) или на конец 
  списка в случае переполнения.
}
function TEnumFormatEtc.Skip
    (
      celt: Longint
    ): HResult;
begin
  if (celt <= FFormatCount - FIndex) then
  begin
    FIndex := FIndex + celt;
    Result := S_OK;
  end else
  begin
    FIndex := FFormatCount;
    Result := S_FALSE;
  end;
end;

{ Reset устанавливает указатель текущей 
позиции на начало списка }
function TEnumFormatEtc.Reset: HResult;
begin
  FIndex := 0;
  Result := S_OK;
end;

{ Clone копирует список структур }
function TEnumFormatEtc.Clone
    (
      out enum: IEnumFormatEtc
     ): HResult;
begin
  enum := TEnumFormatEtc.Create 
  (FFormatList, FFormatCount, FIndex);
  Result := S_OK;
end;

end.

Реализация сервера 

var
  RequiredSize : Integer;
  i : Integer;
  hGlobalDropInfo : HGlobal;
  DropFiles : PDropFiles;
  c : PChar;
begin
  {
    Построим структуру TDropFiles в памяти, 
    выделенной через
    GlobalAlloc. Область памяти сделаем глобальной 
    и совместной,
    поскольку она, вероятно, будет передаваться 
    другому процессу.
  }

  { Определяем необходимый размер структуры }
  RequiredSize := sizeof (TDropFiles);
  for i := 0 to Self.Files.Count-1 do
  begin
    { Длина каждой строки, плюс 1 байт для 
    терминатора }
    RequiredSize := RequiredSize + 
    Length (Self.Files[i]) + 1;
  end;
  { 1 байт для завершающего терминатора }
  inc (RequiredSize);

  hGlobalDropInfo := GlobalAlloc
((GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT), 
      RequiredSize);
  if (hGlobalDropInfo <> 0) then
  begin
    { Заблокируем область памяти, чтобы к ней 
      можно было обратиться
    }
    DropFiles := GlobalLock (hGlobalDropInfo);

    { Заполним поля структуры DropFiles }
    {
      pFiles -- смещение от начала 
      структуры до первого байта массива
      с именами файлов.
    }
    DropFiles.pFiles := sizeof (TDropFiles);
    DropFiles.pt := Self.FDropPoint;
    DropFiles.fNC := Self.InClientArea;
    DropFiles.fWide := False;

    {
      Копируем каждое имя файла в буфер.
      Буфер начинается со смещения 
      DropFiles + DropFiles.pFiles,
      то есть после последнего поля структуры.
    }
    c := PChar (DropFiles);
    c := c + DropFiles.pFiles;
    for i := 0 to Self.Files.Count-1 do
    begin
      StrCopy (c, PChar (Self.Files[i]));
      c := c + Length (Self.Files[i]);
    end;

    { Снимаем блокировку }
    GlobalUnlock (hGlobalDropInfo);
  end;

  Result := hGlobalDropInfo;
end;

Данная функция вычисляет требуемый размер данных (он равен размеру записи 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. За освобождение данных отвечает вызывающая сторона (то есть клиент перетаски вания). 

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. В первом случае имя файла просто отображается в списке, а во втором файл копируется в указанное место¹. Текст процедуры TForm1.Label1MouseDown, инициирующей перетаскивание, приведен в листинге 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 управляет операцией и по мере надобности 

¹ Разумеется, чтобы 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;

OLE! 

В этой главе мы лишь скользнули по поверхности OLE. Если вас заинтересуют стандартные интерфейсы, возьмите любой справочник по OLE из тех, что можно найти в каждом магазине. Кроме того, попробуйте обратиться к Windows SDK, где описаны все интерфейсы и реализованные в Windows функции OLE. Впрочем, если вы не владеете C, SDK вряд ли принесет много пользы. 

Чтобы получить дополнительную информацию о создании и использовании интерфейсов OLE, изучите объекты Delphi TComObject и TActiveXControl, а также прочитайте главу 25 из руководства пользователя по Delphi 3 и всю часть IV, «Working with COM and ActiveX», из руководства программиста. Как всегда, обращайтесь к своему надежному другу — электронной документации. 

О модели программирования COM можно рассказывать очень долго. Если вам удалось определить для объекта минимальный, но функционально полный интерфейс (в котором клиент полностью изолирован от внутреннего представления данных), то вы, вероятно, очень хорошо представляете себе, что делает ваш объект. Кроме того, тем самым вы проводите четкую границу между «что» и «как». Как показывает опыт, с усложнением программ наиболее важной частью работы становится определение интерфейсов между различными частями программы. Если спроектированные интерфейсы будут просты и удобны, вам будет проще реализовать их и наладить совместную работу компонентов. В результате получится более логичная программа, содержащая меньшее количество ошибок, которую будет проще изменить при необходи мости. Такие интерфейсы можно определять и без COM, но идея взаимодействия между объектами через систему четко определенных интерфейсов уже доказала свою несомненную эффективность.