Delphi 3. Библиотека программиста
       

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


Чтобы субклассировать окно, необходимо получить и сохранить указатель на существующую оконную процедуру, а затем занести в структуру данных окна указатель на новую оконную процедуру. Для этого использу ются функции Windows API GetWindowLong и SetWindowLong, реализующие доступ к информации, хранящейся во внутренней структуре данных окна.

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

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

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

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

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

Листинг 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. Форма с двумя списками, которые принимают сбрасываемые файлы

Листинг 3.8. Модуль DRAGFRM3.PAS

{

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.



Содержание раздела