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

С перетаскиванием в Windows дело обстоит сложнее, чем кажется на первый взгляд, — но если бы все было просто, кто стал бы читать книги по программированию?

Программы на Delphi поддерживают как минимум три разных интерфейса перетаскивания. В классе TControl, являющемся общим предком для всех управляющих элементов Delphi, определен межэлементный интерфейс перетаскивания. Включая в программу на Delphi обработчики для OnDragDrop, OnDragOver и других аналогичных событий, вы сможете наделить ее поддержкой внутренних операций перетаскивания. Если приложить некоторые усилия и использовать общую область памяти, метод можно расширить и организовать взаимодействие двух программ, написанных на Delphi. Тем не менее он не подойдет для перетаскивания между приложением, написанным на Delphi, и посторонней программой. Данный интерфейс наглядно поясняется документацией Delphi и программами-примерами. 

Интерфейс перетаскивания также определен в OLE — интерфейсе связывания и внедрения Windows ¹. Программы, написанные на Delphi, могут поддерживать этот интерфейс с помощью встроенных элементов OLE. Эти элементы позволяют построить клиентское или серверное приложение OLE, обладающее полноценной поддержкой перетаскивания OLE-объектов. В «чистой» Windows-программе нормально использовать OLE оказывается непросто. В Delphi существуют классы, которые поддерживают OLE и в некоторой степени облегчают OLE-программирование. В следующей главе я покажу, как реализовать перетаскивание средствами OLE с помощью таких классов. 

¹Когда-то сокращение OLE действительно расшифровывалось как Object Linking and Embedding, но сейчас рамки OLE значительно расширились, и сокращение официально признано самостоятельным термином. — Примеч. перев.

Третья разновидность перетаскивания, поддерживаемая в Delphi, — перетаскивание файлов из File Manager (Windows NT 3.5) или Windows Explorer (Windows 95 и NT 4.0). Этот интерфейс обладает минимальными возможностями (допускается лишь перетаскивание файлов), но оказывается на удивление полезным. Именно этот интерфейс, совершенно не упоминающийся в документации по Delphi, станет темой данной главы. Я использую для него термин FMDD (File Manager Drag and Drop). 

Перетаскивание 

Типичная реализация FMDD в программе для Windows требует выполнения следующих действий:

1. При запуске программы вызовите функцию DragAcceptFiles с логическим номером окна и флагом True, чтобы окно могло принимать перетаскивае мые файлы. 
2. При получении окном сообщения WM_DROPFILES выполните следующие действия (поле Msg.wParam в структуре сообщений Object Pascal соответствует логическому номеру области памяти, используемой сообщением WM_DROPFILES): 


a) вызовите функцию DragQueryPoint, чтобы узнать, был ли перетаскивае мый объект брошен в клиентской области окна; 

б) вызовите функцию DragQueryFile с параметром $FFFFFFFF, чтобы определить количество брошенных файлов; 

в) для каждого файла вызовите DragQueryFile, чтобы скопировать его имя во внутренний буфер; 

г) выполните с каждым файлом необходимые действия; 

д) освободите всю внутреннюю память, выделенную при обработке перетаскивания; 

е) вызовите функцию DragFinish, чтобы освободить память, занятую сервером FMDD (то есть File Manager). 

3. При завершении программы вызовите функцию DragAcceptFiles с логическим номером окна и флагом False, чтобы прервать прием файлов окном.

Рис. 3.1. Готовая программа Drag1 

{ 

DRAG1.DPR — Первый эксперимент с перетаскиванием 

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

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

}
program drag1;

uses
  Forms,
  dragfrm1 in "dragfrm1.pas" 
{Form1};

{$R *.RES}

begin
  Application.CreateForm(TForm1, Form1);
  Application.Run;
end.

{ 

DRAGFRM1.PAS — Первая реализация перетаскивания 

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

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

}
unit dragfrm1;

interface

uses
  SysUtils, Windows, Messages, Classes, Graphics, 
  Controls,  Forms, Dialogs, StdCtrls,
  {
     Функции перетаскивания определены в 
     ShellAPI. Они реализованы в библиотеке 
     SHELL32.DLL.
  }
  ShellAPI;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure FormCreate(Sender: TObject);
    procedure AppMessage(var Msg: TMsg; 
    var Handled: Boolean);
    procedure FormClose(Sender: TObject; 
    var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    procedure WMDropFiles (hDrop : THandle; 
    hWindow : HWnd);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
  {
    Вызываем DragAcceptFiles, чтобы сообщить 
    менеджеру перетаскивания
    о том, что наша программа собирается 
    принимать файлы.
  }
  DragAcceptFiles (Handle, True);
end;


procedure TForm1.WMDropFiles (hDrop : THandle; 
hWindow : HWnd);
Var
  TotalNumberOfFiles,
  nFileLength : Integer;
  pszFileName : PChar;
  pPoint : TPoint;
  i : Integer;
  InClientArea : Boolean;

Begin
  {
    hDrop — логический номер внутренней 
    структуры данных Windows
    с информацией о перетаскиваемых файлах.
  }

  {
    Проверяем, были ли файлы брошены 
    в клиентской области
  }
  InClientArea := DragQueryPoint (hDrop, pPoint);
  if InClientArea then
    Label2.Caption := "In client area"
  else
    Label2.Caption := "Not in client 
    area";

  {
    Определяем общее количество сброшенных файлов, 
    передавая 
    функции DragQueryFile индексный параметр -1 
  }
  TotalNumberOfFiles := DragQueryFile (hDrop , 
  $FFFFFFFF, Nil, 0);

  for i := 0 to TotalNumberOfFiles - 1 do begin
    {
  Определяем длину имени файла, 
  сообщая DragQueryFile
  о том, какой файл нас интересует ( i ) 
  и передавая Nil
  вместо длины буфера.  Возвращаемое значение 
  равно длине 
  имени файла.
    }
    nFileLength := DragQueryFile (hDrop, i , 
    Nil, 0) + 1;
    GetMem (pszFileName, nFileLength);

    {
Копируем имя файла —  сообщаем 
DragQueryFile о том, 
какой файл нас интересует ( i ) и 
передавая длину буфера.
ЗАМЕЧАНИЕ: Проследите за тем, чтобы размер 
буфера на 1 байт
превышал длину имени, чтобы выделить место 
для завершающего 
строку нулевого символа!
    }
    DragQueryFile (hDrop , i, pszFileName, 
    nFileLength);

    Listbox1.Items.Add (StrPas (pszFileName));

    { Освобождаем выделенную память... }
    FreeMem (pszFileName, nFileLength);
  end;

  {
    Вызываем DragFinish, чтобы освободить 
    память, выделенную Shell
    для данного логического номера.
    ЗАМЕЧАНИЕ: Об этом шаге нередко забывают, 
    в результате возникает
    утечка памяти, а программа начинает 
    медленнее работать.
  }
  DragFinish (hDrop);
end;

{
  AppMessage получает сообщения приложения. 
  Этот обработчик следует
  назначить свойству Application.OnMessage 
  в FormCreate.
}
procedure TForm1.AppMessage(var Msg: TMsg; 
var Handled: Boolean);
begin
  case Msg.Message of
    WM_DROPFILES :  begin
      WMDropFiles (Msg.wParam, Msg.hWnd);
      Handled := True;
    end;

    else
      Handled := False;
  end;
end;

procedure TForm1.FormClose (Sender: TObject; 
var Action: TCloseAction);
begin
  { Прекращаем прием файлов }
  DragAcceptFiles (Handle, False);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Listbox1.Clear;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
  Close;
end;

end.

Во всей программе по-настоящему заслуживает внимания всего одна строка из TForm1.FormCreate:

Application.OnMessage := AppMessage; 

Она докладывает программе о том, что сообщения Windows должны передаваться процедуре TForm1.AppMessage. Так в Delphi организуется традиционная обработка сообщений. Нам пришлось это сделать из-за того, что ни класс TControl, ни его потомки (например, TForm) ничего не знают о сообщении WM_DROPFILES, поэтому поступающее сообщение не будет «упаковано» в какое-нибудь приятное событие Delphi типа OnDropFiles. Неприятно, однако ничего не поделаешь. 

И все же листинг 3.2 не радует. Конечно, программа работает (а это самое главное), но она получилась большой, чреватой ошибками, а самое главное — уродливо й. Как хотите, но в программе на Delphi весь этот кошмарный код Windows неуместен. 

Существует и другая проблема, обусловленная механизмом обработки сообщений Delphi. Предположим, у вас имеются две формы, каждая из которых должна реагировать на сообщение WM_DROPFILES. Если каждая форма назначит событию OnMessage объекта Application свой собственный обработчик, то сообщения будут поступать лишь во вторую форму. Первый обработчик будет попросту перекрыт вторым. Эту проблему можно обойти несколькими способами, и мы рассмотрим некоторые из них после того, как расправимся с уродливым кодом Windows. 

Что делать с кодом Windows? 

Вместо того чтобы заставлять форму возиться с обработкой WM_DROPFILES, мы определим в модуле FMDD специальную функцию, с помощью которой обработчик OnMessage формы сможет получить объект с полными сведениями о происходящем перетаскивании. Этот объект будет содержать всю информацию, полученную от интерфейса FMDD Windows, но объединенную в простую и удобную структуру:

TDragDropInfo = class (TObject)
private
  FNumFiles : UINT;
  FInClientArea : Boolean;
  FDropPoint : TPoint;
  FFileList : TStringList;
public
  constructor Create (ANumFiles : UINT);
  destructor Destroy; override;
 
  property NumFiles : UINT read FNumFiles;
  property InClientArea : Boolean read 
  FInClientArea;
  property DropPoint : TPoint read FDropPoint;
  property Files : TStringList read FFileList;
end;

Помимо структуры TDragDrop, в модуле FMDD определены три функции: AcceptDroppedFiles, UnacceptDroppedFiles и GetDroppedFiles. Две первые инкапсулируют функцию DragAcceptFiles, а третья вызывается при получении сообщения WM_DROPFILES и возвращает объект TDragDropInfo. В листинге 3.3 содержится первая версия модуля, FMDD1.PAS. 

{ 

FMDD1.PAS — Первая версия модуля, инкапсулирующего перетаскивание 

файлов из File Manager 

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

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

}
unit fmdd1;

interface

uses Windows, Classes;

type
  TDragDropInfo = class (TObject)
  private
    FNumFiles : UINT;
    FInClientArea : Boolean;
    FDropPoint : TPoint;
    FFileList : TStringList;
  public
    constructor Create (ANumFiles : UINT);
    destructor Destroy; override;
    property NumFiles : UINT read FNumFiles;
    property InClientArea : Boolean read 
    FInClientArea;
    property DropPoint : TPoint read FDropPoint;
    property Files : TStringList read FFileList;
  end;

function GetDroppedFiles (hDrop : THandle) 
: TDragDropInfo;
procedure AcceptDroppedFiles (Handle : HWND);
procedure UnacceptDroppedFiles (Handle : HWND);

implementation

uses ShellAPI;

constructor TDragDropInfo.Create (ANumFiles 
: UINT);
begin
  inherited Create;
  FNumFiles := ANumFiles;
  FFileList := TStringList.Create;
end;

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

function GetDroppedFiles (hDrop : THandle) 
: TDragDropInfo;
var
  DragDropInfo : TDragDropInfo;
  TotalNumberOfFiles,
  nFileLength : Integer;
  pszFileName : PChar;
  i : Integer;

begin
  {
    hDrop - логический номер внутренней 
    структуры данных Windows
    с информацией о перетаскиваемых файлах.
  }
  {
    Определяем общее количество брошенных 
    файлов, передавая 
    функции DragQueryFile индексный 
    параметр -1
  }

  TotalNumberOfFiles := DragQueryFile 
  (hDrop , $FFFFFFFF, Nil, 0);
  DragDropInfo := TDragDropInfo.Create 
  (TotalNumberOfFiles);
  {
    Проверяем, были ли файлы брошены 
    в клиентской области
  }
  DragDropInfo.FInClientArea := DragQueryPoint 
  (hDrop,
    DragDropInfo.FDropPoint);

  for i := 0 to TotalNumberOfFiles - 1 do begin
    {
      Определяем длину имени файла, 
      сообщая DragQueryFile
      о том, какой файл нас интересует ( i ) 
      и передавая Nil
      вместо длины буфера.  Возвращаемое 
      значение равно длине 
      имени файла.
    }
    nFileLength := DragQueryFile (hDrop, 
    i , Nil, 0) + 1;
    GetMem (pszFileName, nFileLength);

    {
      Копируем имя файла —  сообщаем 
      DragQueryFile о том, 
      какой файл нас интересует ( i ), и 
      передаем длину буфера.
      ЗАМЕЧАНИЕ: Проследите за тем, чтобы 
      размер буфера на 1 байт
      превышал длину имени, чтобы выделить 
      место для завершающего 
      строку нулевого символа!
    }
    DragQueryFile (hDrop , i, pszFileName, 
    nFileLength);

    { Заносим файл в список }
    DragDropInfo.FFileList.Add (pszFileName);

    { Освобождаем выделенную память... }
    FreeMem (pszFileName, nFileLength);
  end;

  {
    Вызываем DragFinish, чтобы освободить 
    память, выделенную Shell
    для данного логического номера.
    ЗАМЕЧАНИЕ: Об этом шаге нередко забывают, 
    в результате возникает
    утечка памяти, а программа 
    начинает медленнее работать.
  }
  DragFinish (hDrop);
  Result := DragDropInfo;
end;

procedure AcceptDroppedFiles (Handle : HWND);
begin
  DragAcceptFiles (Handle, True);
end;
procedure UnacceptDroppedFiles (Handle : HWND);
begin
  DragAcceptFiles (Handle, False);
end;

end.

Чтобы старая тестовая программа работала с новым интерфейсом, в нее придется внести ряд изменений. Во-первых, замените ссылку на модуль ShellAPI в секции uses ссылкой на FMDD1. Затем исправьте обработ чики событий формы в соответствии с листингом 3.4. Обновленная версия программы содержится в файлах DRAG2.DPR и DRAGFRM2.PAS на прилагаемом компакт-диске. 

procedure TForm1.FormCreate(Sender: TObject);
begin
  Application.OnMessage := AppMessage;
  FMDD1.AcceptDroppedFiles (Handle);
end;

procedure TForm1.WMDropFiles (hDrop 
: THandle; hWindow : HWnd);
var
  DragDropInfo : TDragDropInfo;
  i : Integer;

begin
  DragDropInfo := FMDD1.GetDroppedFiles 
  (hDrop);
  { Проверяем, были ли файлы брошены 
  в клиентской области }
  if DragDropInfo.InClientArea then
    Label2.Caption := "In client 
    area"
  else
    Label2.Caption := "Not in client 
    area";

  { Заносим все файлы в список }
  for i := 0 to DragDropInfo.NumFiles - 1 
  do begin
    Listbox1.Items.Add 
    (DragDropInfo.Files[i]);
  end;

  { Уничтожаем объект DragDropInfo }
  DragDropInfo.Free;
end;

procedure TForm1.FormClose (Sender: 
TObject; var Action: TCloseAction);
begin
  { Прекращаем прием файлов }
  FMDD1.UnacceptDroppedFiles (Handle);
end;

По-моему, новым интерфейсом пользоваться намного проще. В полном соответствии с духом Delphi мы убрали код для работы с Windows API из приложения и вынесли его с глаз долой в отдельный модуль. Модуль FMDD копается во внутренностях Windows и достает оттуда нужный объект, с которым мы умеем работать. В результате код получается компактным и понятным, более простым в написании и сопровождении. 

Обработка сообщений Windows 

Первое, что приходит в голову, — написать обработчик, который знает обо всех элементах, обрабатывающих сообщения Windows. Он сравнивает значение Msg.hwnd со свойством Handle каждого элемента и передает сообщение нужному элементу. Конечно, такой вариант возможен, но для этого ваша программа должна уже на стадии компиляции знать все элементы, которым может потребоваться обработка сообщений Windows. 

Кроме того, можно создать цепочку обработчиков OnMessage. Каждый элемент, которому потребуется обрабатывать сообщения Windows, подключается к этой цепочке. «Главный» обработчик подключается к событию Application.OnMessage и затем при поступлении нового сообщения просматривает список подключенных элементов, передавая сообщение нужному адресату. В этом случае элементы могут по своему усмотрению присоеди няться к цепочке OnMessage и покидать ее, однако вашей программе придется следить за тем, чтобы цепочка не нарушалась, а элементы не лишались направленных им сообщений. 

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

Представьте себе, что ваш программный шедевр почти закончен, осталось лишь дописать элемент для работы с электронными таблицами. Перелистывая последний номер «Hacker Monthly», вы находите статью о Spreadsheet MAX — самом крутом элементе подобного рода. Он идеально подходит для вашего приложения, и вы немедленно посылаете заказ. Когда элемент прибывает, выясняется, что он прекрасно работает, но попутно перехватывает Application.OnMessage и полностью разрушает всю цепочку, построенную вами с таким трудом. А откуда электронной таблице знать о том, что вы организуете цепочечную доставку сообщений? 

Может, в природе и существует надежный способ организовать правильную обработку Application.OnMessage несколькими элементами — я его не нашел. Так что советую забыть обо всем сказанном выше и вообще не пользоваться Application.OnMessage, если у вас имеется несколько окон, обрабатывающих сообщения Windows. Укротить свирепого льва можно и по-другому. 

Нестандартные элементы 

{ 

FMDDFORM.PAS—форма, обрабатывающая сообщение WM_DROPFILES. 

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

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

}
unit fmddform;

interface

uses
  Windows, Messages, SysUtils, Classes, 
  Graphics, Controls,
  Forms, Dialogs, FMDD1;

type
  TFMDDEvent = procedure (Sender: TObject; 
  DragDropInfo : TDragDropInfo)
    of object;
  TFMDDForm = class(TForm)
  private
    { Private declarations }
    FOnFMDD : TFMDDEvent;
    procedure WMDropFiles (var Message: TMessage);
      message WM_DROPFILES;
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    { Published declarations }
    property OnFMDD: TFMDDEvent read FOnFMDD 
    write FOnFMDD;
  end;

procedure Register;

implementation

constructor TFMDDForm.Create(AOwner: TComponent);
begin
  inherited Create (AOwner);
  FMDD1.AcceptDroppedFiles (Handle);
end;

destructor TFMDDForm.Destroy;
begin
  FMDD1.UnacceptDroppedFiles (Handle);
  inherited Destroy;
end;

procedure TFMDDForm.WMDropFiles 
(var Message: TMessage);
var
  DragDropInfo : TDragDropInfo;
begin
  if assigned (FOnFMDD) then begin
    DragDropInfo := FMDD1.GetDroppedFiles 
    (Message.wParam);
    FOnFMDD (Self, DragDropInfo);
    DragDropInfo.Free;
  end;
end;

procedure Register;
begin
  RegisterComponents("Samples", 
  [TFMDDForm]);
end;

end.

Недостаток такого подхода заключается в том, что вам придется создавать нестандартную версию каждой формы, которая должна обрабатывать сообщения WM_DROPFILES. Даже если у вас хватит смелости влезть в исходный текст TWinControl и создать событие OnFMDD, чтобы все оконные элементы знали о существовании сообщения WM_DROPFILES, из этого все равно ничего не выйдет. Дело в том, что сама среда Delphi использует эти элементы и не поймет, что делать в случае их изменения. 

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

Субклассирование 

Суть субклассирования совершенно проста. С каждым окном связана особая структура данных, используемая Windows. Среди многих замечательных вещей в ней хранится указатель на оконную процедуру (window procedure) — процедуру, которая обрабатывает сообщения Windows. Когда система Windows получает сообщение, предназначенное для некоторого окна, она находит адрес оконной процедуры этого окна и вызывает ее, передавая в виде параметров информацию сообщения. При субклассировании вы заменяете оконную процедуру другой, нестандартной, и сохраняете указатель на старую процедуру, чтобы ей можно было передать сообщение для дальнейшей обработки. Весь этот процесс документирован в руководствах по Windows SDK, по нему имеются неплохие примеры (разумеется, на языке C — нельзя же получить все сразу). Правда, работа идет на очень низком уровне и отдает хакерством, но иногда программисту все же приходится пачкать руки. (Вы никогда не пытались заглянуть в исходные тексты VCL? Просмотрите CONTROLS.PAS, и вы лишитесь многих иллюзий.) 

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

Определение интерфейса 

1. Определить тип TFMDDEvent для обработчика события. 
2. Объявить обработчик OnFMDRagDrop в закрытой (private) секции формы. 
3. При создании формы передать адрес обработчика интерфейсу FMDD — то есть сообщить ему о том, что наша форма желает принимать брошенные файлы. 
4. Когда происходит событие перетаскивания (то есть в тот момент, когда форма получает сообщение WM_DROPFILES), интерфейс FMDD вызывает обработчик OnFMDragDrop и передает ему объект TDragDropInfo. 
5. При закрытии формы обратиться к интерфейсу FMDD и сообщить о том, что форма прекращает принимать перетаскиваемые файлы.

interface

uses Windows, Messages, Classes, Controls;

type
  TDragDropInfo = class (TObject)
  private
    FNumFiles : UINT;
    FInClientArea : Boolean;
    FDropPoint : TPoint;
    FFileList : TStringList;
  public
    constructor Create (ANumFiles : UINT);
    destructor Destroy; override;

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

  TFMDDEvent = procedure (DDI : TDragDropInfo) 
  of object;

procedure AcceptDroppedFiles 
(Control : TWinControl;
                    AOnDrop : TFMDDEvent);
procedure UnacceptDroppedFiles 
(Control : TWinControl);

Обратите внимание — класс TFragDropInfo не изменился. Мы удалили функцию GetDroppedFiles и переопределили процедуры AcceptDroppedFiles и UnacceptDroppedFiles. Получившийся интерфейс выглядит намного приятнее — из него исчезли отвратительные подробности типа логических номеров окон или сообщений Windows. Разумеется, кто-то должен помнить обо всем этом. Все детали скрыты в секции реализации (implementation) модуля FMDD. 

Реализация нового интерфейса 

1. Процедура AcceptDropFiles должна сохранить логический номер окна передаваемого элемента и обработчик OnDrop для будущего использования. Кроме того, процедура должна вызвать DragAcceptFiles, чтобы разрешить обработку сообщений WM_DROPFILES данным окном, и субклассировать окно, чтобы оно могло обрабатывать сообщения. 
2. Нам потребуется обработчик сообщений Windows, который при получении WM_DROPFILES конструирует объект TDragDropInfo и передает его соответствующему элементу. 
3. Процедура UnacceptDroppedFiles должна прекратить субклассирование окна и вызвать DragAcceptFiles, чтобы в дальнейшем сообщения WM_DROPFILES окну уже не посылались.

Самой сложной частью реализации является субклассирование — в основном из-за того, что оно требует знания многих внутренних механизмов Windows. Ранее я в общих чертах рассказал о субклассировании, но намерен но не стал говорить о том, как оно выполняется, пока мы не добрались до реализации. Этот момент наступил, снимайте белые перчатки. 

Снова о субклассировании 

Если субклассирование пройдет успешно, Windows будет посылать все сообщения, предназначенные для данного окна, новой оконной процедуре. Процедура должна обработать те сообщения, которые ее интересуют (в нашем случае WM_DROPFILES), и передать все остальные сообщения старой оконной процедуре, адрес которой был сохранен при субклассировании. При этом вы не можете просто вызвать старую процедуру — вместо этого 

придется вызвать функцию API CallWindowProc, передав ей адрес старой оконной процедуры вместе с параметрами, полученными от Windows. 

Субклассирование следует завершить десубклассированием — то есть вернуть все в прежнее состояние. Десубклассирование сводится к повторному вызову SetWindowLong, но на этот раз новая оконная процедура заменяется старой. 

На самом деле все не так страшно, как может показаться. После того как вы изрядно поломаете голову над примерами и несколько раз «подвесите» Windows, все становится просто и понятно (насколько вообще может быть понятным программирование для Windows). 

В листинге 3.7 содержится новый модуль FMDD с поддержкой субкласси рования. 

{ 

FMDD2.PAS — Полностью инкапсулированный модуль FMDD 

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

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

}
unit fmdd2;

interface

uses Windows, Messages, Classes, Controls;

type
  TDragDropInfo = class (TObject)
  private
    FNumFiles : UINT;
    FInClientArea : Boolean;
    FDropPoint : TPoint;
    FFileList : TStringList;
  public
    constructor Create (ANumFiles : UINT);
    destructor Destroy; override;

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

  TFMDDEvent = procedure (DDI : TDragDropInfo) 
  of object;
procedure AcceptDroppedFiles (Control : 
TWinControl;
               AOnDrop : TFMDDEvent);
procedure UnacceptDroppedFiles 
(Control : TWinControl);

implementation

uses ShellAPI;

type
  {
    В TSubclassItem хранится информация 
    о субклассированном окне
  }
  TSubclassItem = class (TObject)
  private
    Handle : HWND;           
    { Логический номер окна }
    WindowProc : TFNWndProc; 
    { Старая оконная процедура }
    FOnDrop : TFMDDEvent;    
    { Обработчик события OnFMDragDrop элемента }
  public
    constructor Create (AHandle : HWND;
       AWndProc : TFNWndProc; AOnDrop 
       : TFMDDEvent);
  end;

var
  SubclassList : TList;

constructor TSubclassItem.Create (AHandle : HWND;
              AWndProc : TFNWndProc; AOnDrop 
              : TFMDDEvent);
begin
  inherited Create;
  Handle := AHandle;
  WindowProc := AWndProc;
  FOnDrop := AOnDrop;
end;

{
  WMDragDrop создает объект TDragDropInfo 
  и вызывает
  обработчик FOnDrop.
}
procedure WMDragDrop (hDrop : THandle; FOnDrop 
: TFMDDEvent);
var
  DragDropInfo : TDragDropInfo;
  TotalNumberOfFiles,
  nFileLength : Integer;
  pszFileName : PChar;
  i : Integer;

begin
  if not assigned (FOnDrop) then
    exit;
  {
    hDrop - логический номер внутренней 
    структуры данных Windows,
    содержащей информацию о брошенных файлах.
  }
  {
    Определяем общее количество брошенных 
    файлов, передавая
    DragQueryFile индексный параметр -1
  }
  TotalNumberOfFiles := DragQueryFile (hDrop , 
  $FFFFFFFF, Nil, 0);

  DragDropInfo := TDragDropInfo.Create 
  (TotalNumberOfFiles);

  {
    Проверяем, были ли файлы брошены 
    в клиентской области
  }
  DragDropInfo.FInClientArea :=
    DragQueryPoint (hDrop, 
    DragDropInfo.FDropPoint);


  for i := 0 to TotalNumberOfFiles - 1 do begin
    {
      Определяем длину имени файла — 
      сообщаем DragQueryFile
      о том, какой файл нас интересует ( i ), 
      и передаем Nil
      вместо длины буфера.  Возвращаемое 
      значение равно длине 
      имени файла.
    }
    nFileLength := DragQueryFile (hDrop, i , 
    Nil, 0) + 1;
    GetMem (pszFileName, nFileLength);

    {
      Копируем имя файла —  сообщаем 
      DragQueryFile о том, 
      какой файл нас интересует ( i ), и 
      передаем длину буфера.
      ЗАМЕЧАНИЕ: Проследите за тем, чтобы 
      размер буфера на 1 байт
      превышал длину имени, чтобы выделить 
      место для завершающего 
      строку нулевого символа!
    }
    DragQueryFile (hDrop , i, pszFileName, 
    nFileLength);

    { Заносим файл в список }
    DragDropInfo.FFileList.Add (pszFileName);

    { Освобождаем выделенную память... }
    FreeMem (pszFileName, nFileLength);
  end;
  {
    Вызываем DragFinish, чтобы освободить память, 
    выделенную Shell
    для данного логического номера.
    ЗАМЕЧАНИЕ: Об этом шаге нередко забывают, 
    в результате возникает
    утечка памяти, а программа 
    начинает медленнее работать.
  }
  DragFinish (hDrop);

  { Вызываем обработчик события... }
  FOnDrop (DragDropInfo);

  { ...и уничтожаем объект TDragDropInfo }
  DragDropInfo.Free;
end;


{
  FindItemInList находит и возвращает элемент 
  списка, соответствующий
  передаваемому логическому номеру окна
}
function FindItemInList (Handle : HWND) 
: TSubclassItem;
var
  i : Integer;
  Item : TSubclassItem;
begin
  for i := 0 to SubclassList.Count - 1 
  do begin
    Item := SubclassList.Items[i];
    if Item.Handle = Handle then begin
      Result := Item;
      exit;
    end;
  end;
  Result := Nil;
end;

{
  FMDDWndProc обрабатывает сообщения 
  WM_DROPFILES, вызывая WMDragDrop.
  Все прочие сообщения передаются старой 
  оконной процедуре.
}
function FMDDWndProc (
    Handle : HWND; Msg : UINT;
    wparam: WPARAM; lparam: LPARAM) 
    : LRESULT; stdcall;
var
  Item : TSubclassItem;
begin
  Item := FindItemInList (Handle);
  if Item <> Nil then begin
    if Msg = WM_DROPFILES then begin
      WMDragDrop (wparam, Item.FOnDrop);
      Result := 0;
    end
    else
      Result := CallWindowProc (Item.WindowProc,
          Handle, Msg, wparam, lparam)
  end
  else
    Result := 0;
end;

{
  AcceptDroppedFiles субклассирует окно элемента 
  и сохраняет информацию для 
  последующего использования.
}
procedure AcceptDroppedFiles (Control 
: TWinControl;
            AOnDrop : TFMDDEvent);
var
  WndProc : TFNWndProc;
begin
  DragAcceptFiles (Control.Handle, True);
  { Получаем старую оконную процедуру }
  WndProc :=
    TFNWndProc(GetWindowLong (Control.Handle, 
    GWL_WNDPROC));
  { Подключаем новую оконную процедуру... }
  SetWindowLong (Control.Handle,
    GWL_WNDPROC, Longint (@FMDDWndProc));
  { ... и добавляем ее в список }
  SubclassList.Add (
    TSubclassItem.Create (Control.Handle, 
    WndProc, AOnDrop));
end;

{
  UnacceptDroppedFiles прекращает 
  субклассирование окна
  и удаляет его из списка.
}
procedure UnacceptDroppedFiles (Control 
: TWinControl);
var
  Item : TSubclassItem;
begin
  { Прекращаем прием файлов }
  DragAcceptFiles (Control.Handle, False);

  Item := FindItemInList (Control.Handle);
  if Item <> Nil then begin
    { Восстанавливаем старую оконную процедуру }
    SetWindowLong (Control.Handle, GWL_WNDPROC,
      Longint (Item.WindowProc));
    { Удаляем элемент из списка... }
    SubclassList.Remove (Item);
    { ... и уничтожаем его }
    Item.Free;
  end;
end;

{ TDragDropInfo }
constructor TDragDropInfo.Create 
(ANumFiles : UINT);
begin
  inherited Create;
  FNumFiles := ANumFiles;
  FFileList := TStringList.Create;
end;

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

initialization
  SubclassList := TList.Create;

finalization
  SubclassList.Free;

end.

Если вам уже приходилось заниматься субклассированием, может возникнуть вопрос — почему я не сохранил старую оконную процедуру (или хотя бы указатель на объект TSubclassItem) в поле GWL_USERDATA структуры данных окна? Такая возможность приходила мне в голову, но я отверг ее из тех же соображений, из которых критиковал цепочечную обработку Application.OnMessage, — никогда нельзя предсказать, как поведет себя другая программа. Если FMDD будет работать с GWL_USERDATA, то любой элемент, которому понадобится FMDD, не сможет использовать это поле для своих нужд. Это ограничение мне не понравилось, и я перешел к списку структур TList. Он позволяет создать более гибкую реализацию ценой небольшого снижения производительности (за счет времени, необходимо го для поиска объекта в списке). Обработка сообщений Windows обычно не относится к числу операций, критичных по скорости, поэтому небольшие расходы времени на просмотр списка никак не скажутся на работе программы. Оставьте GWL_USERDATA для пользовательских данных, а для хранения указателя на оконную процедуру поищите другой способ. 

С готовым модулем FMDD можно создавать приложения, в которых бросаемые файлы принимаются несколькими формами, или даже формы, в которых файлы принимаются двумя или несколькими различными элементами. Программа Drag3 (см. рис. 3.2) демонстрирует одну из таких форм. Сама по себе форма не принимает бросаемые файлы — это делают отдельные компоненты-списки, находящиеся на ней. Запустите программу и проверьте все сами. Исходный текст модуля DRAGFRM3.PAS приведен в листинге 3.8. 

Рис. 3.2. Форма с двумя списками, которые принимают сбрасываемые файлы 

{ 

DRAGFRM3.PAS — Прием файлов несколькими элементами 

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

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

}
unit dragfrm3;

interface

uses
  SysUtils, Windows, Messages, Classes, 
  Graphics, Controls,
  Forms, Dialogs, StdCtrls,
  {
     FMDD определяет интерфейс перетаскивания
  }
  FMDD2;

type
  TForm1 = class(TForm)
    ListBox1: TListBox;
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    Label2: TLabel;
    ListBox2: TListBox;
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; 
    var Action: TCloseAction);
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
  private
    { Private declarations }
    procedure OnListbox1FMDragDrop 
    (DragDropInfo : TDragDropInfo);
    procedure OnListbox2FMDragDrop 
    (DragDropInfo : TDragDropInfo);
    procedure ProcessDroppedFiles (lb : TListBox;
                DragDropInfo : TDragDropInfo);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  FMDD2.AcceptDroppedFiles 
  (Listbox1, OnListbox1FMDragDrop);
  FMDD2.AcceptDroppedFiles 
  (Listbox2, OnListbox2FMDragDrop);
end;


procedure TForm1.ProcessDroppedFiles (lb 
: TListBox;
            DragDropInfo : TDragDropInfo);
var
  i : Integer;
begin
  { Проверяем, были ли файлы брошены 
  в клиентской области }
  if DragDropInfo.InClientArea then
    Label2.Caption := "In client area"
  else
    Label2.Caption := "Not in client 
    area";

  { Заносим все файлы в список }
  for i := 0 to DragDropInfo.NumFiles - 1 
  do begin
    lb.Items.Add (DragDropInfo.Files[i]);
  end;
end;

procedure TForm1.OnListbox1FMDragDrop (DragDropInfo 
: TDragDropInfo);
begin
  ProcessDroppedFiles (Listbox1, DragDropInfo);
end;

procedure TForm1.OnListbox2FMDragDrop (DragDropInfo 
: TDragDropInfo);
begin
  ProcessDroppedFiles (Listbox2, DragDropInfo);
end;

procedure TForm1.FormClose (Sender: TObject; 
var Action: TCloseAction);
begin
  { Прекращаем прием файлов }
  FMDD2.UnacceptDroppedFiles (Listbox1);
  FMDD2.UnacceptDroppedFiles (Listbox2);
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
  Listbox1.Clear;
  Listbox2.Clear;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  Close;
end;

end.

Вот теперь это похоже на Delphi-программу — никакой возни с логическими номерами и оконными процедурами. Все делается с помощью компонентов и обработчиков событий, как и положено программам, написанным в Delphi. Все страшные подробности спрятаны в FMDD — вне поля зрения прикладного программиста, который хочет получить брошенные файлы, но совершенно не желает возиться с циклом сообщений Windows. 

Поймите меня правильно — я твердо верю в силу знаний, и по мере знакомства с тем, что происходит «под капотом» Windows и Delphi, вы наверняка придумаете и другие решения этой проблемы. Но если задача уже решена, стоит ли повторять все заново? На проектирование и реализацию хорошей «упаковки» для какого-либо средства Windows (в нашем случае — перетаски вания) потребуется некоторое время, но зато потом вы сможете пользоваться ей в любом приложении, избавившись от необходимости снова залезать в дебри Windows.