Переменная DLLProc
При загрузке DLL прежде всего выполняется код запуска (расположенный между begin и end в конце DLL). Если ваша DLL должна загрузить ресурсы, выделить область памяти или выполнить другие действия во время загрузки и перед вызовом других функций, такой код следует расположить именно здесь. Он выполняется каждым приложением, в котором загружается DLL.
Кроме того, Windows сообщает DLL о факте присоединения или отсоеди нения процесса или программного потока (thread), но чтобы извлечь из этого пользу, придется немного потрудиться. Для этого следует подготовить специальную процедуру и присвоить ссылку на нее переменной DLLProc (определенной в модуле System). Процедура определяется так:
procedure DLLHandler (Reason: Integer);
Параметр Reason может быть равен одной из четырех констант: DLL_PROCESS_ ATTACH, DLL_PROCESS_DETACH, DLL_THREAD_ATTACH или DLL_THREAD_DETACH.
Вам придется организовать обработку сообщений DLL_PROCESS_ATTACH и вызвать CreateFileMapping, чтобы создать общий блок памяти (или получить указатель на уже имеющийся блок). Ваша DLL должна также обрабатывать сообщения DLL_PROCESS_DETACH и освобождать блок памяти, чтобы Windows могла удалить его, когда блок не будет использоваться ни одним процессом.
В проекте SHAREME.DPR (листинг 2.11) реализован общий блок памяти. В данном примере общая память представляет собой целое число, которое увеличивается с присоединением и уменьшается с отсоединением очередного процесса.
Листинг 2.11. Реализация общей памяти в DLL
{ SHAREME.DPR — Пример использования общей памяти для организации межпроцессного взаимодействия Автор: Джим Мишель Дата последней редакции: 12/05/97 } library shareme; uses Windows, SysUtils, Classes; const pCounter: ^Longint = nil; function GetProcessCount : Longint; stdcall; export; begin Result := pCounter^; end; procedure MyDLLHandler (Reason: Integer); const hMapObject : THandle = 0; var fInit : Boolean; begin case Reason of DLL_PROCESS_ATTACH : begin { Создаем именованный объект для совместного доступа } hMapObject := CreateFileMapping ( $FFFFFFFF,{ использовать страничный файл } nil,{ без атрибутов безопасности } PAGE_READWRITE,{ доступ по чтению/ записи } 0,{ старшие 32 бита размера } sizeof (longint),{ младшие 32 бита размера } "SharedMem"{ имя объекта } ); { Память инициализируется первым присоединенным процессом } fInit := (GetLastError <> ERROR_ALREADY_EXISTS); { Получаем указатель на общую область памяти, отображаемую на файл } pCounter := MapViewOfFile ( hMapObject, { отображаемый объект } FILE_MAP_WRITE, { доступ по чтению/записи } 0, { старшие 32 бита смещения } 0, { младшие 32 бита смещения } 0 { по умолчанию: отображение на весь файл } ); { Инициализируем или увеличиваем счетчик } if (fInit) then pCounter^ := 1 else pCounter^ := pCounter^ + 1; end; DLL_PROCESS_DETACH : begin { Уменьшаем счетчик } pCounter^ := pCounter^ - 1; { Разрываем связь между общей памятью и адресным пространством процесса } UnmapViewOfFile (pCounter); { Закрываем логический номер объекта } CloseHandle (hMapObject); end; (* Присоединение и отсоединение потоков не обрабатываетсяDLL_THREAD_ATTACH : DLL_THREAD_DETACH : *) end; end; Exports GetProcessCount index 1 name "GetProcessCount"; begin DLLProc := @MyDLLHandler; MyDLLHandler (DLL_PROCESS_ATTACH); end.
Особое внимание следует обратить на две строки из секции инициализации DLL. Первая строка инициализирует переменную DLLProc из модуля System и заносит в нее ссылку на управляющую процедуру DLL (MyDLLHandler). Я думал, что ничего больше не потребуется, но оказалось, что при загрузке DLL почему-то не производится вызов этой процедуры с параметром DLL_PROCESS_ATTACH, поэтому такой вызов приходится организовывать в секции инициализации DLL. Видимо, в библиотеках Delphi допущена какая-то ошибка при генерации кода инициализации DLL.
Чтобы проверить, как работает общая память, создайте форму, при инициализации которой вызывается функция DLL GetProcessCount, и выведите значение переменной-счетчика с помощью компонента TLabel. Если запустить несколько экземпляров приложения, счетчик будет увеличиваться с присоединением каждой новой копии. Если закрыть один или несколько экземпляров приложения, а потом снова открыть их, соответственно изменится и значение счетчика (то есть если запустить три экземпляра, закрыть один, а потом запустить еще один, то итоговое значение счетчика процессов будет равно 3).
Глобальные области памяти (вроде той, что используется в SHAREME) поглощают драгоценные ресурсы Windows, так что старайтесь разумно подходить к их выделению. Если вы работаете со множеством различных полей из одной DLL, сгруппируйте их в общем блоке памяти (то есть в записи) и выделите один общий блок для всей информационной структуры. При этом объем ресурсов Windows, используемых программой, сводится к минимуму. Также проследите за тем, чтобы DLL правильно освобождали свою память. Если DLL аварийно завершится или по другой причине закончит работу, не освободив свои блоки памяти, то распределенная память и ресурсы Windows будут числиться занятыми до перезагрузки Windows. Если логический номер блока будет потерян, освободить память уже не удастся.
Перемещение элементов
Хотя перемещать элементы во время выполнения программы можно несколькими способами, для наших целей лучше всего подойдет трюк с почти недокументированным сообщением WM_SYSCOMMAND. Для перемещения элемента класса TWinControl следует вызвать ReleaseCapture и послать элементу сообщение WM_SYSCOMMAND, указав в качестве параметра wParam шестнадцатеричное значение $F012. А теперь то же самое на языке программы:
ReleaseCapture;
SendMessage(TWinControl(SizingRect1).Handle, WM_SysCommand,
$F012, 0);
Рис. 12.2. Перемещение кнопки Windows
Результат этого фрагмента с точки зрения пользователя изображен на рис. 12.2.
Внешне все выглядит, как при перемещении модального диалогового окна — тонкий пунктирный контур элемента следует за курсором, пока не будет отпущена кнопка мыши.
Возможно, вы уже заметили, что этот способ обладает одним ограниче нием — для него необходим логический номер окна. У потомков TWinControl он имеется, у потомков TGraphicControl — нет. Следовательно, для компонентов типа TGraphicControl (например, TLabel) он работать не будет. Чтобы наши динамические формы были действительно полезными и полноценными, необходимо найти способ перемещения потомков TGraphicControl.
Только что описанный механизм WM_SYSCOMMAND придется усовершенствовать. Конечно, его нельзя использовать для потомков TGraphicControl напрямую, но обходной путь все же существует — мы создадим прозрачный TWinControl и расположим его над перемещаемым элементом.
Когда пользователь выбирает из контекстного меню команду Adjust Size & Position, мы накладываем прозрачный TWinControl поверх выделенного элемента. Пользователь сможет перетащить прозрачный элемент (с помощью сообщения WM_SYSCOMMAND с параметром $F012) так, словно это и есть «выделенный» элемент. Другими словами, когда пользователь щелкает на выделенном элементе и начинает перетаскивать его, на самом деле он перетаскивает наш прозрачный TWinControl. Затем, когда пользователь решит сохранить внесенные изменения (повторно выбрав команду Adjust Size & Position), мы прячем прозрачный TWinControl и программным способом перемещаем «выделенный» элемент в новое место.
В сущности, именно это происходит в Delphi в режиме конструирования. Если присмотреться повнимательнее, вы увидите, что при перетаскивании элемента на самом деле перемещается прозрачный прямоугольник в толстой рамке (см. рис. 12.3).
Рис. 12.3. Перетаскивание в режиме конструирования Delphi
Прозрачный прямоугольник появляется только над перемещаемым элементом. С того момента, когда вы щелкнули на «выделенном» элементе, и до отпускания кнопки мыши прозрачный прямоугольник следует за курсором. При отпускании кнопки мыши прозрачный прямоугольник исчезает, а перемещаемый элемент оказывается в новом месте.
Наш прозрачный потомок TWinControl называется SizingRect и принадлежит классу TSizingRect. Объект класса TSizingRect заменяет элемент на время перетаскивания.
Важнейшие методы класса TSizingRect — CreateParams и Paint. Метод Create Params определяет некоторые аспекты поведения элемента еще до его создания. Мы воспользуемся этим методом, чтобы сделать наш элемент прозрачным (см. листинг 12.1).
Листинг 12.1. Метод TSizingRect.CreateParams
procedure TSizingRect.CreateParams(var Params: TCreateParams); begin inherited CreateParams(Params); Params.ExStyle := Params.ExStyle + WS_EX_TRANSPARENT; end;Метод Paint (см. листинг 12.2) рисует толстую рамку, которую видят наши пользователи при перетаскивании SizingRect. При рисовании прямоугольника толщиной в 3 пикселя мы задаем свойству Pen.Mode холста значение pmNot. Тем самым гарантируется, что цвет нарисованного прямоугольника будет отличаться от цвета формы (как и при масштабировании элементов в Delphi).
Листинг 12.2. Метод TSizingRect.Paint
procedure TSizingRect.Paint; begin inherited Paint; if fVisible = False then Exit; Canvas.Pen.Mode := pmNot; Canvas.Pen.Width := 3; Canvas.Brush.Style := bsClear; Canvas.Rectangle(0, 0, Width, Height); end;Перемещение по иерархии
Для перемещения вверх и вниз по иерархии потребуются две дополнитель ные функции. В рассматриваемом примере пользователь перемещается вниз, когда он делает двойной щелчок на подчиненной записи (справа). При этом фильтр левой таблицы изменяется, и в нее включаются строки из правой таблицы. Затем новый фильтр меняет содержимое правой таблицы— теперь в ней отображаются «дети» выбранной записи. Все это довольно трудно объяснить на словах, поэтому в листинге 13.3 приведен исходный текст обработ чика OnDoubleClick, поясняющий сказанное. Внимательно просмотрите его и убедитесь, что вы поняли принцип его работы.
Листинг 13.3. Обработчик OnDoubleClick для перемещения по иерархии
procedure TForm2.DBGrid2DblClick(Sender : TObject); var NewRangeID, SelectedEmployeeID : String; begin { Выводим информацию о текущей записи } if Table1.FieldByName('Boss_ID').AsString = '' then Label1.Caption := Table2.FieldByName ('Boss_ID').AsString else Label1.Caption := Label1.Caption + ':' + Table2.FieldByName ('Boss_ID').AsString; { Предполагается, что свойство Table1.IndexFieldNames все еще равно 'Boss_ID;Emp_ID' } SelectedEmployeeID := Table2.FieldByName ('Emp_ID').AsString; NewRangeID := Table2.FieldByName ('Boss_ID').AsString; Table1.SetRange([NewRangeID],[NewRangeID]); Table1.FindKey([NewRangeID, SelectedEmployeeID]); end; procedure TForm2.UpOneLevelButtonClick(Sender : TObject); var PrevPos : Integer; NewRangeID : String; begin { Записи фильтруются по Boss_ID выбранного работника. } NewRangeID := Table1.FieldByName ('Boss_ID').AsString; Table1.CancelRange; Table1.IndexFieldNames := 'Emp_ID'; Table1.FindKey([NewRangeID]); NewRangeID := Table1.FieldByName ('Boss_ID').AsString; Table1.IndexFieldNames := 'Boss_ID'; { Восстанавливаем синхронизацию Table2. } Table1.SetRange([NewRangeID],[NewRangeID]); if Table1.FieldByName('Boss_ID').AsString = '' then Label1.Caption := '<Top level>'; else begin PrevPos := 0; while Pos(':', Copy(Label1.Caption, PrevPos + 1, 999))<>0 do PrevPos := Pos(':',Copy(Label1.Caption, PrevPos +1, 999)) + PrevPos; Label1.Caption := Copy(Label1.Caption, 1, (PrevPos - 1)); end; end;Когда пользователь нажимает кнопку Up One Level, записи левой таблицы фильтруются по значению Boss_ID текущего фильтра. Хотя этот способ и допускает бесконечную рекурсию, вы все равно не сможете легко получить список всех подчиненных текущего начальника вместе с их подчиненными и так далее, вниз по иерархии. Кроме того, вам также не удастся получить всю цепочку вышестоящих начальников. Для этого придется перемещаться по ссылкам в нужном направлении, причем заранее неизвестно, через сколько уровней иерархии потребуется пройти.
Но и такие иерархии приносят пользу — они позволяют выбрать объект любого уровня и при этом снабжают приложение адекватными данными. Например, вы можете последовательно разделять географический регион на более мелкие области, но приложение всегда сможет узнать, к какому региону относятся эти области (кто является родителем самого верхнего уровня).
Кроме того, общие категории можно разделить на отдельные специали зации, но так, чтобы выбор общей категории приводил к включению всех специализаций. Например, при выборе категории «художники» в нее будут автоматически включены художники-портретисты, художники-баталисты, художники-маринисты и т. д. В этом случае для получения списка объектов общей категории вам не придется составлять отдельные списки для членов каждой специализации.
Пересылка нескольких файлов
Второй способ позволяет переслать сразу несколько файлов (пакет). Перед тем как начинать прием, мы выделяем файлы в списке lbRemoteFiles, щелкая на их именах. При этом в обработчике TfrmMain.lbRemoteFilesClick имена файлов заносятся в строковый список RemoteFiles. Это демонстрирует следующий фрагмент кода:
procedure TfrmMain.lbRemoteFilesClick (Sender: TObject); begin CsShopper1.RemoteFiles.Add (lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex]); end;На рис. 6.6 видно несколько файлов, выделенных в каталоге удаленного хоста и готовых к приему. После того как будут выделены все принимаемые файлы, начинайте пересылку с помощью кнопки , расположенной вверху рядом со списком lbRemoteFiles. При этом будет вызван метод CsShopper.MGet. Соответствующий код выглядит так:
procedure TfrmMain.sbbtnRetrClick(Sender: TObject); begin pbDataTransfer.Visible := TRUE; bbtnAbort.Enabled := TRUE; CsShopper1.MGet; end;
Рис. 6.6. Выделенные файлы готовы к пакетному приему
Однако для того, чтобы описанная схема работала, нам придется изменить два свойства списка lbRemoteFiles в инспекторе объектов: во-первых, измените значение ExtendedSelect с FALSE на TRUE, а во-вторых, измените значение MultiSelect также с FALSE на TRUE. Если теперь щелкнуть на имени файла в списке lbRemoteFiles, оно заносится в строковый список CsShopper1.RemoteFiles (относящийся к типу TStringList). Аналогично в случае пакетной передачи вам придется изменить те же два свойства для списка flbLocal.
Замечание
Учтите, что возможность пакетной пересылки отсутствует в асинхронном режиме — это обусловлено трудностями с синхронизацией файловых операций.
Перетаскивание
В системе Windows FMDD реализуется через интерфейс Shell из библиотеки SHELL32.DLL. При этом используются четыре функции API — DragAcceptFiles, DragQueryFile, DragQueryPoint и DragFinish, а также одно сообщение Windows, WM_DROPFILES. В Delphi сообщение WM_DROPFILES определено в модуле Messages, а функции API — в модуле ShellAPI. Документированный интерфейс относится к клиентам , но не серверам FMDD. Ваша программа сможет принимать файлы, перетаскиваемые из File Manager, но ей не удастся отправить файлы в другую программу.
Типичная реализация FMDD в программе для Windows требует выполнения следующих действий:
При запуске программы вызовите функцию DragAcceptFiles с логическим номером окна и флагом True, чтобы окно могло принимать перетаскивае мые файлы. При получении окном сообщения WM_DROPFILES выполните следующие действия (поле Msg.wParam в структуре сообщений Object Pascal соответствует логическому номеру области памяти, используемой сообщением WM_DROPFILES):a) вызовите функцию DragQueryPoint, чтобы узнать, был ли перетаскивае мый объект брошен в клиентской области окна;
б) вызовите функцию DragQueryFile с параметром $FFFFFFFF, чтобы определить количество брошенных файлов;
в) для каждого файла вызовите DragQueryFile, чтобы скопировать его имя во внутренний буфер;
г) выполните с каждым файлом необходимые действия;
д) освободите всю внутреннюю память, выделенную при обработке перетаскивания;
е) вызовите функцию DragFinish, чтобы освободить память, занятую сервером FMDD (то есть File Manager).
При завершении программы вызовите функцию DragAcceptFiles с логическим номером окна и флагом False, чтобы прервать прием файлов окном.В листингах 3.1 и 3.2 содержится черновой набросок программы, поддерживающей FMDD. На рис. 3.1 показано, как выглядит окно готовой программы.
Рис. 3.1. Готовая программа Drag1
Листинг 3.1. Файл DRAG1.DPR
{
DRAG1.DPR — Первый эксперимент с перетаскиванием
Автор: Джим Мишель
Дата последней редакции: 27/04/97
} program drag1; uses Forms, dragfrm1 in "dragfrm1.pas" {Form1}; {$R *.RES} begin Application.CreateForm(TForm1, Form1); Application.Run; end.Листинг 3.2. Модуль DRAGFRM1.PAS
{
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.
Перетаскивание: как это делается
Прежде всего потребовалось выбрать компонент для календаря. Хотя вместе с Delphi поставляется неплохой календарь, в нем трудно связать дату с координатами внутри календаря. Поскольку этот компонент-пример отображает только дни текущего месяца (оставляя все остальные ячейки пустыми), мне пришлось бы писать специальный код для вычисления дат, соответствующих пустым ячейкам. Некрасивое решение.
Я остановил свой выбор на компоненте OvcCalendar, входящем в пакет VCL-компонентов Orpheus фирмы TurboPower Software. Этот мощный маленький компонент заполняет датами все ячейки, отображая при необходимости дни предыдущего и/или следующего месяца. Удаляя стандартный заголовок календаря, я могу быть уверен, что каждая ячейка соответствует какой-нибудь дате. Поскольку все ячейки имеют одинаковые размеры, вычислить абсолют ную дату по координатам мыши в OvcCalendar оказывается несложно.
Примечание
Компонент OvcCalendar вместе с остальными компонентами семейства Orpheus (специаль ная пробная версия) находится в каталоге \ORPHEUS прилагаемого CD-ROM. Последнюю пробную версию пакета всегда можно получить на Web-узле TurboPower по адресу http://www.turbopower.com.
Для своего расследования я создал приложение с единственной формой, на которой находятся текстовое поле, строковая сетка TStringGrid и календарь (и, разумеется, вездесущая кнопка для выхода из приложения). Общая идея такова: вы вводите строку в текстовом поле, затем перетаскиваете и бросаете ее на календарь, где она ассоциируется с определенной датой. Затем строка, содержащая дату и введенный текст, заносится в TStringGrid. Внешний вид формы для рабочей версии этого приложения показан на рис. 14.1.
Рис.14.1. Эксперимент с перетаскиванием
Я начал с шага 1. Было бы вполне логично перехватывать сообщения о нажатии кнопки мыши, поступающие от текстового поля. Идея оказалась удачной — но лишь в определенной степени. Перетаскивание из текстового поля приводит к непредвиденным последствиям — событие OnMouseEvent в контексте текстового поля уже имеет стандартный смысл, оно применяется для выделения текста. Используя это событие для перетаскивания, я тем самым теряю возможность выделить часть текста, перетаскивая над ней курсор.
Обработчик события OnMouseDown получает некоторые сведения — ссылку на объект, от которого поступило сообщение; параметр, идентифицирующий нажатую кнопку мыши; другой параметр, определяющий состояние клавиш Shift, Ctrl и Alt; и, наконец, координаты x и y курсора. В нашем случае сообщение поступает от текстового поля, поскольку именно в нем начинается операция перетаскивания. Координаты курсора можно игнорировать — меня не интересует, из какой именно точки поля начинается перетаскивание. Наконец, перетаскивание должно начинаться только при нажатии левой кнопки мыши (позднее выяснилось, что необходимо дополнительно отфильтровать двойные щелчки, поскольку их использование для перетаскивания приводит к странным побочным эффектам).
Все просто. Окончательный вид кода приведен в листинге 14.1.
Листинг 14.1. Обработчик события для инициализации перетаскивания
procedure TDDDemoForm.EditBoxMouseDown( Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) and (EditBox.Text <> "") and not (ssDouble in Shift) then TEdit(Sender).BeginDrag(False); end;При тестировании исходной версии обработчика я обнаружил, что перетаскивание можно начать двумя способами. Если аргумент метода BeginDrag равен True, перетаскивание начинается сразу же после нажатия кнопки мыши, а если False — откладывается до тех пор, пока мышь не сдвинется на несколько пикселей. Второй вариант показался мне более естественным. Кроме того, я добавил проверку, которая блокировала попытки перетащить пустую строку. Преобразование типа, используемое при вызове метода BeginDrag, почти всегда необходимо при работе со ссылками на объекты Sender и Source, которые передаются обработчикам событий.
Настало время заняться шагом 2. Обработчику события OnDragOver передается несколько параметров. Параметр Source
определяет объект, в котором началось перетаскивание (в нашем случае — текстовое поле). Параметр Sender обозначает объект, вызвавший событие, потенциальный приемник для операции перетаскивания (в нашем случае — календарь). Параметры X и Y
содержат относительные координаты курсора мыши внутри Sender, а State определяет состояние перетаскиваемого объекта (объект входит в границы Sender, покидает их или перемещается внутри Sender). Хотя для процесса перетаски вания предоставляется курсор по умолчанию, информация о состоянии позволяет легко выбрать собственный курсор для каждой стадии процесса. Наконец, присутствует логический параметр Accept, передаваемый по ссылке.
Цель игры — на основании представленной информации принять решение о том, можно ли завершить операцию перетаскивания. Ситуация выглядит так, словно пилот маленького самолета (Source) обращается к наземному наблюдателю: «Сообщаю свои координаты относительно поля, где вы находитесь. Можно ли сбрасывать груз?»
Как оказалось, выбор OvcCalendar сделал мою работу тривиальной: для сбрасывания подходит любая точка внутри клиентской области календаря. Исходный текст приведен в листинге 14.2.
Листинг 14.2. Проверка допустимости сбрасывания
procedure TDDDemoForm.CalendarDragOver (Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := True; end;Перетаскивание текста в списках
Спасибо, Джон. При перетаскивании объекта в Delphi вид курсора изменяется; по умолчанию курсор принимает вид стрелки, к которой присоединена небольшая рамка. Такое визуальное обозначение перетаскивания выглядит вполне нормально — раз уж курсор присутствует на экране, почему бы ему не выглядеть именно так?
Тем не менее вы можете придать пользователям еще больше уверенности в происходящем. Например, при перетаскивании одной из строк списка курсорможет выглядеть как прозрачное изображение текста, окруженное пунктирным прямоугольником. Оказывается, в Delphi 3 сделать это несложно.В листинге 9.5 приведен полный исходный текст компонента-списка, обладающего такой возможностью.
В отличие от Delphi 1 версии Delphi 2 и Delphi 3 обладают встроенной поддержкой для перетаскивания графических элементов; все, что от вас требуется — предоставить нужное изображение. Для этого следует нарисовать его в растровом виде, поместить растр в компонент TImageList и передать этот объект Delphi. После этого за перерисовку изображения при перемещении мыши будет отвечать код Delphi из модуля Controls.
Как видно из листинга 9.5, для хранения графики используется private-поле типа TImageList. Его следует создать как можно раньше, но не заносить в него изображение до начала перетаскивания. Чтобы обнаружить начало операции перетаскивания, мы переопределяем метод DoStartDrag. Кроме того, необходимо переопределить и метод GetDragImages, поскольку список изображе ний передается Delphi именно при вызове этого метода.
Почему мы не рисуем изображение сразу, а ждем до последней секунды? Потому что это позволяет синхронизировать перетаскиваемое изображение с перетаскиваемым элементом. Как узнать, какой текст следует вывести в растре, если еще неизвестно, какой элемент списка перетаскивается?
Листинг 9.5. Модуль TXTDRGBX.PAS
unit TxtDrgBx; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TTextDragListBox = class( TListBox ) private FDragImage: TImageList; protected procedure CreateDragImage; procedure DoStartDrag( var DragObject: TDragObject ); override; public constructor Create( AnOwner: TComponent ); override; destructor Destroy; override; function GetDragImages: TCustomImageList; override; end; procedure Register; implementation constructor TTextDragListBox.Create( AnOwner: TComponent ); begin inherited Create( AnOwner ); ControlStyle := ControlStyle + [ csDisplayDragImage ]; FDragImage := TImageList.CreateSize ( 32, 32 ); end; destructor TTextDragListBox.Destroy; begin FDragImage.Free; inherited Destroy; end; procedure TTextDragListBox.CreateDragImage; var Bitmap: TBitmap; // Перетаскиваемое изображение AnItemRect: TRect; // Прямоугольник, в котором находится // элемент списка MousePt: TPoint; // Положение курсора begin // Очищаем список изображений //и заканчиваем работу, // если в списке нет выделенных элементов FDragImage.Clear; if ItemIndex = -1 then Exit; // Создаем растр, масштабируем его //до размеров // выделенного элемента и выводим //в нем текст AnItemRect := ItemRect( ItemIndex ); Bitmap := TBitmap.Create; try with Bitmap do begin Width := AnItemRect.Right - AnItemRect.Left; Height := AnItemRect.Bottom - AnItemRect.Top; Canvas.Font := Font; Canvas.DrawFocusRect( Rect( 0, 0, Width, Height ) ); Canvas.Brush.Style := bsClear; Canvas.TextOut ( 1, 1, Items[ ItemIndex ] ); // Задаем размер списка изображений, заносим //в него // изображение и устанавливаем прозрачный цвет FDragImage.Width := Width; FDragImage.Height := Height; FDragImage.AddMasked( Bitmap, clWhite ); // ... задаем положение активной точки GetCursorPos( MousePt ); with ScreenToClient( MousePt ), AnItemRect do FDragImage.SetDragImage ( 0, X - Left, Y - Top ); end; finally Bitmap.Free; end; end; procedure TTextDragListBox.DoStartDrag ( var DragObject: TDragObject ); begin inherited DoStartDrag( DragObject ); CreateDragImage; end; function TTextDragListBox.GetDragImages: TCustomImageList; begin Result := nil; if FDragImage.Count > 0 then Result := FDragImage; end; procedure Register; begin RegisterComponents('HP Delphi 3', [ TTextDragListBox ]); end; end.Основную часть листинга 9.5 занимает процедура CreateDragImage для работы со списком изображений. После создания и прорисовки растра размер списка изображений приводится в соответствие с размером растра (не забывайте это делать!), после чего метод AddMasked заносит растр в список и назначает прозрачный цвет.
Метод SetDragImage, вызываемый двумя строками ниже, задает положение активной точки (hotspot) перетаскиваемого изображения. Мышь «держит» перетаскиваемое изображение в активной точке. В нашем случае вызов SetDragImage гарантирует, что текстовый прямоугольник будет перетаскиваться за точку его первоначального «захвата».
Конечно, запрограммировать этот прием в Delphi 2 и 3 оказывается сложнее, чем просто рисовать на экране, но зато перед вами открываются широкие возможности для организации визуального взаимодействия компонентов. Например, при перетаскивании изображения между списками второй список может скрыть перетаскиваемое изображение, выделить свой элемент-приемник и затем вернуть скрытое изображение на экран.
Первая попытка
Общий сценарий выглядит так: я выбираю нужную вкладку и перетаскиваю строку с описанием задачи на сетку. Для всех трех страниц при этом выполняются практически одинаковые операции. Единственное отличие заключается в том, какая сетка получает строку. Следовательно, необходимо придумать способ совместного использования обработчиков OnDragOver и OnDrag Drop всеми тремя сетками.
Наверное, это вопрос личного вкуса, но я предпочитаю, чтобы совместно используемые обработчики событий имели более внятные имена, чем генерирует Delphi. Я решил назвать их GridDragOver и GridDragDrop.
Перед тем как следовать дальше, опишу алгоритм для создания нестандарт ных имен обработчиков1:
Дважды щелкните на имени обрабатываемого события в инспекторе объектов. Delphi автоматически создаст уникальное имя процедуры, объединив в нем имена компонента и события. Что еще важнее, при этом автомати чески генерируется список параметров для обработчика данногособытия (я слишком ленив и предпочитаю, чтобы вместо меня этим занималась среда Delphi). Введите любой текст (например, точку с запятой) между begin и end
пустой процедуры, созданной Delphi. Это предотвращает автоматичес кое удаление процедуры при попытке сохранить файл. Отредактируйте имя процедуры, затем выделите его двойным щелчком и нажмите Ctrl+C, чтобы скопировать в буфер. Перейдите в начало файла и найдите объявление исходного обработ чика среди прочих объявлений формы. Выделите исходное имя и нажмите Ctrl+V, чтобы заменить его новым. В какой-то момент Delphi пожалуется, что исходное имя (все еще присутствующее в инспекторе объектов) не найдено. Подтвердите его удаление. Переместите курсор в пустую строку инспектора объектов. Вставьте в нее новое имя, нажимая Ctrl+V. Сохраните файл.
Исходный текст написанных мной процедур приведен в листинге16.1.
Листинг 16.1. Общие обработчики событий OnDragOver и OnDragDrop
{ Общий обработчик для события OnDragOver всех сеток. }
procedure TShareEventDemoForm.GridDragOver(Sender, Source: TObject;
X, Y: Integer; State: TDragState; var Accept: Boolean);
begin
{ Принимается все, что угодно, но только из текстового поля. }
Accept := Source is TEdit;
end;
{ Общий обработчик для события OnDragDrop всех сеток. }
procedure TShareEventDemoForm.GridDragDrop(Sender, Source : TObject;
X, Y : Integer);
1 Визуальные среды таят в себе серьезную опасность — люди начинают забывать, что у компьютера кроме мыши есть еще и клавиатура. Вот и Эйс Брейкпойнт (или Дон Тейлор?), судя по всему, даже не догадывался, что оставлять создание имен обработчиков на усмотре ние Delphi вовсе не обязательно. Просто введите желаемое имя в поле нужного события на вкладке Events и нажмите клавишу Enter. — Примеч. ред.
begin { Сбрасываем перетаскиваемый объект на текущую сетку. } DropEditString(CurrentGrid); end; { Вспомогательная процедура для сброса строки из текстового поля на указанную сетку. Также очищает содержимое текстового поля. } procedure TShareEventDemoForm.DropEditString (AGrid : TStringGrid); begin if AGrid <> nil then with AGrid do begin Cells[0, RowCount - 1] := EditBox.Text; RowCount := RowCount + 1; EditBox.Text := ''; end; { with } end; { Возвращает указатель на сетку, расположенную на текущей вкладке. } function TShareEventDemoForm.CurrentGrid : TStringGrid; begin Result := nil; if PageControl.ActivePage = MorningSheet then Result := MorningGrid else if PageControl.ActivePage = AfternoonSheet then Result := AfternoonGrid else if PageControl.ActivePage = EveningSheet then Result := EveningGrid; end;Процедура OnDragOver выглядит очень просто. Объект, перетаскиваемый из текстового поля, может быть принят любой сеткой. Я решил разбить обработку OnDragDrop на две части: главный обработчик и вспомогательную процедуру. Обработчик ограничивается вызовом вспомогательной процедуры
с использованием функции, возвращающей указатель на сетку текущей вкладки1. Здесь проявляется способность Delphi скрывать работу с указателями, благодаря чему можно выполнить нужные операции и сохранить «четкость» программы. Получив указатель, процедура DropEditString
заносит строку
из текстового поля в соответствующую сетку, добавляет в нее новую строку и стирает содержимое текстового поля.
Для сетки на первой вкладке (MorningGrid) обработчик делал именно то, что требовалось. Я вернулся к инспектору объектов и присоединил те же обработ чики к двум другим решеткам — и снова все идеально работало.
1 ?ешение, использующее для распознавания нужной сетки параметр Sender, является намного более элегантным. — Примеч. ред.
Плавающие панели инструментов
Дневник №16 (3 апреля): Я всегда любил программы с панелями инструментов, свободно перемещаемыми по экрану. Такие панели особенно удобны
в графических редакторах и программах компьютерной верстки, так как палитру с необходимыми инструментами можно расположить вблизи от того места, над которым вы работаете.
В поисках основы для «плавающей» панели инструментов я перебрал различные компоненты, поставляемые вместе с Delphi. Наверное, можно было бы воспользоваться дополнительной формой, но я не стремился к экзотическим решениям. Меня вполне устроило бы нечто, перемещаемое в пределах клиентской области главной формы.
Обычный компонент TPanel прекрасно подходил на эту роль, за исключением одного: панели нельзя перемещать во время выполнения. Однако небольшое исследование показало, что они способны обрабатывать события мыши. После нескольких неудачных попыток у меня получилась демонстрационная программа, приведенная в листинге16.7.
Листинг 16.7. Исходный текст программы с плавающей панелью инструментов
Как видно из листинга, панель должна обрабатывать три события мыши — OnMouseDown, OnMouseMove и OnMouseUp. Обработчик OnMouseDown проверяет, была ли нажата левая кнопка мыши. Если это так, он запоминает исходное положение курсора и устанавливает флаг статуса в состояние, которое обозначает перетаскивание.
Обработчик OnMouseMove выглядит сложнее — в основном потому, что ему приходится следить, чтобы панель не вышла за пределы клиентской области и не потерялась из вида. Обработчик ToolbarMouseMove вычисляет разность между исходным и текущим положениями мыши и прибавляет ее к первоначаль ным значениям свойств Left и Top панели, чтобы переместить ее в новое место. Я предусмотрел возможность перемещения панели с шагом в 1, 10 или 20 пикселей. Внешне это выглядит похожим на перемещение компонентов в режиме конструирования Delphi при включенной привязке к сетке. Кроме того, я позаботился о том, чтобы участок панели всегда можно было захватить мышью, даже если пользователь по неосторожности уведет ее слишком далеко.
Обработчик OnMouseUp выглядит тривиально; все, что от него требуется — сбросить флаг статуса.
?ис. 16.5. Плавающая панель инструментов
Я поместил на форму три переключателя, чтобы дискретность перемеще ний и размеры полей можно было менять на ходу. Кроме того, я предусмотрел возможность перехода от горизонтальной ориентации к вертикальной, и наоборот.
На рис. 16.5 показано, как выглядит эта программа во время выполнения. Перетаскивать панель оказывается довольно занятно, к тому же первая кнопка на ней выполняет полезную функцию — завершает работу программы.
Конец записи (3 апреля).
Почему интерфейсы?
Перед тем как следовать дальше, я хотел бы объяснить, почему я пользуюсь интерфейсами Delphi3, вместо того чтобы просто определить классы вида и фрейма и создавать объекты на их основе. Не вызвано ли применение интерфейсов обычным желанием воспользоваться новой эффектной возможностью Delphi 3?
Вовсе нет. Начнем с того, что виды и фреймы связаны циклической зависимостью. Фрейм должен сообщать виду о необходимости чтения или записи в модель; вид должен сообщать фрейму об изменении свойства Valid. Разумеется, подобную циклическую зависимость можно было бы реализовать с помощью опережающего объявления классов вместо опережающего объявления интерфейсов, но мне кажется, что интерфейсы делают эти взаимосвязи более понятными и избавляют их от груза посторонних свойствиметодов. Кроме того, хотя я и не использую такую возможность вEMBEDDEDFORMS.PAS, применение интерфейсов означает, что вид можно реализовать несколькими различными способами — он не обязан быть потомком TEmbeddedForm. Однако самая важная причина заключается в том, что вид сам может быть фреймом.
Например, объект Employee (работник) может содержать ссылки на объекты типа People для самого работника и его руководителя, каждый из которых в свою очередь содержит сведения об имени и адресе. Вид объекта Employee может содержать внутренние виды для соответствующих полей. В Delphi не поддерживается множественное наследование, поэтому объект не может одновременно быть TView и TFrame, однако он легко может реализовать интерфейсы IView и IFrame.
Перед тем как в Delphi появилась поддержка интерфейсов, для реализации чего-то наподобие протокола INotify обычно применялись процедурные типы:
type TOnValidChanged = procedure(ChangingObject: TObject) of object; procedure TViewAddNotifiee(Callback: TOnValidChanged);Такая схема работала, но TOnValidChanged — это практически то же самое, что и TNotifyProc, и в каждой Delphi-программе такие процедурные типы встречаются в избытке. Вы можете передать процедуре AddNotifiee любой объект TNotifyProc, и компилятор никак не сможет предотвратить ошибочную передачу неверного параметра. При использовании интерфейсов процедура косвенного вызова (callback) фрейма должна иметь правильное имя и правильную сигнатуру, и притом она должна принадлежать объекту, реализующему протокол IFrame — это намного снижает вероятность случайных ошибок.
Подключение
Пользуясь введенной информацией, метод CsShopper.Start вызывает GetHost, чтобы открыть соединение с удаленным хостом. Если вызов функции завершится неудачно, WSAErrorMsg отображает возможную причину неудачи и присваивает Status значение Failure. В противном случае Status присваивается значение Success. При успешной установке соединения CsShopper вызывает процедуру события ConnEvent (унаследованную от CsSocket), чтобы сообщить SHOPPER32 о необходимости изменения состояния кнопок. Например, кнопка Quit блокируется до момента установления соединения, а затем становится доступной. Start вызывает FTPCommand для посылки команд USER, PASS, SYST и PWD (именно в таком порядке) с соответствующими аргументами. Затем Start устанавливает соединение данных (data connection) для пересылки списка каталогов и файлов удаленного хоста, при этом порт данных для соединения задается функцией GetPort.
Чтобы получить список каталогов, Start посылает команду LIST с помощью FTPCommand. Результат сохраняется, а последующий вызов Decode анализирует полученные данные и ищет в них информацию о каталогах и файлах.
Замечание
Механизм анализа несложен, однако описание каталогов и файлов на разных системах может выглядеть по-разному. Анализатор CsShopper работает с серверами, использующими Unix и Unix-подобные системы. Для других операционных систем он иногда выдает неверную информацию о каталогах.
Decode сравнивает первый символ каждой строки файла FTPFILE.TMP с «d» (для каталогов) или два начальных символа — с «-r» (для файлов). Если будет найден символ «d», Decode удаляет его, проверяет оставшуюся часть строки и преобразует ее в знакомый формат \ddd. Обратная косая черта сообщает SHOPPER32 о том, что строка содержит имя каталога. Аналогично в случае файлов Decode удаляет символы «-r» и ищет в строке имя, время, дату и размер файла, выделяя их в подстроки. Затем эти составные части переставляются так, чтобы получившаяся строка подходила для просмотра в окне списка SHOPPER32 (см. рис. 6.5).
Метод FRemFiles.Add, используемый внутри Decode, читает каждую сформатированную строку и заносит ее в FRemFiles. Свойство FRemFiles представляет собой список строк, производный от класса TStringList и созданный в конструкторе TCsShopper.Create.
После того как процедура Decode завершит построение списка, CsShopper передает FRemFiles процедуре TCsShopper.ChangeList, вызывающей обработчик
OnList:procedure TCsShopper.ChangeList(List : TStringList);
begin
if Assigned(FUpDateList) then
FUpDateList(Self, List);
end;
Рис. 6.5. Отображение файлов и каталогов в SHOPPER32
Обработчик события OnList в программе SHOPPER32 обновляет содержимое списка lbRemoteFiles:
procedure TfrmMain.CsShopper1List(Sender: TObject; List:TStringList);
begin
lbRemoteFiles.Items := List;
lbRemoteFiles.UpDate;
gbRemote.Caption := CsShopper1.RemoteDir;
end;
Поиск сервиса
Процесс преобразования номера порта в соответствующий ему тип сервиса почти не отличается от только что описанного, за исключением того, что на этот раз используется блокирующая функция Winsock getservbyport. Вместо того чтобы подробно рассматривать весь процесс, мы лучше рассмотрим WSAAsyncGetServByPort, асинхронную версию getservbyport.
Чтобы воспользоваться асинхронным режимом, необходимо сначала изменить свойство Access установкой переключателя Non-blocking в групповом поле TypeOfLookup. Затем введите имя порта в текстовом поле edPortName и нажмите кнопку Resolve.
Рис.5.7. Результат преобразования имени сервиса
Когда мы присваиваем номер порта, хранящийся в edPortName.Text, свойству WSPort, он передается методу TCsSocket.SetPortName в качестве параметра ReqdPortName. Убедившись в том, что строка номера порта не пуста, SetPortName вызывает SetAsyncPort. Метод SetAsyncPort копирует номер порта в поле FPortNo — строку с нуль-терминатором. Затем вызов WSAAsyncGetServByPort извлекает номер порта.
Результат этого вызова сохраняется в поле FTaskHandle. Если значение FTaskHandle равно нулю, вызов закончился неудачей. В противном случае он прошел успешно, и тогда SetAsyncPort возвращает управление приложению, оставляя процесс просмотра выполняться в фоновом режиме. После его завершения посредством сообщения от Winsock DLL инициируется AsyncOperation. Переменная Mess проверяется на предмет ошибки. Если ошибки не было, метод возвращает номер порта. В противном случае он вызывает ErrorEvent, чтобы вывести причину ошибки, присваивает флагу FStatus значение Failure и возвращает управление приложению.
Поиск записей
Мы узнали, как определить объект, выбранный пользователем. Но этого недостаточно — необходимо научиться искать объекты на программном уровне. В зависимости от типа элемента вам, возможно, придется просмотреть всю структуру данных, прежде чем вы найдете нужный объект. Если в границах иерархии сортированный список делится на несколько сортированных групп (например, родительский объект соответствует определенной букве алфавита, а дети — всем объектам, описание которых начинается с этой буквы), вы сможете воспользоваться группировкой и ускорить поиск, находя нужного родителя и ограничиваясь поиском среди его потомков.
Потенциальная проблема заключается в многократном просмотре одних и тех же объектов во время поиска. Если поиск производится в направлении от объекта к родителю, один и тот же родитель будет просматриваться для каждого из его детей. Если только содержимое объектов не создает некоторой сужающей поиск группировки, поиск почти всегда безопаснее всего выполнять линейным просмотром полного списка объектов.
В некоторых случаях можно создать индекс или таблицу перекрестных ссылок и воспользоваться ими в программе. Компонент TTreeView работает очень медленно, даже простой перебор узлов занимает много времени. Если заменить его сортированным списком TStringList, будет выполняться очень быстрый двоичный поиск без учета регистра. Найденный идентификатор объекта может ассоциироваться с указателем на объект TTreeNode (список может быть заполнен идентификаторами и указателями на соответствующие им объекты после загрузки всех узлов).
Result := nil; Index := LookupStringList.IndexOf (IntToStr(FindThisValue)); if Index > -1 then Result := TTreeNode(LookupStringList.Objects[Index]);Положи на место!
В асинхронном режиме в отличие от блокирующего можно легко прервать затянувшуюся пересылку файла — достаточно нажать кнопку Abort на вкладке Connect (обратите внимание на то, что в блокирующем режиме эта кнопка недоступна). При нажатии кнопки Abort вызывается метод CsShopper.Abort, который посылает серверу через управляющее соединение команду ABOR. Рассмотрим следующий фрагмент кода:
procedure TCsShopper.Abort; begin ChangeBusy(TRUE); SendFtpCmd(LoadStr(SFtpAbor)); FFtpCmd := FTP_ABORT; ChangeBusy(FALSE); end;При получении кода ответа 226, означающего успешную отмену пересылки, CsShopper.ProcessAbort закрывает соединение данных, а в случае приема файла — стирает локальный файл.
Получение доступа к данным
Чтобы новый класс TDBStatistics мог извлечь анализируемые данные, он должен прежде всего подключиться к компоненту TTable или TQuery. Для этого проще и удобнее всего снабдить наш компонент свойством DataSource. Именно это мы и сделаем. Секция private содержит следующее объявление:
fDataSource : TDataSource;
Свойство DataSource, предоставляющее доступ к этому полю, конечно, становится доступным в режиме разработки благодаря ключевому слову published.
Кроме того, DBStatistics необходимо сообщить о том, какое поле следует анализировать. Это легко достигается с помощью свойства DataField. Во всем этом нет ничего нового, эти свойства можно найти в любом компоненте на вкладке Data Controls. Поскольку эти свойства так часто встречаются, включение их в DBstatistics помогает создать более знакомую обстановку в режиме разработки. Локальное хранение данных
После получения доступа к данным нам потребуется место для их хранения. Процедуры модуля Math работают со статически объявленными массивами; следовательно, нам понадобится такой массив. Мы назовем его Data.
Остается вопрос: каким должно быть максимальное количество элементов в Data? При выборе этого значения приходится учитывать два фактора. Первый фактор — количество записей в таблице среднего (для ваших приложений) размера. Если объем таблицы обычно не превышает 4000 записей, то максимальное количество элементов вполне можно выбрать равным 4500.
Второй фактор — объем доступной памяти. Если расход памяти непринци пиален, массив можно сделать сколь угодно большим. В противном случае оптимальный размер приходится искать методом проб и ошибок.
В нашем примере объявляется массив Data, состоящий из 10 000 элементов (разумеется, значение 10 000 объявлено в виде константы — MaxValues). Для большинства типичных приложений этого вполне достаточно.
Потоки и TPersistent
«Устойчивостью» (persistence) называется способность объекта продолжать свое существование в течение некоторого времени. В Delphi имя TPersistent было присвоено классу, специально разработанному так, чтобы его объекты сохранялись при нескольких запусках программы. Чтобы объект мог пережить завершение программы, важнейшая информация о нем записывается в поток и загружается позднее.
Потоки Delphi умеют работать с классом TPersistent, так что чтение и запись объектов происходит почти автоматически. Однако не все объекты TPersistent равноценны. Компоненты , являющиеся потомками TPersistent, можно сохранять и загружать удобными методами TStream.WriteComponent и ReadComponent. Но другие потомки TPersistent сохраняются в потоках лишь в том случае, если они представляют собой published-свойства компонентов — то есть теряют самостоятельность.
Это становится неудобным, если мы захотим сохранить в потоке, например, шрифтовой объект. Сначала придется объявить новый тип компонента с published-свойством TFont, затем создать экземпляр этого компонента, присвоить шрифтовому свойству наш объект и записать компонент в поток.
Но если все, что вам нужно — это «рабочая лошадка», которая возит на себе TPersistent, необязательно каждый раз объявлять новый класс. Необходим всего один класс для компонента с published-свойством TPersistent; полиморфизм позволяет назначить этому свойству объект любого класса-потомка TPersistent, и он будет сохраняться и загружаться вместе с компонентом.
Компонент TCarrier (см. листинг 9.17) как раз и является таким «вьючным животным». Он спрятан в секции implementation модуля StrmPers, а процедуры WritePersistent и ReadPersistent занимаются созданием, использованием и уничтожением временных экземпляров его объектов. Не забудьте создать свой TPersistent перед тем, как использовать его при вызове ReadPersistent; к этому моменту объект уже должен существовать.
Листинг 9.17. Модуль STRMPERS.PAS
unit StrmPers; interface uses Classes; procedure WritePersistent( Stream: TStream; Persistent: TPersistent ); { ЗАМЕЧАНИЕ: Объект TPersistent должен быть создан до его передачи этой процедуре... } procedure ReadPersistent( Stream: TStream; Persistent: TPersistent ); implementation type TCarrier = class( TComponent ) private FPersistent: TPersistent; published property Persistent: TPersistent read FPersistent write FPersistent; end; procedure WritePersistent( Stream: TStream; Persistent: TPersistent ); var Carrier: TCarrier; begin Carrier := TCarrier.Create( nil ); try Carrier.Persistent := Persistent; Stream.WriteComponent( Carrier ); finally Carrier.Free; end; end; procedure ReadPersistent( Stream: TStream; Persistent: TPersistent ); var Carrier: TCarrier; begin Carrier := TCarrier.Create( nil ); try Carrier.Persistent := Persistent; Stream.ReadComponent( Carrier ); finally Carrier.Free; end; end; end.Потрясающее открытие
Эйс Брейкпойнт набрал рабочий номер Хелен. Она подняла трубку после второго гудка.
— Алло, чем могу помочь?
— Хелен — у меня есть потрясающие новости. Хочу, чтобы ты узнала их первой».
— Отлично, милый, — ответила Хелен. — А что случилось?
— Я нашел важную улику — вернее, я хотел сказать, что Автор помог мне отыскать важное вещественное доказательство.
— Хорошо, что ты связался с ним, Эйс. И что же ты нашел?
— Кожаную перчатку. Она валялась на земле рядом со стоянкой и почти полностью ушла в грязь. Торчал только кончик большого пальца. Если бы я не знал, где искать, то никогда бы не нашел ее.
— Может быть, ее выронил кто-то из машины, припаркованной рядом с твоей, — заметила Хелен.
— Черт возьми! — воскликнул он. — Ты знаешь, той ночью там действи тельно стояла машина. Я запомнил это только потому, что обычно это место остается пустым. Даже не могу вспомнить, как она выглядела. Помню только, что большая и грязно-белого цвета. Но сейчас наверняка не осталось ни единого отпечатка шин.
— А как насчет перчатки? Что ты можешь сказать о ней? — спросила Хелен.
Эйс внимательно осмотрел улику.
— Не стоит и говорить, она вся перепачкана грязью. Снять отпечатки пальцев не удастся. Посмотрим, что там внутри… все промокло… подкладки нет… Постой! Здесь застряла пара волосков. Наверное, с руки вора.
— Это Бохакер , Эйс, — взволнованно прошептала Хелен.
— Дорогая, это невозможно. Какое-то время я действительно думал, что это он. Но я несколько раз пытался дозвониться до него, и к телефону никто не подходил. К тому же теперь, когда у нас есть перчатка…
— Называй это женской интуицией или как хочешь, — прервала его Хелен, — но я просто знаю, что эта перчатка принадлежит Бохакеру.
— Если бы у меня был хоть один волосок, который точно принадлежит ему, то мы бы могли провести анализ ДНК, — заметил Эйс.
— Наверное, нам никогда не удастся это сделать. Дело в том… Эйс! У тебя сохранился плащ с кровью Мелвина Бохакера? Не подойдет ли он для анализа ДНК?
— Конечно, сохранился! — воскликнул он. — Висит у меня в шкафу. Я отнесу его вместе с перчаткой в Крайм-сити.
— Куда?
— Это сеть круглосуточных лабораторий для обслуживания частных детективов. Они проанализируют ДНК и сообщат результаты по факсу через пару часов. Думаю, у меня даже завалялся купон, дающий право на скидку в 2 доллара. Сделаем так: я заброшу вещи в лабораторию и встречу тебя после работы. Мы где-нибудь перекусим, и к тому времени результаты экспертизы уже будут готовы. Как ты к этому относишься?
— Можешь рассчитывать на меня, — ответила она.
Практическая реализация видов
До настоящего момента эта глава выглядела несколько абстрактно. День за днем вы работаете с объектами, компонентами, формами и обработчиками событий — никаких моделей, видов или фреймов. Однако эти абстракции полезны и даже необходимы. Стандартная абстракция «модель/вид» помогает избежать «ловушки RAD» (RAD — Rapid Application Development, быстрое создание приложений), то есть размазывания смыслового кода по многочислен ным обработчикам событий, которые трудно понять, изменить или повторно использовать. Концепция фрейма помогает избежать похожей ловушки и не привязывать вид к конкретному объекту-контейнеру (форме, панели или вкладке диалогового окна). И все-таки теорию следует оценивать по программам, написанным с ее помощью — итак, как же реализовать вид, который можно использовать в нескольких фреймах?
особенно начинающие) любят задавать вопросы
Программисты ( особенно начинающие) любят задавать вопросы типа: «Скажи, на чем ты пишешь?..» Когда-то этот вопрос выглядел вполне логично. Компиляторы, отладчики, серверы, системы управления базами данных и все остальное только-только выходило из каменного века. Программные инструменты разительно отличались друг от друга по качеству и возможностям. Стоило сделать ставку на неудачный инструментарий, и работа становилась излишне тяжкой, а качество результата - низким.
Сегодня стал актуальным другой вопрос: «А чего стоишь ты сам?» Благодаря непрерывной конкуренции современные средства разработчика стали невероятно мощными и качественными, так что среднему программисту вряд ли удастся выжать из них все возможное. Скорее всего, вы спасуете намного раньше, чем ваш инструментарий - если только не узнаете о нем абсолютно все и не доведете свое мастерство программиста до подлинного совершенства.
Книги этой серии предназначены для углубленного изучения программных инструментов. В них рассматриваются нетривиальные возможности, которые невозможно описать в простейшем учебнике. Полноценные проекты заставляют читателя мыслить на уровне эксперта - напрягать серое вещество, лежащее в основе всего, что мы называем «мастерством».
Конечно, это не единственный путь - например, можно добросовестно набивать шишки обо все острые углы новых технологий и наобум пробовать все подряд, пока что-нибудь не заработает. А можно воспользоваться опытом наших авторов, которые уже прошли стадию обучения и попутно сделали кое-какие заметки на память. Мы тщательно отобрали темы, авторов и методику изложения, чтобы читатель не путался в ненужных вступлениях или редких технологиях, которые ему все равно не понадобятся.
Наша главная цель - поднять ваше мастерство настолько, насколько вы сами захотите. Классные инструменты у вас уже есть, осталось лишь стать классным программистом.
Джефф Дантеманн
Моему благодетелю, Иисусу из Назарета. Ты подарил мне то, чего я не заслужил бы и за тысячу жизней.
Дон Тейлор
Дину Беннету (Dean Bennett) и Рэнди Шаферу (Randy Schafer), хорошим друзьям и коллегам.
Джим Мишель
Моей дорогой жене Джоси и прекрасным детям, Дэвиду и Диане, за их поддержку. Маме и папе - за любовь и непрестанные усилия, благодаря которым я стал таким, какой есть.
Джон Пенман
Тиму, брату и другу.
Теренс Гоггин
Моим мальчикам, Сэму и Арту, и их маме Тане. Не могу представить лучшей побудительной причины для продолжения работы.
Джон Шемитц
Преобразование портов и сервисов
Преобразование имен сервисов и портов, как и символьных имен с IP-адресами, может выполняться в блокирующем или псевдоблокирующем (асинхронном) режиме. В блокирующем режиме для этого используются функции getservbyname и getservbyport.
Поиск порта, связанного с определенным сервисом, во многом похож на процесс получения имени хоста. Например, если мы захотим определить номер порта для FTP, следует ввести строку FTP в текстовом поле edServiceName и затем присвоить ее свойству WSService. При этом имя сервиса передается методу TCsSocket.SetServiceName для преобразования. После копирования строки Паскаля ReqdServiceName в строку с нуль-терминатором ServName с помощью функции StrPCopy в строку протокола заносится текст «TCP», один из обязательных параметров для getservbyname. По умолчанию используется протокол TCP, а это означает, что при попытке определить номер порта для сервиса, основанного на другом протоколе (обычно UDP), функция getservbyname вернет указатель NIL. Некоторые сервисы используют либо TCP, либо UDP, либо оба протокола сразу. Чтобы определить, доступен ли сервис для протокола UDP, следует установить переключатель UDP в групповом поле rgProtocol и затем нажать кнопку Resolve.
Метод SetServiceName вызывает функцию getservbyname для получения соответствующего номера порта. Если сервис найден, функция getservbyname
присваивает полю FServ указатель на структуру типа pServent. После этого структура будет содержать номер порта. В противном случае функция возвращает пустой указатель; тогда метод вызывает ErrorEvent, чтобы вывести причину ошибки из WSAErrorMsg, присваивает флагу FStatus значение Failure и возвращает управление вызывающему приложению. Номер порта определяется с помощью следующего оператора:
FPortName := IntToStr(LongInt(abs(ntohs(FServ^.s_port))));
На рис. 5.7 показано, как выглядит результат преобразования.
Преобразование протоколов
Получение имени и номера протокола требуется несколько реже других функций преобразования, но для полноты картины CsSocket поддерживает и их. Эти преобразования выполняются функциями API getprotobyname, getprotobyno, WSAAsyncGetProtoByName и WSAAsyncGetProtoByNo. По своей структуре и использованию эти функции похожи на те, что рассматривались выше.
Прием и передача файлов
Прием и передача могут осуществляться как по отдельности, так и пакетами, состоящими из нескольких файлов, Сначала мы рассмотрим пересылку отдельных файлов. Она начинается двойным щелчком на имени принимаемого или передаваемого файла в списке.
Ключевым моментом при этом является создание нового события. После того как вы поместите список lbRemoteFiles на вкладку Connect, создайте обработчик для его события ObDblClick на вкладке Events инспектора объектов. Это событие обрабатывается процедурой TfrmMain.lbRemoteFilesDblClick. Как показано в следующем фрагменте, в результате имя файла присваивается свойству
CsShopper.Get:procedure TfrmMain.lbRemoteFilesDblClick(Sender: TObject); begin
pbDataTransfer.Visible := TRUE;
if lbRemoteFiles.ItemIndex <> -1 then CsShopper1.Get := lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex]
else
pbDataTransfer.Visible := FALSE; end;
Внутри компонента CsShopper свойство Get передает имя файла в виде параметра Name процедуре Retrieve. Чтобы обеспечить правильную пересылку и сохранение файла, SetUpFileTransfer проверяет расширение файла. Для двоичных файлов (например, EXE, DLL и ZIP) SetUpFileTransfer приказывает FTP Command выдать команду TYPE IMAGE, в результате чего сервер будет пересылать файл в виде непрерывного потока байтов. Для недвоичных файлов SetUp FileTransfer выдает команду TYPE A. После того как FTP-сервер подтвердит получение команды TYPE, SetUpFileTransfer через FTPCommand посылает команду RETR имя_файла.
Программа RESOLVER32 использует ряд интересных
Программа RESOLVER32 использует ряд интересных методов и свойств объекта TCsSocket. RESOLVER32 может преобразовывать символьное имя хоста в его IP-адрес (то есть адрес в Internet), и наоборот. Кроме того, программа определяет взаимное соответствие между номером порта и типом сервиса, а также между номером протокола и его именем. Все эти примеры взяты из практики, поскольку преобразование имен хостов и имен сервисов — самые распространенные операции, выполняемые приложениями Winsock.
На рис. 5.1 показано, как выглядит приложение в Delphi IDE. Щелкните на компоненте CsSocket1, и в окне инспектора объектов появится перечень его свойств (см. рис. 5.2). Содержащиеся в нем стандартные значения хорошо подходят для выполнения преобразований с помощью блокирующих функций. Свойство Service по умолчанию имеет значение NoService, поскольку в нашем приложении не предусмотрено конкретного сервиса для выполнения преобразований.
На рис. 5.3 изображена вкладка Events с несколькими обработчиками событий. При любом изменении статуса Winsock DLL обработчик CsSocket1OnInfo передает информацию от CsSocket к приложению. Аналогично, процедура CsSocket1LookUp передает информацию при завершении работы функции просмотра. Также заслуживает внимания процедура CsSocket1Error, которая сообщает приложению об ошибках, случившихся во время работы CsSocket.
Рис. 5.1. Приложение RESOLVER32
Рис. 5.2. Свойства CsSocket
Рис. 5.3. События CsSocket
При запуске приложения RESOLVER32 процедура Application.CreateForm из файла RESOLVER32.DPR вызывает конструктор TCsSocket.Create, чтобы задать свойствам CsSocket значения по умолчанию. После того как конструктор инициализирует компоненты и успешно обратится к Winsock DLL, процедура TFrmMain.FormCreate (см. листинг 5.5) выполняет ряд других задач.
В частности, метод TMainForm.FormCreate должен проверить свойство Status, обновляемое в CsSocket. Если свойство Status сообщает о наличии сбоев, RESOLVER32 блокирует кнопку Resolve и текстовые поля, устанавливает цвет компонента pnStatus (элемента типа TPanel) в значение clRed и выводит в панели pnStatus сообщение об ошибке. Если же все прошло гладко, RESOLVER32 обновляет элементы в групповом поле gbWSInfo в соответствии со значениями, полученными от Winsock.
Листинг 5.5. Процедура FormCreate главной формы
procedure TfrmMain.FormCreate(Sender: TObject); begin tag := 1; memErrorLog.Clear; memErrorLog.Visible := FALSE; if CsSocket1.Status = Failure then begin pnStatus.Color := clRed; pnStatus.Caption := 'Winsock not available!'; btnResolve.Enabled := FALSE; gbNameRes.Enabled := FALSE; gbServiceRes.Enabled := FALSE; gbProtoRes.Enabled := FALSE; gbTypeOfLookUp.Enabled := FALSE; edMachineName.Text := ''; edVendorName.Text := ''; edVersionNo.Text := ''; edMaxNoSockets.Text := ''; edMaxUDPacketSize.Text := ''; edWSStatusInfo.Text := ''; end else begin with CsSocket1 do begin edMachineName.Text := LocalName; edVendorName.Text := WSVendor; edVersionNo.Text := WSVersion; edMaxNoSockets.Text := WSMaxNoSockets; edMaxUDPacketSize.Text := WSMaxUDPPSize; edWSStatusInfo.Text := WSStatus; Access := Blocking; rgProtocol.ItemIndex := 0; // По умолчанию выбирается TCP end; if CsSocket1.Access = Blocking then begin btnAbortRes.Enabled := FALSE; rbBlocking.Checked := TRUE; end; cbHint.Checked := TRUE; frmMain.ShowHint := TRUE; end; end;
Применение иерархических данных в запросах
Возможности иерархических и реляционных моделей по части запросов сильно расходятся. Реляционная модель хорошо подходит для поиска записей по атрибутам (полям) или объединения таблиц по общим значениям. На SQL такие запросы часто записываются в виде коротких, очевидных выражений.
Однако SQL плохо подходит для описания концепций типа «найти где-то среди потомков объект с зеленым маркером». Возможно, SQL без проблем найдет зеленый маркер, но при этом он понятия не имеет, что такое «потомки объекта». В разделе этой главы, посвященном SQL (см. ниже), приведены некоторые возможные варианты итерационного поиска записей, но, если иерархия находится в памяти, можно получить список потомков в виде набора идентификаторов и использовать его в критерии запроса типа IN. Запрос будет искать значение поля в ограниченном списке вариантов. В листинге13.5 показано, как SQL-запрос создается программой в свойстве TQuery.SQL. При этом SQL выполняет лишь часть работы; сначала иерархический объект вычисляет потомков, пользуясь своими собственными средствами.
Листинг 13.5. Использование SQL для поиска среди потомков
procedure TForm1.FindColoredBoxes (ColorName : String; StartingID : Integer); var DescendantString : String; begin DescendantString := HierarchyObject.GetDescendants(StartingID); with Query1 do begin DisableControls; Close; with SQL do begin Clear; Add('SELECT *'); Add('FROM BoxList T1'); Add('WHERE T1.BoxColor = "' + ColorName + '"'); { Предполагается, что идентификаторы в DescendantString разделяются запятыми } if DescendantString <> '' then Add('AND T1.BoxID IN (' + DescendantString ')'); end; Open; EnableControls; end; end;Пример: если вас интересуют художники всех специализаций, можно найти в иерархии родителя всех художников, на программном уровне получить идентификаторы всех потомков этого объекта и использовать их в критерии. Запись однозначно определяется по ее идентификатору, каким бы специали зированным он ни был. Когда вам потребуется выбрать общую категорию, данная запись будет извлечена среди прочих. Благодаря иерархической структуре данных вам даже не нужно знать, сколько потомков имеет объект «Художник» — вы автоматически получаете их все.
Если иерархия представлена компонентом TOutline или TTreeView, вы можете воспользоваться навигационными средствами этих компонентов для перебора потомков любого объекта. В противном случае объект придется загружать в память и установить связи-указатели между родителями и детьми или же воспользоваться итерационными или рекурсивными методиками, описываемыми ниже.
Пример модели
Хотя файл EMBEDDEDFORMS.PAS прежде всего демонстрирует, как внедренные формы применяются на практике, и предоставляет работоспособную основу для построения мастеров и списков свойств, в нем также присутству ет упрощенная модель данных и четыре вида — как для того, чтобы научить вас пользоваться мастерами, так и в качестве примера внедрения видов друг в друга.
Модуль Data представляет собой «скелет» модуля данных с методами для создания, «загрузки» и «сохранения» объектов Employee (см. листинг 10.10). Вероятно, в реальном приложении эти методы будут представлять собой оболочки для процедур, работающих с базами данных; в нашем случае метод загрузки лишь извлекает «зашитые» в программе фиктивные данные, а метод сохранения вообще ничего не делает. Объект Employee содержит ссылки на два объекта People с личными данными работника и его начальника. Вид Employee View, изображенный на рис. 10.1 и 10.2, позволяет выбрать начальника из раскрывающегося списка, а также отредактировать имя и налоговый код (TaxID) работника.
Самое интересное заключается в том, что для отображения сведений о работнике и начальнике применяется один и тот же вид — для этого создается две различные копии одного объекта вида. В режиме конструирования оба вида выглядят как пустые панели (см. рис. 10.6). При создании формы мы создаем два экземпляра вида PersonIdView (см. листинг 10.7) и размещаем их на соответствующих панелях формы EmployeeIdview.
Рис. 10.6. Вид, одновременно являющийся фреймом
Рис. 10.7. PersonIdView в режиме конструирования
Листинг 10.10. Модуль EMPLOYEEIDVIEWS.PAS
unit EmployeeIdViews; // Copyright © 1997 by Jon Shemitz, //all rights reserved. // Permission is hereby granted to freely use, //modify, and // distribute this source code PROVIDED that //all six lines of // this copyright and contact notice are //included without any // changes. Questions? Comments? Offers of work? // mailto:jon@midnightbeach.com // ---------------------------------------- // Это достаточно правдоподобная реализация вида Employee ID. // Она позволяет вводить имя и налоговый код, а также // указывать начальника. interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls, Models, Embedded, FickleViews, PersonIdViews; type TEmployeeIdView = class(TFickleView, IFrame) SupervisorPnl: TPanel; SupervisorCaptionPnl: TPanel; SupervisorFrame: TPanel; SelectSupervisor: TComboBox; SupervisorLbl: TLabel; EmployeeIdFrame: TPanel; procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure SelectSupervisorChange(Sender: TObject); private SupervisorView, EmployeeView: TPersonIdView; protected procedure ReadFromModel(Model: TModel); override; procedure WriteToModel(Model: TModel); override; procedure SetReadOnly(Value: boolean); override; procedure OnValidChanged( ChangingObject: TObject; View: IView ); end; implementation {$R *.DFM} uses Data; // Создание/уничтожение procedure TEmployeeIdView.FormCreate(Sender: TObject); var Index: integer; begin inherited; SupervisorView := TPersonIdView.CreateEmbedded( Self, SupervisorFrame, efmCentered ); SupervisorView.ReadOnly := True; SupervisorView.AddNotifiee(Self); EmployeeView := TPersonIdView.CreateEmbedded( Self, EmployeeIdFrame, efmCentered ); EmployeeView.AddNotifiee(Self); with DataModel do for Index := 0 to SupervisorCount - 1 do SelectSupervisor.Items.Add( GetEmployeeName(Supervisor[Index]) ); end; // TEmployeeIdView.FormCreate procedure TEmployeeIdView.FormDestroy(Sender: TObject); begin inherited; SupervisorView.RemoveNotifiee(Self); SupervisorView.Free; EmployeeView.RemoveNotifiee(Self); EmployeeView.Free; end; // TEmployeeIdView.FormDestroy // Переопределения IView procedure TEmployeeIdView.ReadFromModel(Model: TModel); begin Assert(Model is TEmployee); with TEmployee(Model) do begin SupervisorView.ReadFromModel(Supervisor); EmployeeView.ReadFromModel(Employee); SelectSupervisor.ItemIndex := DataModel.IndexOfSupervisor(Supervisor.ID); end; // with end; // TEmployeeIdView.ReadFromModel procedure TEmployeeIdView.WriteToModel(Model: TModel); begin Assert(Model is TEmployee); with TEmployee(Model) do begin SupervisorView.WriteToModel(Supervisor); EmployeeView.WriteToModel(Employee); end; // with end; // TEmployeeIdView.WriteToModel procedure TEmployeeIdView.SetReadOnly(Value: boolean); begin inherited; EmployeeView.ReadOnly := ReadOnly; SelectSupervisor.Color := ShowReadOnly_EditColors[ReadOnly]; end; // TEmployeeIdView.SetReadOnly // Изменение начальника procedure TEmployeeIdView.SelectSupervisorChange (Sender: TObject); var ID: TPersonID; Supervisor: TPerson; begin inherited; ID := DataModel.Supervisor [SelectSupervisor.ItemIndex]; Supervisor := DataModel.LoadPerson(ID); try SupervisorView.ReadFromModel(Supervisor); finally Supervisor.Free; end; end; // TEmployeeIdView.SelectSupervisorChange // Уведомление фрейма procedure TEmployeeIdView.OnValidChanged( ChangingObject: TObject; View: IView ); begin Valid := SupervisorView.Valid and EmployeeView.Valid; end; // TEmployeeIdView.OnValidChanged end.Процедура FormCreate создает два вида TPersonIDView и регистрируется как их фрейм. Вид начальника доступен только для чтения, однако начальника можно сменить с помощью раскрывающегося списка. FormDestroy отменяет регистрацию (то есть освобождает интерфейсную ссылку) и уничтожает внедренные формы.
ReadFromModel и WriteToModel, в сущности, перепоручают свою работу внедренным видам. Обычно рекомендуется, чтобы все функции ввода/вывода моделей следовали этому примеру и с помощью Assert проверяли, относится ли аргумент-модель к ожидаемому типу. В этом случае при передаче неверного типа модели редактору (или неверного типа вида — процедуре настройки редактора модели) возникает runtime-ошибка.
Пример приложения «Настрой меня сам»
На рис. 12.1 представлена «сборная» копия экрана простейшего приложения, демонстрирующая все возможности, которые вы можете предложить конечному пользователю.
Раскрытое меню содержит три команды:
 | Adjust All Fonts (выбрать новый шрифт для всех элементов); |
| Tab Order (изменить порядок перебора элементов); |
| Show Properties (вызвать инспектор объектов). |
Имеется также контекстное меню, с помощью которого можно изменить фоновый цвет формы.
Наконец, есть еще одно контекстное меню с четырьмя командами:
| Escape/No changes (отменить возможные изменения); |
| Adjust Size & Position (изменить размеры и положение элемента); |
| Change Font (изменить шрифт отдельного элемента); |
| View Properties (вызвать инспектор объектов). |
На это контекстное меню ссылается свойство PopupMenu каждого элемента.
В левой части экрана находится инспектор объектов, доступный во время выполнения. С его помощью пользователи могут просматривать и изменять некоторые дополнительные свойства элементов.
А самое замечательное в этом динамическом интерфейсе «сделай сам» — то, что на прилагаемом CD-ROM имеется простой проект STARTER.DPR для его создания. Вы можете поместить этот проект в хранилище и при необходимости просто использовать его в качестве шаблона. Все очень просто!
Как видно из первого примера, мы взяли многие средства Delphi, доступные только в режиме конструирования, и перенесли их в режим выполнения.
Рис. 12.1. Средства настройки пользовательского интерфейса
Присоединение DLL на стадии выполнения
Иногда программа может прекрасно работать без некоторых DLL. Вспомним пример с DLL для преобразования файлов в текстовом редакторе. Пользователи не так уж часто занимаются преобразованием файлов. Скорее всего, большинству из них вообще никогда не придется этим занимать ся. Со стороны программы было бы прямо-таки преступно требовать наличия этих DLL для обычного редактирования файлов. Но именно это и происходит при статическом импорте! Если Windows не сможет найти DLL при загрузке программы, она выдаст сообщение об ошибке и завершит программу.
Кроме того, статический импорт DLL не обладает достаточной гибкостью. Если компилятор должен заранее знать, какие DLL потребуются программе, мы возвращаемся к старой проблеме — чтобы работать с новым форматом, придется исправлять исполняемый файл программы. Нехорошо.
На помощь приходит динамический импорт. Вместо того чтобы заставлять Windows автоматически загружать и подключать DLL при загрузке программы, почему бы не позволить самой программе при необходимости загрузить DLL и подключиться к ней? В этом случае программа будет работать даже без DLL, хотя и не сможет выполнять некоторые функции. Утакого подхода есть еще одно достоинство — программа может сообщить пользователю о причине возникшей проблемы. Если у пользователя где-нибудь сохранилась копия DLL, он сможет скопировать ее в нужное место и попробовать снова— при этом ему даже не придется перезапускать программу.
Глава 2•32-разрядные DLL в Delphi — когда, зачем и как
В листинге 2.3 содержится новая версия интерфейсного модуля BEEPER.DLL. Директивы условной компиляции позволяют выбрать тип импорта — статический или динамический.
Листинг 2.3. Динамический импорт DLL на стадии выполнения
{ BEEPDLL.PAS — интерфейсный модуль для BEEPER.DLL Автор: Джим Мишель Дата последней редакции: 12/05/97 } unit BeepDLL; {$DEFINE DYNAMIC} { закомментируйте эту строку, чтобы реализовать статический импорт } interface {$IFDEF DYNAMIC} { Объявления процедур для динамического импорта } procedure BeepMe; procedure BeepMeTwo; procedure BeepMeThree; {$ELSE} { Объявления процедур для статического импорта } procedure BeepMe; external "beeper.dll"; procedure BeepMeTwo; external "beeper.dll" name "BeepMe"; procedure BeepMeThree; external "beeper.dll" index 1; {$ENDIF} implementation {$IFDEF DYNAMIC} uses Windows; type BeepMeProc = procedure; var LibInstance : HMODULE; { Логический номер модуля DLL } BeepMePtr : BeepMeProc; procedure BeepMe; begin if (LibInstance = 0) then begin { если DLL еще не загружена, попытаемся загрузить } LibInstance := LoadLibrary("beeper.dll"); { Если LoadLibrary возвращает 0, произошла ошибка } if (LibInstance = 0) then begin MessageBox (0, "Can"'t load BEEPER.DLL', "Error", MB_ICONEXCLAMATION or MB_OK); Exit; end; { DLL загружена, теперь попытаемся найти функцию } BeepMePtr := BeepMeProc (GetProcAddress (LibInstance, "BeepMe")); { Если GetProcAddress возвращает Nil, у нас возникли проблемы} if (Not Assigned (BeepMePtr)) then begin { Предварительно выгрузим DLL, чтобы пользователь заменил ее, если это возможно } FreeLibrary (LibInstance); LibInstance := 0; MessageBox (0, "Can"'t find BeepMe function in DLL.', "Error", MB_ICONEXCLAMATION or MB_OK); Exit; end; end; BeepMePtr; end; procedure BeepMeTwo; begin BeepMe; end; procedure BeepMeThree; begin BeepMe; end; initialization LibInstance := 0; BeepMePtr := Nil; finalization { Если DLL была загружена, ее обязательно нужно выгрузить } if (LibInstance <> 0) then begin FreeLibrary (LibInstance); LibInstance := 0; end; end. {$ELSE} end. {$ENDIF}Я же предупреждал, что этот вариант сложнее!
Да, динамический импорт действительно получается более сложным. Вам приходится вручную программировать те действия, которые Windows автоматически выполняет при запуске программы в случае статического импорта. С другой стороны, этот код более устойчив к ошибкам. Давайте потратим несколько минут и посмотрим, как он работает.
Прежде всего, имена процедур не связываются с функциями DLL непосредственно в интерфейсной (interface) секции модуля, а соответствуют обычным процедурам, определенным в секции реализации (implementation). Именно ключевое слово external вызывает автоматическую загрузку DLL при запуске программы; если удалить его, Windows не станет загружать DLL.
Затем мы определяем процедурный тип и две переменные:
type
BeepMeProc = procedure;
var
LibInstance : HMODULE; { Логический номер экземпляра DLL }
BeepMePtr : BeepMeProc;
Процедурный тип BeepMeProc похож на типы обработчиков событий Delphi. Переменная этого типа (в данном случае BeepMePtr) содержит указатель на процедуру, не имеющую параметров. После того как мы загрузим библиотеку BEEPER.DLL и найдем в ней процедуру BeepMe, ее адрес присваивается переменной BeepMePtr.
LibInstance — логический номер (handle) экземпляра BEEPER.DLL, который возвращается функцией LoadLibrary, если загрузка DLL прошла успешно.
Процедуры BeepMeTwo и BeepMeThree являются псевдонимами для BeepMe, поэтому в версии с динамическим импортом они просто вызывают процедуру BeepMe модуля.
Все волшебство происходит внутри BeepMe. Прежде всего процедура проверяет, загружена ли DLL. Если DLL еще не загружена, процедура вызывает функцию API LoadLibrary, которая ищет DLL и пытается загрузить ее, а также выполняет код запуска DLL (об этом подробно рассказано ниже), после чего возвращает логический номер модуля, который однозначно определяет DLL. Если DLL не найдена или при загрузке произошла ошибка, LoadLibrary возвращает 0, а BeepMe выдает сообщение об ошибке.
Если функция LoadLibrary успешно загрузила DLL, мы вызываем функцию GetProcAddress, которая пытается найти в загруженной DLL функцию с именем BeepMe. Адрес найденной функции присваивается переменной BeepMePtr. Если GetProcAddress не может найти заданную функцию, она возвращает Nil, в результате чего BeepMe выдает сообщение об ошибке и выгружает DLL из памяти.
Если все прошло нормально, то есть DLL была успешно загружена, а процедура BeepMe — найдена, она вызывается через указатель BeepMePtr.
Последнее замечание — ваша программа должна явно выгрузить (используя процедуру FreeLibrary) все DLL, загруженные с помощью LoadLibrary. Для этого используются секции initialization и finalization. При запуске модуля секция initialization присваивает переменным LibInstance и BeepMePtr стандартные значения, означающие, что DLL не загружена. При выходе из программы секция finalization выгружает DLL, если она была загружена ранее.
Проблема общих сторон
Конечно, в действительности генерация фрактальных ландшафтов не сводится к примитивному рецепту «изогнуть, разделить, повторить по вкусу». Вам придется проследить за тем, чтобы каждая линия изгибалась только один раз; к тому же ландшафт еще необходимо отобразить на экране, но это уже подробности.
Первая и самая важная деталь заключается в том, что вы должны следить за своими действиями. Если процедура FractureTriangle() будет просто изгибать все грани подряд, у вас получится что-то вроде рис.8.4. Треугольники не будут образовывать сплошную сетчатую поверхность; появятся «плавающие» группы из четырех треугольников, высота вершин которых не будет совпадать с высотой вершин соседей.
Рис. 8.4. Вот что получается, когда стороны не совпадают
Возможно, рис. 8.5 поможет разобраться в происходящем. Внутренние стороны принадлежат сразу двум треугольникам, мнения которых насчет величины изгиба могут не совпасть. Вершина I является серединой отрезка DF, который принадлежит треугольникам CDF и DEF. Если оба треугольника попытаются самостоятельно задать высоту этой точки, то вершина I в треугольниках 1, 2 и 3 будет находиться на иной высоте, чем она же в треугольниках 4, 5 и 6!
Очевидно, нам потребуется база данных вершин, чтобы положение вершины I можно было задать при обработке треугольника CDF и затем использовать ту же величину смещения для этой вершины при обработке треугольника DEF. Можно попытаться объявить DEF «внутренним» треугольником, рассматривать его в последнюю очередь и использовать «внешние» значения для вершин G, H и I — но взгляните на треугольники GEH и LMN. Отрезки GE и EH принадлежат и «внешним» треугольникам, поэтому для вершин L и M следует использовать «внешние» значения, но отрезок GH находится «полностью внутри», поэтому его необходимо изогнуть. Несомненно, схему с внешними и внутренними треугольниками можно усовершенствовать для правильной обработки таких «внешне-внутренних субтреугольников», но в итоге получится нечитаемый код с высокой вероятностью возникновения ошибок при любых изменениях.
Рис. 8.5. Так треугольники «спорят» из-за вершин
Намного проще определить специальное значение координаты, которое будет присутствовать только у неинициализированных вершин, и заставить FractureTriangle() проверять, не было ли положение середины отрезка задано ранее. Если положение уже задано, FractureTriangle() использует готовое значение; если нет, FractureTriangle() генерирует новую высоту. Возможно, вычисление и просмотр середин внутренних треугольников работают несколько медленнее, чем простая передача аргументов, но программа получается более компактной и наглядной. К тому же на отображение ландшафта неизбеж но уйдет намного больше времени, чем на его расчет.
Проблема произвольной вложенности
При произвольной глубине вложенности и неизвестном количестве поколений потомства начинаются трудности. В SQL нет условных операторов; подзапрос либо находит записи, либо нет. Джо Селко (Joe Celko) посвятил две главы своей книги «SQL for Smarties» (Morgan Kaufman Publishers, 1995) деревьям и графам, а точнее — данным, представляемым в виде визуальных графов, в том числе и в виде иерархических деревьев. Пользуясь нетривиальными приемами, он показывает, как правильно ассоциировать один объект (или узел) с другим.
Если вас устроит простое, но менее эффективное (и заведомо менее элегантное) решение, воспользуйтесь двумя временными таблицами: первая (Final) применяется для накопления результатов нескольких запросов, а вторая (Working) — для хранения результатов последнего запроса. Возможно, в зависимости от используемого SQL-сервера вам придется работать с двумя таблицами Working и переключаться между ними. Алгоритм выглядит так:
Выполнить запрос для поиска детей исходного объекта. Скопировать идентификаторы найденных объектов в таблицу Working. Выполнить запрос для поиска детей объектов, идентификаторы которых хранятся в таблице Working. Если не будет найден ни один объект, прекратить работу. Добавить содержимое таблицы Working в таблицу Final. Очистить таблицу Working и занести в нее все идентификаторы объектов, найденных в результате запроса. Вернуться к шагу 3.Каждый цикл находит объекты следующего поколения, а таблица Final будет содержать все найденные объекты в порядке следования поколений.
и ссылки на длинные строки,
Ссылки на интерфейсы, как и ссылки на длинные строки, подсчитываются. Каждый раз, когда вы создаете копию переменной, содержащей интерфейсную ссылку (непосредственным присваиванием или при передаче параметра процедуре), вызывается метод _AddRef объекта, который увеличивает значение счетчика ссылок. При каждом уничтожении ссылки на интерфейс (непосредственным присваиванием или при выходе за пределы области видимости) вызывается метод _Release объекта, который уменьшает значение счетчика ссылок. Когда значение счетчика достигает 0, объект удаляет себя. «Обычные» объектные ссылки никак не влияют на процесс подсчета ссылок.
Данная схема прекрасно работает — если вы взаимодействуете с объектом только с помощью интерфейсных ссылок. Например, для следующего фрагмента:
type IFoo = interface procedure Foo; end; TFoo = class (TObject, IFoo) procedure Foo; end; procedure TFoo.Foo; begin end; prcedure Bar(InterfaceReference: IFoo); begin end; begin Bar(TFoo.Create); end. ALIGN="JUSTIFY">объект TFoo, созданный вызовом Bar, автоматически уничтожается при выходе из Bar. Но давайте рассмотрим слегка измененный сценарий, в ором интерфейсные ссылки смешиваются со ссылками на объекты:
var ObjectReference: TFoo; begin ObjectReference := TFoo.Create; try Bar(ObjectReference); finally ObjectReference.Free; end; end. Проблема заключается в том, что присваивание ObjectReference := TFoo.Create не влияет на счетчик ссылок объекта. Свойство RefCount продолжает оставаться равным 0, как и при создании объекта. Тем не менее при вызове процедуры Bar происходит неявное присваивание ее параметру InterfaceReference. При этом генерируется вызов _AddRef, в результате которого RefCount становится равным 1. При выходе из Bar заканчивается область видимости параметра InterfaceReference, поэтому генерируется вызов _Release. В результате RefCount снова обнуляется, что приводит к уничтожению объекта. Ссылка Object Reference становится недействительной! При следующем обращении к ней (в нашем случае — при вызове Free) возникает GPF.
Подобный сценарий выглядит достаточно хитроумно, но он неплохо демонстрирует те проблемы, с которыми вы столкнетесь при попытке добавить интерфейсы в старый код. Но даже в некоторых новых программах бывает удобно работать с объектами, смешивая интерфейсные и объектные ссылки (например, при работе с TList интерфейсные ссылки иногда оказывают неоценимую помощь).
В подобных случаях следует принудительно увеличить счетчик ссылок объекта на 1 еще до получения первой интерфейсной ссылки на него. Например, класс TAbstractView из следующего раздела содержит следующий обработчик OnCreate:
procedure TAbstractView.FormCreate (Sender: TObject); begin inherited; _AddRef; // теперь Self можно передавать // в качестве интерфейсной ссылки end; Явный вызов _AddRef означает, что при создании первой интерфейсной ссылки RefCount увеличится до 2 и в дальнейшем никогда не станет равным 0. Следовательно, объект никогда сам не уничтожится и не разрушит ваших объектных ссылок; он будет жить до тех пор, пока вы не освободите его с помощью Free.
Разумеется, явный вызов _AddRef необходим лишь при смешивании объектных и интерфейсных ссылок. Если вы собираетесь взаимодействовать с объектом только через интерфейсные ссылки, к явным вызовам _AddRef следует относиться с большой осторожностью — вы можете нарушить всю систему подсчета ссылок и ваш объект не будет уничтожаться. И наоборот, при работе с «чисто интерфейсным» объектом никогда не создавайте объектных ссылок на него, иначе они станут недействительными после того, как счетчик интерфейсных ссылок упадет до 0 и объект самоуничтожится. Одна из простейших мер предосторожности состоит в том, чтобы поместить все интерфейсные методы в секцию protected — они останутся доступными через интерфейс, но раз вы не сможете обратиться к ним через объектные ссылки, исчезнет и повод эти ссылки создавать.
Проблемы TPersistent и несколько полезных советов
Джон Шемитц и Эд Джордан
Иногда можно обнаружить, что Delphi присваивает значение свойству компонента, используя метод read, а не write. Неосторожность при написании таких методов может привести к большим неприятностям! Джон и Эд поделятся своими соображениями о том, как избежать подобных бед и получить максимум пользы от работы с Delphi.
Свойства объектов Delphi просты и функциональны: они похожи на переменные, но весь процесс их чтения и записи находится под вашим контролем. Вы можете разрешить прямое считывание свойств, словно это обычные переменные, или же указать метод read, вызываемый при каждом чтении данного свойства. Можно разрешить прямую запись свойств или же указать метод write, который вызывается при задании значения этого свойства.
Верно?
Нет, неверно.
Процедура Project()
Проекционная процедура Project() — «рабочая лошадка», от которой зависят все операции графического вывода. Она преобразует трехмерные координаты TTriple в плоские TPixel с использованием одноточечной перспективы и текущих размеров окна.
Фактически эта процедура проводит линию между двумя точками — текущей и точкой перспективы — и определяет, где эта линия пересекается с плоскостью экрана. Сложность листинга 8.3 обусловлена использованием вычислений с фиксированной точкой. (В основном это наследство, доставшееся программе FL3 от ее первых версий, появившихся в те дни, когда вычисления с плавающей точкой были очень медленными. С другой стороны, вычисления с фиксированной точкой сокращают размер базы данных вершин и позволяют разместить всю базу в одном сегменте данных.) Если отказаться от математики с фиксированной точкой, мы получим следующее:
function Project(const P: TTriple): TPixel; { Трехмерное преобразование точки } var Delta_Y: double; Tr, V: TFloatTriple; begin Tr := FloatTriple(P); V := FloatTriple(VanishingPoint); Ratio := Pt.Y / V.Y; Result.X := Round( DisplayWidth * ((V.X - Pt.X) * Ratio + Pt.X)); Result.Y := DisplayHeight - Round( DisplayHeight * ((V.Z - Pt.Z) * Ratio + Pt.Z)); end;Процедура вычисляет отношение глубины точки к глубине точки перспективы и умножает его на разности координат этих точек по осям x и z. Поскольку координаты TTriple принадлежат интервалу 0…1, для получения экранных координат можно просто умножить спроектированные координаты на размер окна.
Продолжаем!
Если тема вас заинтересовала, о DLL можно узнать еще много интересно го. В этой главе я привел достаточно информации, чтобы вы могли заняться самостоятельными исследованиями. Если у вас есть компакт-диски из серии Microsoft Developer's Network, проведите поиск по ключевому слову «DLL» в предметном указателе и прочитайте все, что найдете. Кроме того, почитайте о CreateFileMapping и аналогичных функциях, обращая особое внимание на отличия Windows 95 от Windows NT. С помощью DLL можно сделать много классных штук, но при этом следует проявлять осторожность. Желаю удачи!
|
Программа-фильтр на Delphi
Мы научились создавать консольные приложения, теперь пора воспользовать ся полученными знаниями на практике. Оставшаяся часть этой главы посвящена написанию фильтров как разновидности консольных приложений. После краткого знакомства с фильтрами мы поговорим об анализе командных строк и эффективной работе с файлами. Нам придется отхватить изрядный кусок от стандартной runtime-библиотеки Delphi, поэтому на подробное обсуждение каждой функции не хватит времени. Помните, что электронная документа ция - ваш лучший помощник, почаще обращайтесь к ней.
Эйс проглотил последний кусок гамбургера
Эйс проглотил последний кусок гамбургера и глубоко задумался, без всякого выражения уставившись на соседку по столу. Хорошо понимая, что в ближайшее время он не способен вести светскую беседу, Хелен предложила вернуться в контору и посмотреть, не пришли ли результаты экспертизы.
— Пока ты занимаешься результатами, мне нужно кое-куда зайти, — сказала Хелен, изящно выпархивая из-за стола.
— Ладно,— рассеянно произнес Эйс. Он машинально проследил за тем, как она проследовала к соседнему ресторану. Maison de Mort Rouge Viande был одним из самых шикарных местных заведений. Хелен обожала такие места — еще бы, ведь она привыкла к ним с детства.
Эйс частично вышел из транса.
«Если это действительно Бохакер, — подумал он, — я должен узнать об этом сейчас же. Пока Хелен не слышит, надо связаться с моим Человеком-На-Ули це и узнать, что происходит».
Он извлек из кармана плаща верный сотовый телефон и набрал номер «Норвежских жареных цыплят Бака МакГаука» — далеконе самой шикарной забегаловки.
— Добро пожаловать к Баку, — послышалось в трубке. — Сегодня вечером мы специализируемся на «Куриных Сюрприза х». Будете заказывать?
— Это ты, Бифф? — спросил Эйс.
— Эйс, как дела, дружище?
— Мне нужна кое-какая информация, и побыстрее. Ты давно видел Мелвина Бохакера?
— Забавно, что ты спрашиваешь о нем. Сегодня произошло нечто очень странное.
— Выкладывай.
— Не помню, говорил я тебе или нет, что Бохакер по вторникам и пятницам всегда заказывает «Особо Жирную Курицу». Обычно он сам приходит за своим обедом.
— Ну?
— Сегодня днем он позвонил и отменил свой заказ, — продолжал Бифф. — Сказал, что ему неожиданно понадобилось уехать из города и он не знает, когда вернется.
— Что еще? — торопил Эйс.
— Было довольно шумно, все время проезжали машины. Но мне показалось, что он упомянул о какой-то женщине, с которой собирается встретить ся в Нортон-Сити. Что ты об этом думаешь? Может, его наконец кто-нибудь прикончит?
— Не знаю, Бифф, — ответил Эйс. — Слушай, мне нужно идти. Потом поговорим.
Эйс выключил телефон, сунул его в карман и направился к кассе.
Тем временем изучение похищенного Дневника продолжалось…
Дневник №16, 28 марта. С момента выхода самой первой версии Delphi мне не раз приходилось слышать, что этот пакет отличается от других средств визуального программирования тем, что сильно упрощает работу со всеми трудными аспектами Windows, но при этом позволяет программисту работать на сколь угодно низком уровне, вплоть до самых мелких «болтов и гаек». Я решил исследовать некоторые детали внутреннего устройства Windows 95 и узнать, как добраться до них из приложения, написанного на Delphi.
Одно из главных отличий Windows 3.1 от Windows 95 — вытесняющая мультизадачность и те изменения, которые из нее следуют. В Windows 3.1 мультизадачность была кооперативной (cooperative); это означало, что в любой момент может выполняться только одна задача, и пока она добровольно не отдаст управление, все остальные задачи выполняться не будут. В частности, из этого следует, что одна программа всегда могла заблокировать доступ к системным структурам данных до тех пор, пока не считала нужным разрешить его. Однако в Win95 с ее многопоточностью и вытесняющей (preemptive) мультизадачностью сценарий выглядит иначе — операционная система, наделенная абсолютными полномочиями, сама распределяет кванты процессор ного времени на основании системы приоритетов.
Фирма Microsoft тайком включила в Windows 3.1 библиотеку TOOLHELP.DLL. Хотя в книгах и журналах эта библиотека почти не рассмат ривалась (адокументации к ней практически не существовало), в Delphi 1.0 был включен интерфейсный модуль для работы с ней. Модуль ToolHelp содержал несколько интересных низкоуровневых процедур, в том числе процедуры TaskFirst и TaskNext, с помощью которых программист мог «пройтись» по текущему списку активных задач в системе. Я обрадовался, когда узнал о том, что в последующие версии Delphi был включен аналогичный интерфейсный
модуль, TLHELP32, ориентированный на 32-разрядное окружение. Я решил сконцентрировать свое сегодняшнее расследование на этой теме.
Пропавшая функция Poly
При подготовке полного списка функций модуля Math, приведенного в конце главы, я намеренно пропустил одну из функций. Почему? Потому что фирма Borland тоже не документировала ее! Непонятно, должна эта функция присутствовать в модуле Math или нет. Более того, найти ее можно только при просмотре исходного текста модуля Math во время подготовки главы для этой книги…
Что же делает эта загадочная функция? Выглядит она так:
function Poly(X: Extended; const Coefficients: array of Double):
Extended;
Функция Poly предназначена для вычисления полиномов. Единственное ограничение состоит в том, что это должны быть полиномы лишь одной переменной. Функция Poly получает переменную X, для которой вычисляется полином, и массив коэффициентов. Коэффициенты должны быть упорядочены по возрастанию степеней X.
Следовательно, для следующего полинома:
4x4 [+ 0x3] _ x2 + 3x + 34
массив коэффициентов должен быть упорядочен так:
34, 3, _1, 0, 4
Если бы вам потребовалось снабдить функцию Poly пользовательским интерфейсом, вероятно, получилось бы что-то наподобие программы PolyProject (см. рис.11.2).
Рис. 11.2. Графическое представление
Программа PolyProject (она находится на CD-ROM в подкаталоге этой главы) как раз и является таким интерфейсным приложением. Она позволяет задать полином, а затем выводит его график. Обратите внимание — в главном окне программы PolyProject наряду с надписями имеется несколько текстовых полей для ввода коэффициентов полинома. Однако вся основная работа PolyProject выполняется в обработчике события OnClick кнопки Solve!:
procedure TForm1.SolveButtonClick(Sender: TObject); var i : Integer; XCoes : array[0..4] of double; X,Y, OffsetX, OffsetY : Integer; NewRect: TRect;Прежде всего мы заполняем массив XCoes введенными значениями коэффициентов:
begin XCoes[0] := StrToFloat(TxtX0.Text); XCoes[1] := StrToFloat(TxtX1.Text); XCoes[2] := StrToFloat(TxtX2.Text); XCoes[3] := StrToFloat(TxtX3.Text); XCoes[4] := StrToFloat(Tx1tX4.Text);После этого необходимо задать начало координат для построения графика. Обычно я использую центр элемента TImage, но при желании можно выбрать любую другую точку:
OffsetX := Image1.Width div 2; OffsetY := Image1.Height div 2;Затем мы инициализируем координату X и очищаем график, заполняя Image1 сплошным белым прямоугольником. Присваивание соответствующего значения свойству Image1.Canvas.Brush.Color гарантирует, что график будет выводиться черным цветом:
X := 0; { Для надежности инициализируем X }
NewRect := Rect(0, 0, Image1.Width, Image1.Height);
Image1.Canvas.Brush.Color := clWhite;
Image1.Canvas.FillRect(NewRect);
Image1.Canvas.Brush.Color := clBlack;
Пора заняться вычислениями. Сначала мы определяем положение начальной точки графика. До входа в цикл for мы ничего не рисуем, просто перед любым серьезным рисованием необходимо установить «перо» в исходную позицию. Затем мы вызываем функцию Poly, передавая ей значение из текстового поля с нижней границей диапазона (TxtRangeStart) и массив XCoes:
with Image1.Canvas do begin Y := Trunc(Poly(StrToInt(TxtRangeStart.Text), XCoes)); ...Возможно, вы удивитесь тому, что я округляю результат функции Poly. Это делается исключительно для рисования: функция Poly возвращает значение с плавающей точкой (тип Extended), а Windows API работает только с целыми координатами.
Полученный результат преобразуется в пару (X, Y), которая соответствует нашей центральной точке, после чего «перо» перемещается в эту точку:
X := StrToInt(TxtRangeStart.Text) + OffsetX; Y := OffsetY - Y; MoveTo(X,Y);Затем мы перебираем значения X из заданного интервала, начиная с нижней границы +1 (я только что упоминал о нижней границе) и вплоть до значения верхней границы из соответствующего текстового поля (TxtRangeEnd):
for i := StrToInt(TxtRangeStart.Text) + 1 to StrToInt(TxtRangeEnd.Text) do begin Y := Trunc(Poly(I, XCoes)); X := I + OffsetX; Y := OffsetY - Y; LineTo(X,Y); MoveTo(X,Y); end;Хотя функция Poly является единственной общедоступной , но недокумен тированной функцией модуля Math, в секции implementation можно найти еще несколько интересных процедур (одна из них, например, определяет, является ли величина A «бесконечно малой» по отношению к B!). Ограниченный объем главы не позволяет мне рассказать о них подробнее, но я бы порекомендовал изучить эти функции, если у вас есть исходные тексты и, конечно, терпение!
То, чего не было в Паскале
В модуле Math появилось то, чего никогда не было в Паскале — «официаль ная» функция для возведения в степень. Более того, модуль Math содержит сразу две такие функции.
Первая из них, Power, получает два параметра типа Extended — основание и показатель степени. Вторая функция, IntPower, получает один параметр типа Extended (основание) и один целый параметр (показатель степени).
Отличия между ними заключаются в том, что функция IntPower, как и многие функции модуля Math, написана целиком на оптимизированном ассемблере для работы с Pentium FPU, что делает ее достаточно быстрой.
Если вы не знаете, какую функцию следует использовать в вашем приложении, не огорчайтесь.
Хотя это нигде не объясняется и не документируется, функция Power сама определяет, является ли показатель степени целым числом. Если это так, Power вызывает IntPower. Если же показатель является числом с плавающей точкой, Power вычисляет результат каноническим способом, через натуральный логарифм и экспоненту.
Пропавший оракул
Дон Тейлор
Эйс Брейкпойнт вернулся… но его дневник пропал, скорее всего— был похищен. Эйс начинает охоту за Таинственным незнакомцем, который в свою очередь охотится за тайнами Delphi. Интрига закручивается!
Путешествие, которое вам предстоит, многие назовут странным. Наверное, я первым соглашусь с ними.
Прошло лишь три года с той поры, когда на сцене появились Delphi и Эйс Брейкпойнт. Как известно, среда Delphi была создана на редкость талантли вой командой разработчиков из Borland International. Эйс был создан… в общем, по необходимости.
При изучении Delphi мне стало ясно, что никакое количество слов не сможет передать все аспекты этого невероятного продукта. Нельзя научиться программировать на Delphi, просто прочитав описание — Delphi нужно прежде всего исследоват ь. И эта доля выпала мне — написать путеводитель, возглавить экспедицию и привести подробный пример использования Delphi в реальных ситуациях. Не говоря уже о том, чтобы удерживать внимание читателей на протяжении 200 с лишним страниц!
У меня возникла идея — написать приключенческий сюжет, проходящий через весь учебник, и представить в нем одного из самых необычных консультантов в области программирования всех времен. Я выложил идею Джеффу Дантеманну и затаил дыхание. На всякий случай поясню, что Джефф — не только великолепный специалист; в душе он авантюрист и любитель приключений. Он «дал добро», и я создал Эйса Брейкпойнта, крутого частного сыщика, переквалифицировавшегося в программисты…
Детство Эйса прошло в Хакензаке. Он мечтал стать частным сыщиком, похожим на героев классических фильмов 40-х годов — Фила Марлоу, Сэма Спэйда и Эллери Куина. Но после многих лет учебы и тяжких усилий, затраченных на изучение детективного дела, Эйс обнаружил, что в современном мире частные сыщики 40-х уже не пользуются спросом.
Не падая духом, Эйс решил круто изменить свою карьеру. На сей раз он выбрал профессию, которая наверняка прокормит его, — он стал программи ровать для Windows. Но Эйсу хотелось быть не просто современным профессионалом, а настоящим «человеком 90-х годов». Эйс переехал в Пулсбо, штат Вашингтон, и в течение двух долгих лет посещал вечерние курсы по программированию. Закончив их, он быстро арендовал контору и повесил вывеску.
У Эйса, как и у большинства героев, есть мелкие недостатки. Несмотря на все полученное образование, он бывает подчас грубоват. Хотя он, как может, старается проявлять внимание к нуждам других людей, временами вся его чуткость как-то съеживается, будто дешевый пиджак после стирки. Эйс часто ошибается, но его упорство заслуживает уважения. Столкнувшись с проблемой, он упрямо преследует ее, пока не докопается до ответа.
И последнее замечание. Хотя все приключения Брейкпойнта вымышлены, кое-что остается истинным. Пулсбо — вполне реальный город, находящийся в 15 милях (прямо через залив) к западу от Сиэтла. Когда-то это была рыбачья деревушка, основанная группой норвежских иммигрантов. В наши дни Пулсбо стал в основном туристским городом, его набережные и извилистые улицы забиты сувенирными лавками и ресторанами. Впрочем, я бы не советовал вам переезжать — там уже и так слишком много народа. К тому же в Пулсбо почти все время идет дождь. Честное слово.
Во всем остальном приключения Брейкпойнта имеют очень мало отношения к реальности. И конечно, если в тексте не сказано обратного, все персонажи являются чисто вымышленными и не изображают никаких конкретных людей, живых или умерших.
Возьмите свою любимую закуску, выключите свет, пододвиньтесь поближе к экрану и приготовьтесь к приключению, которое я назову…
Эйс Брейкпойнт и…
«Дело о пропавшем Дневнике»!
Пропажа
В 22:57 я вернулся на стоянку возле конторы. Грязь стала настолько густой, что машина скользила по ней, будто слон на коньках. Она остановилась лишь тогда, когда колеса уперлись в поребрик рядом с парковкой номер 132.
Женщина, звонившая по телефону, обманула меня. Когда я приехал к телефонной будке, там никого не было. Оле сказал, что за весь вечер к телефону никто не подходил. Какая-то странная история. Единственное, что я получил за эту дикую гонку, — бесплатную проверку шин, пока ожидал заказанного кофе.
На каждом шагу поскальзываясь и спотыкаясь, я с трудом доковылял до края стоянки, свернул за угол и пошел к двери.
И тут мое сердце замерло.
Дверь в контору была широко открыта. Пробегая несколько оставшихся шагов, я совершенно точно вспомнил, что, уходя, запер дверь. Тем не менее сейчас она была открыта, а внутри горел свет. Я переступил через порог, молниеносно обшаривая глазами комнату. Ничего не пропало, подумал я. Впрочем, нет — Мьюникса не было видно, но он, наверное, просто отправился погулять через открытую дверь. Тут мой взгляд упал на стол, и у меня перехватило дыхание: пропал Дневник!
Я быстро подошел к столу, переворошил бумаги, обшарил все ящики и в полном отчаянии осмотрел пол. Дневника нигде не было.
Я рухнул в кресло. Телефонный звонок был всего лишь наживкой, выманившей меня из конторы. Благодаря этой женщине (и, судя по всему, еще какому-то сообщнику) меня только что произвели в Болваны Первой Степени.
Мое внимание было настолько занято поисками Дневника, что я не заметил, как в комнату вползло темное облако смога. Сейчас оно покрывало весь пол на уровне чуть выше моих промокших ботинок. В комнате стало темно, а единственное освещение, казалось, идет сквозь туман на полу. Тут в дверном проеме появилась загадочная фигура, притянувшая мой взгляд подобно магниту. Это было призрачное существо; определенно человек, но с первого взгляда не скажешь, мужчина или женщина. Существо заметило мой взгляд и заговорило звучным голосом телеведущего (причем его слова отдавались гулким эхом, что отнюдь меня не успокаивало).
— C возвращением, мистер Брейкпойн т. Вас ждали.
— Погодите минутку, — потребовал я. — Кто вы… или что?
— Начнем с главного. Как вы уже обнаружили, ваш Дневник похищен. Сейчас его читает кто-то другой — причем не только технические заметки, но и все личные записи. Автор решил, что в этой истории вам необходима помощь. По этой причине он предоставил в ваше распоряжение повествова теля.
Я снял шляпу и почесал макушку. — Повествователя?
— Третье Лицо.
— Политически выдержанный, современный вариант Гарри Лайма, знаменитого детектива по прозвищу «Третий человек»? — спросил я.
— Нет. Просто Третье Лицо. То, что проходили на уроках литературы в колледже. Припоминаете?
— В общих чертах, — ответил я. — Я не знаю вашего имени, мистер… или миссис… Послушайте, а вы мужчина или женщина?
— У Третьих Лиц не бывает имени. Третье Лицо — всего лишь литературный прием, и пола у него быть не может. По этой же причине Третье Лицо вообще не обладает собственной жизнью.
— Понятно, — заметил я. — Но ответьте мне на такой вопрос: почему эту историю теперь рассказываете вы, а не я?
— Это временное явление. К концу этой истории контроль над происходящим снова вернется к вам. А пока описывать ход событий — дело повествователя. Представьте, будто вы смотрите по телевизору очередную серию «Меня зовут Коломбо».
— Не знаю, понравится ли мне это.
Простейший пример иерархических рекурсивных данных
Реляционная модель хорошо работает для базовых/подчиненных записей в пределах одной таблицы, если в ней существует лишь один уровень принадлежности — другими словами, если каждая запись либо принадлежит другой записи, либо владеет другой записью. В табл. 13.1 приведен список персонала (состоящий из начальников и подчиненных), который при одном уровне принадлежности можно было бы разделить на две таблицы.
Таблица 13.1. Простейший пример рекурсивных иерархических данных
Emp_ID Boss_ID Emp_Name Boss 1 <nil> Frank Eng Boss 2 <nil> Sharon Oakstein Boss 3 <nil> Charles Willings Staff 1 Boss 1 Roger Otkin Staff 2 Boss 1 Marylin Fionne Staff 3 Boss 1 Judy Czeglarek Staff 4 Boss 2 Sean O'Donhail Staff 5 Boss 3 Karol Klauss Staff 6 Boss 3 James RiordanВ табл. 13.2 перечислены все значения свойств для двух наборов компонентов TTable, TDataSource и TDBGrid, связанных с одной и той же физической таблицей. Первый набор свойств предназначен для вывода родительских записей, а второй — для вывода дочерних записей, принадлежащих текущему выбранному родителю. Свойства MasterSource и MasterFields подчиненного компонента TTable автоматически ограничивают его набором записей, подчиненных текущей записи родительской таблицы.
Таблица 13.2. Значения свойств для отображения записей-родителей и записей-детей
| Свойства компонентов для родительских записей Table1.TableName = 'employees' Table1.IndexFieldName = 'Boss_ID;Emp_ID' Table1.SetRange([''],['']); DataSource1.DataSet = 'Table1' DBGrid1.DataSource = 'DataSource1' |
Свойства компонентов для дочерних записей Table2.TableName = 'employees' Table2.IndexFieldName = 'Boss_ID;Emp_ID' Table2.MasterSource = 'DataSource1' Table2.MasterFields = 'Emp_ID' DataSource2.DataSet = 'Table2' DBGrid2.DataSource = 'DataSource2' |
Чтобы ограничить родительский компонент TTable и не выводить в нем дочерние записи, задайте условие-фильтр, пропускающий лишь записи с пустым полем Boss_ID (это и есть родительские записи).
Замечание
Вместо свойства Filter можно использовать метод SetRange. С помощью этого метода мы заставим Table1 выводить только записи о начальниках (то есть записи с Boss_ID = nil). Вызов Table1.SetRange можно включить в обработчик Table1.AfterOpen, чтобы метод гарантированно вызывался независимо от того, оставлена ли таблица открытой в режиме конструирования или она открывается во время выполнения.
На рис. 13.2 изображена форма Delphi с двумя компонентами TDBGrid, свойства которых настроены в соответствии с табл. 13.2. Слева перечислены записи о начальниках (родительские записи), справа — записи о подчиненных (дочерние записи). Все эти записи взяты из одной физической таблицы.
При каждом изменении DataSource1 (связанного с Table1) происходит автоматическое обновление Table2, как будто выполняется код из листинга 13.1.
Рис. 13.2. Отношения master/detail между записями одной таблицы
Листинг 13.1. Эквивалентный код для автоматического выбора записей
при изменении состояния MasterSource
Замечание
Этот способ сработает лишь в том случае, если в Table2 имеется индекс для поля Boss_ID, чтобы в одной таблице можно было отфильтровать все записи, где в Table1.Boss_ID находится пустая строка, а в другой — записи, для которых выполняется условие Table2.Boss_ID = Table1.Emp_ID. Индекс может содержать дополнительные поля, определяющие порядок записей в отфильтрованном наборе. В нашем случае в Table2 выводятся лишь подчиненные одного начальника, причем их список сортируется по полю Emp_ID. Если таблицей управляет SQL Server, то все столбцы, не относящиеся к категории BLOB (больших двоичных объектов, Binary Large Objects), считаются индексированными, хотя при использовании столбцов, не имеющих физических индексов, производительность работы снижается. Свойство Filter не требует наличия индексов, но по возможности старается использовать их.
Работа с буфером как с потоком
До своего знакомства с Delphi я пользовался для записи и чтения данных двоичного файла методами BlockWrite и BlockRead. Теперь наступили просвещен ные времена, и я предпочитаю работать с потоками и методами Write и Read. Одна из причин заключается в том, что компоненты Delphi сохраняются в потоках. Следовательно, объект, который умеет сохранять и загружать себя методами TStream.Write и TStream.Read, заметно облегчит процесс программирования.
А вот и другая причина — если объект умеет записываться в поток, он способен перенести себя на любое устройство, представленное в виде потока. Такой объект с одинаковой легкостью записывается как в память (через TMemoryStream), так и на диск.
Создавая поток для нового устройства, вы делаете свой код более гибким и универсальным— и зачастую упрощаете работу с данным устройством. Например, обмен информацией с буфером (clipboard) — занятие на любителя. Конечно, объект Delphi TClipboard вам поможет, но для копирования и вставки нестандартных форматов или больших объемов данных все равно придется вызывать загадочные функции API, имена которых начинаются с Global. Поток из листинга 9.14, напротив, позволяет работать с буфером с помощью знакомых методов Write и Read.
Листинг 9.14. Модуль CLIPSTRM.PAS
unit ClipStrm; interface uses Classes, Clipbrd, Consts, WinProcs, WinTypes; type TClipboardMode = ( cmRead, cmWrite ); TClipboardStream = class( TMemoryStream ) private FMode: TClipboardMode; FFormat: Word; public constructor Create( Format: Word; Mode: TClipboardMode ); destructor Destroy; override; end; implementation constructor TClipboardStream.Create; var Handle: THandle; MemPtr: Pointer; begin inherited Create; FMode := Mode; FFormat := Format; { В "режиме чтения" немедленно читаем данные буфера в поток... } if ( FMode = cmRead ) and Clipboard.HasFormat ( FFormat ) then begin Clipboard.Open; try Handle := Clipboard.GetAsHandle( FFormat ); MemPtr := GlobalLock( Handle ); try Write( MemPtr^, GlobalSize( Handle )); finally GlobalUnlock( Handle ); end; Position := 0; finally Clipboard.Close; end; end; end; destructor TClipboardStream.Destroy; var P: PChar; begin { В "режиме записи" копируем в буфер все содержимое потока... } if FMode = cmWrite then begin P := GlobalAllocPtr( HeapAllocFlags, Size ); try Position := 0; Read( P^, Size ); Clipboard.SetAsHandle( FFormat, GlobalHandle( P )); except GlobalFreePtr( P ); end; end; inherited Destroy; end; end.Поток TClipboardStream работает чрезвычайно просто. При его создании необходимо указать формат, а также выполняемую операцию — чтение или запись. Поток, созданный в «режиме чтения», немедленно загружает все содержимое буфера, чтобы данные можно было получить методом Read. Поток, созданный в «режиме записи», ожидает своего уничтожения, а дождавшись, копирует в буфер все, что мы успели в него занести.
В результате получается, что объект может с помощью одного и того же кода сохранить себя на диске (TFileStream), в памяти (TMemoryStream) или в буфере; код для его последующей загрузки из разных источников тоже будет одинаковым.
Работа с контекстным меню
В нашем приложении компонент TSizingRect активизируется с помощью меню PopupMenu1, которое назначено контекстным меню для каждого элемента на форме. На рис. 12.4 изображено меню PopupMenu1 во время выполнения программы, после того как пользователь щелкнул правой кнопкой мыши на компоненте DBImage.
При этом у пользователя есть следующие варианты:
| ничего не делать (Escape/No changes); |
| масштабировать или переместить элемент (Adjust Size & Position); |
| изменить шрифт элемента (Change Font); |
| вызвать мини-инспектора (View Properties). |
Команда Adjust Size & Position вызывает процедуру TFrmMain.AdjustClick (см. листинг 12.4).
Рис. 12.4. Контекстное меню, вызываемое правой кнопкой мыши
Листинг 12.4. Обработчик события OnClick команды Adjust Size & Position
procedure TFrmMain.AdjustClick(Sender: TObject); begin if (Adjust.Checked = True) then begin if ((PopupMenu1.PopupComponent <> ComponentBeingAdjusted) and (PopupMenu1.PopupComponent <> SizingRect1)) then begin MessageDlg( 'You can only adjust one element at a time.' + #13#10 + 'Please unselect the current element before continuing.', mtWarning, [mbOK], 0); Exit; end; Adjust.Checked := False; With TWinControl(ComponentBeingAdjusted) do begin Top := SizingRect1.Top; Left := SizingRect1.Left; Width := SizingRect1.Width; Height := SizingRect1.Height; end; SizingRect1.Cursor := crDefault; SizingRect1.Visible := False; SizingRect1.Top := -40; SizingRect1.Left := -40; SizingRect1.Width := 40; SizingRect1.Height := 40; MiniInspector1.ShowThisComponent (ComponentBeingAdjusted); ComponentBeingAdjusted := Self; { т. е. выделенный элемент } { отсутствует. } end else begin if ((ComponentBeingAdjusted <> Self) and (PopupMenu1.PopupComponent <> ComponentBeingAdjusted)) then begin MessageDlg( 'You can only adjust one element at a time.' + #13#10 + 'Please unselect the current element before continuing.', mtWarning, [mbOK], 0); Exit; end; Adjust.Checked := True; ComponentBeingAdjusted := PopupMenu1.PopupComponent; With TWinControl (PopupMenu1.PopupComponent) do begin SizingRect1.Top := Top; SizingRect1.Left := Left; SizingRect1.Width := Width; SizingRect1.Height := Height; end; SizingRect1.Visible := True; MiniInspector1.ShowThisComponent (ComponentBeingAdjusted); end; end;После выполнения различных проверок TSizingRect совмещается с изменяемым элементом (переменная ComponentBeingAdjusted была создана для тех процедур, которые не могут использовать значение PopupMenu1.PopupComponent). Делается это так:
ComponentBeingAdjusted := PopupMenu1.PopupComponent; With TWinControl(PopupMenu1.PopupComponent) do begin SizingRect1.Top := Top; SizingRect1.Left := Left; SizingRect1.Width := Width; SizingRect1.Height := Height; end; SizingRect1.Visible := True; MiniInspector1.ShowThisComponent (ComponentBeingAdjusted);При этом компонент SizingRect остается активным. Его можно перемещать и масштабировать мышью, как показано на рис. 12.5.
Завершив настройку элемента, пользователь снова щелкает правой кнопкой мыши, чтобы сохранить или отменить изменения (см. рис. 12.6).
Рис. 12.5. Прямоугольник SizingRect
Рис. 12.6. Сохранение или отмена изменений
Если пользователь захочет сохранить результаты настройки и выберет вторую команду (Adjust Size & Position), то изменяемый элемент перемещается и масштабируется в соответствии с новыми параметрами, а прямоугольник SizingRect снова скрывается (этот код также входит в TFrmMain.AdjustClick):
With TWinControl(ComponentBeingAdjusted) do begin Top := SizingRect1.Top; Left := SizingRect1.Left; Width := SizingRect1.Width; Height := SizingRect1.Height; end; SizingRect1.Cursor := crDefault; SizingRect1.Visible := False; SizingRect1.Top := -40; SizingRect1.Left := -40; SizingRect1.Width := 40; SizingRect1.Height := 40; {...}Работа со свойствами элементов TreeData
Некоторые свойства чрезвычайно важны для работы элементов TreeData. Все элементы этого семейства получают информацию из следующих свойств режима конструирования: LookupDatabaseName, LookupTableName, LookupSQL (взаимоисключающее по отношению к LookupTableName), LookupDisplayField, LookupIDField, LookupParentIDField и в случае использования в Delphi2 — LookupSessionName (см. рис. 13.4). Пользуясь значениями этих свойств, элемент TreeData загружает все данные в память, отображает их в виде иерархического дерева и затем закрывает соединение с источником.
Рис. 13.4. Свойства компонентов TreeData
Существует и другой вариант — элементы TreeData также обладают свойством LookupDataSource, с помощью которого можно получить данные через открытый ранее источник. Это позволяет фильтровать и отбирать данные, входящие в элемент, с помощью свойства DataSource.DataSet. Свойство LookupAuto Refresh показывает, нужно ли перезагружать данные при изменении LookupData Source.
Разделяй и сгибай
Чтобы сгенерировать ландшафт, достаточно присвоить случайные высоты трем вершинам равностороннего треугольника, а затем «изогнуть» каждое ребро, поднимая или опуская его середину на случайную величину. Соедините линиями середины трех сторон — исходный треугольник разделится на четыре треугольника. Если теперь применить операции изгиба и деления к каждому из получившихся треугольников, то вскоре у вас получится нечто, невероятно похожее на реальный ландшафт (см. рис. 8.1, 8.2 и 8.3).
Рис. 8.1. Каркасный фрактальный ландшафт
Рис. 8.2. Фрактальный ландшафт с заполнением
Рис. 8.3. Фрактальный ландшафт со светотенью
Разумные решения
Несмотря на то что это странное поведение (чтение вместо записи) наблюдается уже в трех версиях Delphi, нельзя исключить возможность, что Borland когда-нибудь все же сочтет его ошибочным и исправит. Следовательно, вы должны избегать любых решений проблемы GPF при полной или частичной загрузке, которые перестанут работать, если метод write все же будет вызван в ходе загрузки компонента.
В случае GPF при полной загрузке обеспечить «совместимость с будущими версиями» оказывается несложно. Нам известно, что при загрузке объекта TPersistent из потока Delphi вызывает его метод read. Следовательно, как показано в листинге 9.1, конструктор Create объекта должен создать объект соответствующего типа и присвоить его private-полю данного свойства. Это выглядит несколько расточительным, если свойство не всегда должно задавать ся или сохраняться, но пара сотен лишних байт на диске или дополнитель ных команд кода Create несущественны для современных Pentium с 16 или 32 Мб памяти.
Листинг 9.1. PERSIST.SRC
{interface} type DemoComponent = class(TComponent) private fGlyph: TBitmap; fGlyphWritten: boolean; procedure SetGlyph(Glyph: TBitmap); { снаружи не видно } protected constructor Create(Owner: TComponent); override; procedure Loaded; override; public published property Glyph: TBitmap read fGlyph write SetGlyph; end; {implementation} constructor DemoComponent.Create(Owner: TComponent); begin inherited Create(Owner); fGlyph := TBitmap.Create; { Обязательно создайте для данного поля пустой объект } end; procedure DemoComponent.SetGlyph(Glyph: TBitmap); begin if fGlyph <> Glyph then { fGlyph = Glyph, когда SetGlyph } begin { вызывается процедурой Loaded } fGlyph.Free; { Assign может закончиться неудачно, } { если целевое поле не пусто: } fGlyph := TBitmap.Create; { Free/Create/Assign намного надежнее } fGlyph.Assign(Glyph); end; { Извлекаем все необходимые данные и устанавливаем флаг PropertyWritten} fGlyphWritten := True; end; procedure DemoComponent.Loaded; begin inherited Loaded; { Не забывайте сделать это! } if (not fGlyphWritten) and (not fGlyph.Empty) then SetGlyph(fGlyph); { Извлекаем все необходимые данные } end;С частичной загрузкой дело обстоит несколько сложнее. К счастью, компоненты Delphi содержат метод Loaded, который можно переопределить для выполнения любых завершающих действий. С помощью метода Loaded и незначительных изменений в программе проблему частичной загрузки удается решить.
Первое, что необходимо сделать, — добавить флаг fPropertyWritten для каждого свойства TPersistent, которое может сохраняться (см. листинг 9.1). При создании объекта флагу присваивается значение False, и лишь в методе write оно может измениться на True.
Затем следует переопределить (с помощью ключевого слова override) метод Loaded вашего компонента и добавить в него строку примерно такого вида:
if not fPropertyWritten then
SetProperty(fProperty)
чтобы метод write вызывался из Loaded в том (и только в том!) случае, если он не был вызван при загрузке компонента.
Наконец, представьте себе, что произойдет при попытке присвоить свойству типа TPersistent тот же самый объект, который в нем уже содержится. Вы уничтожаете имеющееся значение (Free), создаете новый «пустой» экземпляр (Create) и затем присваиваете (Assign) ему новое значение, которое указывает на первоначальный (уже уничтоженный вами) экземпляр. Вряд ли это то, что вы хотели получить! Избежать такой ситуации можно, воспользовавшись фрагментом кода, приведенным в листинге 9.2. При этом private-объект уничтожается лишь в том случае, если новое значение не совпадает с существую щим. Дополнительная проверка гарантирует, что SetProperty(fProperty) больше не приведет к возникновению GPF и не станет причиной особых накладных расходов, если «чтение вместо записи» все же исчезнет из Delphi.
Листинг 9.2. PERSIST2.SRC
if fProperty <> NewPropertyValue then begin fProperty.Free; { Assign 'через' TPersistent } fProperty := TPropertyType.Create; { может и не пройти: } fProperty.Assign(NewPropertyValue); { Free/Create/Assign надежнее } end; { Извлекаем все необходимые данные из NewPropertyValue } fPropertyWritten := True;Перспективы
Подозреваю, что «чтение вместо записи» возникло в результате слишком усердной оптимизации. На первый взгляд оправдать его довольно трудно, но каждый раз, когда в Delphi обнаруживается ошибка или неудачное решение, я спрашиваю себя — а часто ли мне приходилось создавать или использовать приложения, которые работали бы устойчивее Delphi или обладали лучшим соотношением удачных и неудачных решений? Ответ всегда один: крайне редко… если вообще приходилось.
Наконец, следует помнить и о том, что метод write вызывается во время загрузки простых типов (например, целых, перечисляемых типов и строк), а проблема с объектами TPersistent и их потомками не представляет особых сложностей.
Реализация нового интерфейса
Как всегда, самое ужасное спрятано в реализации. За кулисами FMDD происходит немалая работа. Обработка FMDD распадается на три отдельные, но взаимосвязанные подзадачи:
Процедура AcceptDropFiles должна сохранить логический номер окна передаваемого элемента и обработчик OnDrop для будущего использования. Кроме того, процедура должна вызвать DragAcceptFiles, чтобы разрешить обработку сообщений WM_DROPFILES данным окном, и субклассировать окно, чтобы оно могло обрабатывать сообщения. Нам потребуется обработчик сообщений Windows, который при получении WM_DROPFILES конструирует объект TDragDropInfo и передает его соответствующему элементу. Процедура UnacceptDroppedFiles должна прекратить субклассирование окна и вызвать DragAcceptFiles, чтобы в дальнейшем сообщения WM_DROPFILES окну уже не посылались.Поскольку брошенные файлы могут приниматься сразу несколькими окнами, нам придется вести список логических номеров окон и соответ ствующих им обработчиков. При вызове AcceptDroppedFiles информация об элементе заносится в такой список. Процедура, обрабатывающая сообщение WM_DROPFILES, просматривает логические номера окон в списке и определяет, какому объекту следует направить событие OnFMDragDrop. Наконец, процедура UnacceptDroppedFiles удаляет информацию об элементе из списка. К счастью, в Delphi существует компонент TList, предназначенный именно для работы со списками. С его помощью операции добавления, удаления и просмотра элементов выполняются проще простого.
Самой сложной частью реализации является субклассирование — в основном из-за того, что оно требует знания многих внутренних механизмов Windows. Ранее я в общих чертах рассказал о субклассировании, но намерен но не стал говорить о том, как оно выполняется, пока мы не добрались до реализации. Этот момент наступил, снимайте белые перчатки.
Реализация сервера
Приемники 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;Редакторы моделей
Мастера и списки свойств являются редакторами моделей— вы передаете им объект модели, они выполняются и затем возвращают управление. Если пользователь нажал кнопку OK и изменил модель, возвращаемый результат равен True; в противном случае — False. Абстрактные шаблоны из проекта EMBEDDEDFORMS.DPR позволяют создавать реальных мастеров и списки свойств, которые могут совместно использовать объекты моделей и виды. От вас требуется следующее:
| создайте новую форму путем наследования от TAbstractWizard или TAbstract PropertySheet; |
| задайте ее заголовок; |
| для мастеров — выберите изображение и отрегулируйте ширину графической панели. |
| напишите небольшую процедуру Initialize, которая поставляет информацию о заголовках страниц и классах вида, как показано в следующем фрагменте файла TESTSHEET.PAS: procedure TPropertySheet.Initialize; begin InitializeSheet( ['Name/Supervisor', 'Birthday', 'Address'], [TEmployeeIdView, TBirthdayView, TAddressView] ); end; // TPropertySheet.Initialize |
Абстрактный мастер и абстрактный список свойств делают все остальное; оба автоматически масштабируются, чтобы вместить наибольший вид. Мастер управляется стандартными кнопками Prev/Next/OK; список свойств блокирует кнопку OK при наличии неверных данных на странице за исключением ситуации, при которой хотя бы одна страница была неверной еще до вызова EditModel. В обоих случаях на входе вызывается метод ReadFrom Model для всех видов, а на выходе — метод WriteToModel для всех видов, если пользователь нажал кнопку OK. Список свойств обладает свойством ReadOnly, поэтому вы можете разрешить пользователям просматривать объекты без возможности их изменения. И мастер, и список свойств являются «чисто интерфейсными» объектами, не имеющими public-методов, так что вам не придется беспокоиться о Free или try..finally. Например, в листинге 10.7 приведен фрагмент модуля MAIN.PAS, в котором создаются и запускаются примеры мастера и списка свойств.
Листинг 10.7. Запуск редакторов моделей
procedure TTestForm.EditModel(Editor: IModelEdit; Model: TModel); begin {$ifdef ReadOnly} Editor.ReadOnly := True; {$endif} // ReadOnly if Editor.EditModel(Model) then ShowMessage('OK!') else ShowMessage('Abort ...'); end; // TTestForm.EditModel procedure TTestForm.RunWizard(Sender: TObject); var Employee: TEmployee; begin Employee := DataModel.NewEmployee; try EditModel(TWizard.Create(Self), Employee); finally Employee.Free; end; end; procedure TTestForm.RunSheet(Sender: TObject); var Employee: TEmployee; begin Employee := DataModel.LoadEmployee(3); try EditModel(TPropertySheet.Create(Self), Employee); finally Employee.Free; end; end;Лично меня в реализации мастера и списка свойств поражает, как просто выглядит такой обобщенный код на Delphi. Ключевым здесь является аргумент-массив array of TViewClass, передаваемый InitializeSheet() и Initialize Wizard() (см. листинг 10.8).
Листинг 10.8. Метод TAbstractPropertySheet.InitializeSheet
// из файла PropertySheets.pas
procedure TAbstractPropertySheet.InitializeSheet( Captions: array of string; Views: array of TViewClass ); var MaxSpan: TSpan; Index: integer; Sheet: TTabSheet; ActualView: TAbstractView; begin Assert( fViews.Count = 0, 'Should only call ' + Name + '.InitializeSheet once' ); Assert( High(Captions) >= Low(Captions), // можно использовать 'Must have at least one tab' ); // Slice() для передачи // пустых массивов Assert( High(Captions) = High(Views), 'Must have same number of Captions as of Views' ); MaxSpan := Point(0, 0); for Index := Low(Captions) to High(Captions) do begin Sheet := TTabSheet.Create(Self); with Sheet do begin PageControl := Self.PageControl; Caption := Captions[Index]; end; // with Sheet ActualView := Views[Index].CreateEmbedded ( Self, Sheet, efmTopLeft ); fViews.Add(ActualView); ActualView.AddNotifiee(Self); MaxSpan := UnionSpan(MaxSpan, ActualView.Span); end; // for Sheet := PageControl.ActivePage; Width := (Width - Sheet.Width) + MaxSpan.X; Height := (Height - Sheet.Height) + MaxSpan.Y; end; // TAbstractPropertySheet.InitializeSheetТри оператора Assert проверяют, что список свойств еще не настроен, что в нем имеется хотя бы один заголовок и что количество заголовков совпадает с количеством классов вида. Обожаю Assert — лишь после того, как необходимость в конструкции {$IfOpt D+} {$Endif} отпала, я понял, как громоздко она выглядит. Assert проще ввести, он компактен и легко читается.
Габариты (spans) определяются в файле EMBEDDED.PAS. Они представляют собой обычную пару «ширина/высота», то есть BottomRight прямоугольника TRect, у которого Top и Left равны 0:
function TEmbeddedForm.Span: TSpan; begin Result.X := Width; Result.Y := Height; end; // TEmbeddedForm.SpanФункция UnionSpan очень похожа на функцию Windows API UnionRect за исключением того, что она работает с габаритами, а не с прямоугольниками. Присваивая MaxSpan пару (0, 0), мы готовимся к определению минимального прямоугольника, вмещающего все виды из массива Views.
Вся настоящая работа выполняется в цикле при переборе элементов массива Captions. Для каждого элемента массива мы создаем новую вкладку (TTabSheet), размещаем ее на элементе-странице (TPageControl) и задаем текст заголовка. Затем аргумент Views используется для создания нового вида. Мы добавляем новый вид в общий список (Tlist), приказываем ему обращаться к фрейму при каждом изменении Valid и настраиваем MaxSpan.
После того как все виды будут включены в список, мы определяем, сколько места следует выделить «вокруг» MaxSpan для фрейма, заголовка, кнопок и корешков вкладок. Для этого мы вычисляем разность между габаритами формы и габаритами PageControl.ActivePage.
TAbstractWizard выглядит почти так же, но оказывается чуть более сложным, потому что вместо вкладок мы используем три панели: внешнюю панель, панель заголовка (прижатую к верхнему краю — top-aligned) и панель фрейма (заполняющую клиентскую область — client-aligned). При активизации конкретной страницы мы просто переводим на передний план нужную внешнюю панель (листинг 10.9).
Листинг 10.9. Метод TAbstractVizard.SetCurrentPage
// из файла Wizards.pas
property CurrentPage: integer read fCurrentPage write SetCurrentPage; procedure TAbstractWizard.SetCurrentPage (Value: integer); var LastPage, PageIsValid: boolean; begin Assert(TObject(fPanels[Value]) is TPanel); Assert(TObject(fViews[Value]) is TAbstractView); // Сочетание Assert(is) со 'слепыми' преобразованиями типов // обеспечивает отладочную безопасность конструкции "as" // без (особой) потери производительности fCurrentPage := Value; TPanel(fPanels[Value]).BringToFront; LastPage := Value = fPageCount; PageIsValid := TAbstractView(fViews[Value]).Valid; PrevBtn.Enabled := Value > 0; NextBtn.Enabled := PageIsValid and (not LastPage); OkBtn.Enabled := PageIsValid and LastPage; end; // TAbstractWizard.SetCurrentPageКак видно из листинга 10.9, еще одна приятная особенность Assert заключается в том, что пара «Assert/слепое преобразование типа» обеспечивает полноценную проверку на совместимость типов при отладке, но не отражается на производительности окончательной (поставляемой заказчику) версии. Во всем остальном код несложен: мы задаем fCurrentPage и переводим соответствующую панель на передний план. Затем проверяем, является ли данная страница первой или последней и корректно ли она заполнена (Valid), после чего соответствующим образом задаем состояние кнопок Prev, Next и OK.
Оставшийся код в файлах WIZARDS.PAS и PROPERTYSHEETS.PAS не содержит никаких хитростей. Хотя я буду рад и польщен, если вы сочтете его достойным изучения, для успешного использования в нем совершенно не обязательно разбираться. Поэтому я не буду переводить на него бумагу; если этот код вас действительно заинтересует, найдите его на CD-ROM.
Режим с заполнением
Каркасный режим работает относительно быстро и неплохо обрисовывает общую структуру поверхности, но обладает большим недостатком: сетка получается прозрачной. Другими словами, задний склон холма виден сквозь передний.
В серьезных графических приложениях используются сложные алгоритмы «отсечения скрытых линий», но FL3 не является серьезным приложением и убирает скрытые линии методом «грубой силы», рисуя поверх них (см. рис. 8.2).
Другими словами, DrawTriangle() сначала рисует задние треугольники, чтобы передние треугольники рисовались позже и закрывали их. При исходном вызове DrawTriangle() этой процедуре передается треугольник, расположенный «вершиной вниз» — вершина A расположена спереди, в нижней части окна, а вершины B и С — сзади, ближе к верхней части окна (см. рис. 8.8). Следовательно, фрагмент
DrawTriangle(Canvas, CA, BC, C, Plys, True); DrawTriangle(Canvas, AB, B, BC, Plys, True); DrawTriangle(Canvas, BC, CA, AB, Plys, False); DrawTriangle(Canvas, A, AB, CA, Plys, True);сначала рисует левый субтреугольник, а затем — правый. Ориентация этих «внешних» субтреугольников совпадает с ориентацией треугольника ABC, а порядок перечисления параметров в рекурсивных вызовах DrawTriangle() гарантирует, что новая точка A будет расположена спереди, а точки B и C — сзади.
Третья строка вызов рисует «внутренний» субтреугольник, который визуально находится перед вторым (правым верхним) треугольником. Внутренний субтреугольник всегда перевернут по отношению к своему внешнему треугольнику, поэтому при вызове DrawTriangle() он располагается «вершиной вверх». Порядок перечисления параметров гарантирует, что при таком вызове вершина A остается сзади, а B и C — спереди, в нижней части экрана. Если вы просмотрите набор рекурсивных вызовов, соответствующих ветви not PointDn в процедуре DrawTriangle(), то увидите, что расположенные «вершиной вверх» треугольники рисуются в порядке «сзади вперед, справа налево»1.
Четвертый вызов DrawTriangle() рисует последний, передний субтреугольник.
Рис. 8.8. Порядок рисования и ориентация треугольников
Режим со светотенью
В светотеневом режиме мы пытаемся воспроизвести изображение более реалистично и выбираем цвет каждого треугольника в зависимости от угла между его поверхностью и лучами «солнца». Треугольники, расположенные перпендикулярно лучам, выглядят светлее тех, что расположены под углом (см. рис.8.3). Хотя светотень, например, хорошо показывает структуру поверхности речного русла, в целом пейзаж выглядит… слишком серым. Вы можете поэкспериментировать с палитрой и написать свою функцию LandColor(), чтобы сделать изображение псевдоцветным.
Сброс груза
Я перешел к шагу 3. Задача заключалась в том, чтобы определить номера столбца и строки для первого дня месяца и для положения курсора. С помощью несложных вычислений я получаю разность между двумя датами (в днях), которую затем можно прибавить к дате начала месяца для получения абсолютной даты.
Разумеется, первый день месяца всегда выводится в первой строке, каким бы днем недели он ни был. Со строкой все ясно. Поскольку я не изменял стандартного порядка дней недели (с воскресенья до субботы), день недели для первого числа месяца дает мне базовый номер столбца. Дальше остается лишь переместиться в календаре на нужное количество дней. К счастью, пакет Orpheus включает мощные процедуры для арифметических вычислений и преобразования дат, заметно облегчающие мою задачу. Функция вычисления даты приведена в листинге 14.3.
Листинг 14.3. Вычисление даты по положению курсора
function DatePointedTo : TOvcDate; var Idx : Longint; DOW : Integer; Day1 : TOvcDate; begin { Вычисляем первый день как Row = 1, Col = день недели, затем вычисляем смещение для даты под курсором и складываем. } Day1 := DMYToDate(1, Calendar.Month, Calendar.Year); DOW := Ord(DayOfWeek(Day1)) + 1; Idx := (RNum - 1) * 7; if CNum < DOW then Idx := Idx - (DOW - CNum) else if CNum > DOW then Idx := Idx + (CNum - DOW);1 Result := IncDate(Day1, Idx, 0, 0); end; { DatePointedTo }Осталось выполнить тривиальную работу — преобразовать дату и содержимое текстового поля в строку и занести ее в TStringGrid. Кроме того, мне показалось, что текстовое поле после завершения перетаскивания стоит очистить. Поддержка перетаскивания несколько снизила возможности редактирования в текстовом поле, поэтому очищать его вручную было бы утомительно.
Примечание для себя: в данном случае текстовое поле следует очищать в обработчике события перетаскивания, поскольку эта операция должна выполняться лишь в случае успешного завершения. Если бы я захотел очищать текстовое поле независимо от того, состоялось перетаскивание или нет, это следовало бы делать в обработчике OnEndDrag текстового поля.
Заметки на память: 1) проследить за тем, чтобы свойство Initialize компонента OvcCalendar было равно True. В противном случае календарь окажется в неопределенном состоянии! 2) свойство DrawHeader должно иметь значение False, чтобы в календаре не выводилось ничего, кроме дат.
В листинге 14.4 приведен исходный текст всего модуля.
Листинг 14.4. Демонстрационная программа для перетаскивания
{——————————} {Перетаскивание (демонстрационная программа)} {DRAGMAIN.PAS : Главный модуль } {Автор: Эйс Брейкпойнт, N.T.P. } {При содействии Дона Тейлора } { } { Приложение, демонстрирующее } основные принципы } { внутреннего перетаскивания. } { } { Написано для *High Performance Delphi 3 Programming* } { Copyright (c) 1997 The Coriolis Group, Inc.} { Дата последней редакции 3/5/97 } {————————} unit DragMain; interface uses SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls, Forms, Dialogs, Grids, StdCtrls, OvcBase, OvcCal, OvcData, OvcDT, ExtCtrls; type TDDDemoForm = class(TForm) Calendar: TOvcCalendar; OvcController1: TOvcController; EditBox: TEdit; StringGrid: TStringGrid; Label1: TLabel; Bevel1: TBevel; QuitBtn: TButton; Panel1: TPanel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; Panel2: TPanel; procedure QuitBtnClick(Sender: TObject); procedure EditBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure CalendarDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); procedure CalendarDragDrop(Sender, Source: TObject; X, Y: Integer); private { Private declarations } public { Public declarations } end; var DDDemoForm: TDDDemoForm; implementation {$R *.DFM} procedure TDDDemoForm.QuitBtnClick(Sender: TObject); begin Close; end; procedure TDDDemoForm.EditBoxMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if (Button = mbLeft) and (EditBox.Text <> "") and not (ssDouble in Shift) then TEdit(Sender).BeginDrag(False); end; procedure TDDDemoForm.CalendarDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := True; end; procedure TDDDemoForm.CalendarDragDrop(Sender, Source: TObject; X, Y: Integer); var RHeight : Integer; CWidth : Integer; RNum : Integer; CNum : Integer; s : String; function DatePointedTo : TOvcDate; var Idx : Longint; DOW : Integer; Day1 : TOvcDate; begin { Вычисляем первый день как Row = 1, Col = день недели, затем вычисляем смещение для даты под курсором и складываем. } Day1 := DMYToDate(1, Calendar.Month, Calendar.Year); DOW := Ord(DayOfWeek(Day1)) + 1; Idx := (RNum - 1) * 7; if CNum < DOW then Idx := Idx - (DOW - CNum) else if CNum > DOW then Idx := Idx + (CNum - DOW); Result := IncDate(Day1, Idx, 0, 0); end; { DatePointedTo } begin RHeight := Calendar.ClientHeight div 6; RNum := Y div RHeight + 1; CWidth := Calendar.ClientWidth div 7; CNum := X div CWidth + 1; { Заносим дату и описание задачи в список строк } s := DateTimeToStr(OvcDateToDateTime (DatePointedTo)) + " - " + EditBox.Text; StringGrid.Cells[0, StringGrid.RowCount - 1] := s; { Добавляем в список пустую строку } StringGrid.RowCount := StringGrid.RowCount + 1; EditBox.Text := ""; end; end.Конец записи (19 марта).
Зловещая фигура наклонилась вперед, внимательно читая похищенный Дневник. Взгляд скользнул на следующую страницу.
Шаблоны компонентов и составные компоненты
Возможное решение заключается в использовании такой новинки Delphi3, как шаблоны компонентов (component templates). Шаблоны позволяют объединить в группу взаимосвязанные компоненты (вместе с именами и обработчиками событий) и поместить ее в палитру компонентов для повторного использования. Превосходная идея — но не совсем то, что требуется в нашем случае, потому что в итоге мы получим просто набор компонентов на форме. Если нам потребуется разместить один и тот же вид на двух различных формах, станет ясно, что набор компонентов не является самостоятельным объектом и не может иметь своих методов — как же тогда приказать виду прочитать или записать свою модель?
Например, если в виде Employee должны присутствовать два внутренних вида с информацией о разных людях, то попытка размещения двух экземпляров шаблона на одной форме приведет к тому, что элементы второго экземпляра потеряют свои сохраненные имена и будут переименованы в Label1, Edit1 и т. д. В сценарии со сложным диалоговым окном все вкладки окажутся в одном модуле, а изменение шаблона не приведет к изменению созданного на его основе экземпляра.
Похожий, но более «мощный» подход — превратить вид в составной (compound) компонент, который включает в себя другие визуальные компоненты в виде private-полей. Но если вам уже приходилось это делать, вы наверняка знаете, что создание и масштабирование такого компонента превращается в сущий кошмар. Вместо того чтобы просто разместить компоненты на форме, как мы все привыкли делать, приходится создавать каждый внутренний компонент на программном уровне. Вместо того чтобы перетаскивать объекты мышью и задавать их свойства в инспекторе объектов, пока не получится что-то приличное, приходится вручную задавать значения всех свойств. Конечно, теоретически это возможно, но программирование становится очень медленным, нудным и чреватым ошибками. В итоге получается большой объем кода, который очень трудно прочитать и/или изменить. Существует и другой, худший аспект — поскольку это занятие настолько тягостно, программист пытается ограничиться минимальным количеством свойств, и в результате на форме возникает уродливая и неудобная мешанина компонентов. Возможно, построенный подобным образом вид содержит все необходимые «фишки», но пользы от него оказывается немного.
Мы могли бы избежать всех трудностей, связанных с ручным построением компонентов, если бы визуально сконструированную форму можно было преобразовать в компонент. На самом деле Delphi позволяет сделать это, однако не слишком простым или очевидным способом. Вам придется купить или построить специальный компонент, работающий только в режиме констру ирования, который задает недокументированное свойство формы IsControl, включить в форму нужный код и вручную исправить DFM-файл, чтобы изменить базовый класс объекта формы. Если вас заинтересует такая возможность, прочитайте книгу Рея Лишнера (Ray Lischner) «Secrets of Delphi 2» (Waite Group Press, 1996) — в ней приведен специальный компонент для работы с IsControl, а также содержатся подробные инструкции. Впрочем, хотя этот раздел книги произвел на меня огромное впечатление, я никогда не пользовался такой методикой, да и вам не рекомендую. Почему? Потому что вам придется повторять одни и те же действия при каждом создании нового вида или изменении существующего. Возможно, подобное превращение формы в компонент имеет смысл для создания истинно новых компонентов — например, объединения TMemo или TRichEdit с панелью инструментов — но не для видов.
SHOPPER32 за работой
SHOPPER32— базовое FTP-приложение, созданное с помощью компонента CsShopper, оно изображено на рис. 6.3. Создайте новый проект с именем SHOPPER32, вызовите главную форму frmMain и сохраните в модуле MAIN.PAS содержимое листинга 6.1.
Листинг 6.1. Модуль MAIN.PAS (* Модуль Main Написан для книги High Performance Delphi Programming - Джон К.Пенман 1997 За дополнительной информацией и помощью обращайтесь по адресу info@craiglockhart.com *)
unit main; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Buttons, FileCtrl, ComCtrls, CsSocket, CsShopper, MkDirFrm, CsFtpMsg, ToolWin, Registry, ExtCtrls;
Рис. 6.3. Приложение SHOPPER32
type TfrmMain = class(TForm) CsShopper1: TCsShopper; pcShopper: TPageControl; tsConnect: TTabSheet; tsOptions: TTabSheet; tsAbout: TTabSheet; gbLocal: TGroupBox; gbRemote: TGroupBox; gbActions: TGroupBox; dcbLocal: TDriveComboBox; dlbLocal: TDirectoryListBox; flbLocal: TFileListBox; sbStatus: TStatusBar; pbDataTransfer: TProgressBar; lbRemoteFiles: TListBox; bbtnExit: TBitBtn; bbtnConnect: TBitBtn; bbtnAbort: TBitBtn; gbUserName: TGroupBox; gbPassword: TGroupBox; gbDefLocalDir: TGroupBox; gbDefTextEditor: TGroupBox; edDefUserName: TEdit; edDefPassword: TEdit; edDefLocalDir: TEdit; edDefTextEditor: TEdit; bbtnFtpCmds: TBitBtn; bbtnLocateTxtEditor: TBitBtn; bbtnLocateDefLocalDir: TBitBtn; gbMoreActions: TGroupBox; bbtnRefresh: TBitBtn; bbtnFTPHelp: TBitBtn; bbtnSite: TBitBtn; bbtnNewDir: TBitBtn; bbtnDelDir: TBitBtn; bbtnViewFile: TBitBtn; memLog: TMemo; rgFileType: TRadioGroup; bbtnRestart: TBitBtn; bbtnQuit: TBitBtn; tsProfiles: TTabSheet; gbSetProfile: TGroupBox; gbPrName: TGroupBox; gbPrHostName: TGroupBox; gbPrUserName: TGroupBox; gbPrPassWord: TGroupBox; gbPrRemDir: TGroupBox; gbPrLocDir: TGroupBox; edPrName: TEdit; edPrHostName: TEdit; edPrUserName: TEdit; edPrPassword: TEdit; edPrRemDir: TEdit; edPrLocDir: TEdit; gbPrList: TGroupBox; lbPrList: TListBox; bbtnPrNew: TBitBtn; bbtnPrSave: TBitBtn; bbtnPrDelete: TBitBtn; rgFTPMode: TRadioGroup; sbbtnRetr: TSpeedButton; sbbtnStor: TSpeedButton; Panel1: TPanel; Label1: TLabel; Label2: TLabel; Label3: TLabel; Label4: TLabel; Label5: TLabel; bbtnStat: TBitBtn; gbHints: TGroupBox; cbHints: TCheckBox; gbFTPOptions: TGroupBox; BitBtn2: TBitBtn; rgFileStructure: TRadioGroup; rgTransfer: TRadioGroup; bbtnAddNew: TBitBtn; procedure bbtnConnectClick(Sender: TObject); procedure FormCreate(Sender: TObject); procedure bbtnFtpCmdsClick(Sender: TObject); procedure CsShopper1Info(Sender: TObject; Msg: String); procedure CsShopper1UpDateList(Sender: TObject; List: TStringList); procedure lbRemoteFilesDblClick(Sender: TObject); procedure CsShopper1List(Sender: TObject; List: TStringList); procedure bbtnSiteClick(Sender: TObject); procedure bbtnFTPHelpClick(Sender: TObject); procedure CsShopper1Busy(Sender: TObject; BusyFlag: Boolean); procedure CsShopper1Progress(Sender: TObject; Position: Integer); procedure rgFileTypeClick(Sender: TObject); procedure CsShopper1FileType(Sender: TObject; FileType: TFileTypes); procedure CsShopper1Error(Sender: TObject; Status: TConditions; Msg: String); procedure bbtnNewDirClick(Sender: TObject); procedure bbtnDelDirClick(Sender: TObject); procedure CsShopper1Connect(Sender: TObject; sSocket: Integer); procedure bbtnQuitClick(Sender: TObject); procedure rgFTPModeClick(Sender: TObject); procedure bbtnRefreshClick(Sender: TObject); procedure sbbtnRetrClick(Sender: TObject); procedure sbbtnStorClick(Sender: TObject); procedure CsShopper1DataDone(Sender: TObject; Done: Boolean); procedure bbtnStatClick(Sender: TObject); procedure bbtnRestartClick(Sender: TObject); procedure flbLocalDblClick(Sender: TObject); procedure lbRemoteFilesClick(Sender: TObject); procedure flbLocalClick(Sender: TObject); procedure lbPrListDblClick(Sender: TObject); procedure bbtnConnectMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); procedure bbtnViewFileClick(Sender: TObject); procedure bbtnAbortClick(Sender: TObject); procedure bbtnPrSaveClick(Sender: TObject); procedure bbtnExitClick(Sender: TObject); procedure lbPrListClick(Sender: TObject); procedure bbtnPrNewClick(Sender: TObject); procedure bbtnAddNewClick(Sender: TObject); procedure edPrNameExit(Sender: TObject); procedure edPrHostNameExit(Sender: TObject); procedure edPrUserNameExit(Sender: TObject); procedure edPrPasswordExit(Sender: TObject); procedure edPrRemDirExit(Sender: TObject); procedure edPrLocDirExit(Sender: TObject); procedure bbtnPrDeleteClick(Sender: TObject); procedure bbtnLocateDefLocalDirClick(Sender : TObject); procedure bbtnLocateTxtEditorClick(Sender: TObject); procedure BitBtn2Click(Sender: TObject); private { Private declarations } public { Public declarations } HelpCmd : String; UsedProfile, UsedQFTP, NewProfile : Boolean; OldTransferMode, OldFileStruct : String; OldProfiles, HostNameList, UsernameList, PasswordList, RemoteDirList, LocalDirList, CurrentProfiles, ProfileNameList : TStringList; NoOfUsers, LastProfileUsed, NoProfiles : Integer; procedure LoadSettings; procedure SaveOptions; procedure SaveProfiles; end; var frmMain: TfrmMain; implementation uses RMDirFrm, HelpFrm, QuickFTPfrm, LocateDirFrm, LocateEdFrm; {$R *.DFM} const FtpClientKey = 'Software\High Performance Delphi\Shopper32'; procedure TfrmMain.LoadSettings; var Reg : TRegistry; Count : Integer; ProfileName : String; begin Reg := TRegistry.Create; // Считываем имя пользователя по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('UserName') then edDefUserName.Text := Reg.ReadString('UserName') else edDefUserName.Text := 'anonymous'; finally Reg.CloseKey; end; // Считываем пароль по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('Password') then edDefPassword.Text := Reg.ReadString('Password') else edDefPassword.Text := 'guest'; finally Reg.CloseKey; end; // Считываем локальный каталог по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('DefLocalDir') then edDefLocalDir.Text := Reg.ReadString('DefLocalDir') else edDefLocalDir.Text := 'C:\'; finally Reg.CloseKey; end; // Считываем редактор, используемый по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('Editor') then edDefTextEditor.Text := Reg.ReadString('Editor') else edDefTextEditor.Text := 'NOTEPAD '; finally Reg.CloseKey; end; // Задаем свойства try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('Asynchronous') then begin with CsShopper1 do begin Asynchronous := Reg.ReadBool('Asynchronous'); if Asynchronous then rgFTPMode.ItemIndex := 0 else rgFTPMode.ItemIndex := 1; end; end else begin CsShopper1.Asynchronous := FALSE; rgFTPMode.ItemIndex := 0; end; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('Hints') then cbHints.Checked := Reg.ReadBool('Hints') else cbHints.Checked := FALSE; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('DTransferMode') then begin OldTransferMode := Reg.ReadString('DTransferMode'); if UpperCase(OldTransferMode) = UpperCase(FtpTransferStr[STREAM]) then begin CsShopper1.Transfer := STREAM; rgTransfer.ItemIndex := 0; end; if UpperCase(OldTransferMode) = UpperCase(FtpTransferStr[BLOCK]) then begin CsShopper1.Transfer := BLOCK; rgTransfer.ItemIndex := 1; end; if UpperCase(OldTransferMode) = UpperCase(FtpTransferStr[COMPRESSED]) then begin CsShopper1.Transfer := COMPRESSED; rgTransfer.ItemIndex := 2; end; end else begin OldTransferMode := UpperCase(FtpTransferStr[STREAM]); CsShopper1.Transfer := STREAM; rgTransfer.ItemIndex := 0; end; finally Reg.CloseKey; end; // Свойство файловой структуры try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('DFileStructure') then begin OldFileStruct := Reg.ReadString('DFileStructure'); if UpperCase(OldFileStruct) = UpperCase(FtpFileStructStr[NOREC]) then begin CsShopper1.FileStruct := NOREC; rgFileStructure.ItemIndex := 0; end; if UpperCase(OldFileStruct) = UpperCase(FtpFileStructStr[REC]) then begin CsShopper1.FileStruct := REC; rgFileStructure.ItemIndex := 1; end; if UpperCase(OldFileStruct) = UpperCase(FtpFileStructStr[PAGE]) then begin CsShopper1.FileStruct := PAGE; rgFileStructure.ItemIndex := 2; end; end else begin OldFileStruct := UpperCase(FtpFileStructStr[NOREC]); CsShopper1.FileStruct := NOREC; rgFileStructure.ItemIndex := 0; end; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('LastProfileUsed') then LastProfileUsed := Reg.ReadInteger('LastProfileUsed') else LastProfileUsed := 0; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey, TRUE); if Reg.ValueExists('NoProfiles') then NoProfiles := Reg.ReadInteger('NoProfiles') else NoProfiles := 1; finally Reg.CloseKey; end; // Список профилей for Count := 0 to NoProfiles - 1 do begin ProfileName := Concat('ProfileName', IntToStr(Count)); try Reg.OpenKey(FtpClientKey + '\Profiles' + '\ ' + ProfileName, TRUE); if Reg.ValueExists('ProfileName') then ProfileNameList.Add(Reg.ReadString ('ProfileName')) else ProfileNameList.Add('PROFILE'); OldProfiles.Add(Reg.ReadString('ProfileName')); if Reg.ValueExists('Host') then HostNameList.Add(Reg.ReadString('Host')) else HostNameList.Add('HOST'); if Reg.ValueExists('User') then UserNameList.Add(Reg.ReadString('User')) else UserNameList.Add('ANONYMOUS'); if Reg.ValueExists('Password') then PasswordList.Add(Reg.ReadString('Password')) else PasswordList.Add('GUEST'); if Reg.ValueExists('RemoteDir') then RemoteDirList.Add(Reg.ReadString('RemoteDir')) else RemoteDirList.Add('\'); if Reg.ValueExists('LocalDir') then LocalDirList.Add('LocalDir') else LocalDirList.Add('\'); finally Reg.CloseKey; end; end; // цикл for Reg.Free; lbPrList.Items := ProfileNameList; lbPrList.ItemIndex := LastProfileUsed; edPrName.Text := ProfileNameList.Strings[lbPrList.ItemIndex]; edPrHostName.Text := HostNameList.Strings[lbPrList.ItemIndex]; edPrUserName.Text := UserNameList.Strings[lbPrList.ItemIndex]; edPrPassword.Text := PasswordList.Strings[lbPrList.ItemIndex]; edPrRemDir.Text := RemoteDirList.Strings[lbPrList.ItemIndex]; edPrLocDir.Text := LocalDirList.Strings[lbPrList.ItemIndex]; CsShopper1.UserName := edPrUserName.Text; CsShopper1.Password := edPrPassword.Text; lbPrList.Refresh; end; procedure TfrmMain.SaveProfiles; var Reg : TRegistry; Count : Integer; ProfileName : String; begin Reg := TRegistry.Create; try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteInteger('LastProfileUsed', LastProfileUsed); finally Reg.CloseKey; end; NoProfiles := lbPrList.Items.Count; try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteInteger('NoProfiles',NoProfiles); finally Reg.CloseKey; end; for Count := 0 to NoProfiles - 1 do begin ProfileName := Concat('ProfileName', IntToStr(Count)); try Reg.OpenKey(FtpClientKey + '\Profiles' + '\ ' + ProfileName, TRUE); Reg.WriteString('ProfileName', lbPrList.Items.Strings[Count]); Reg.WriteString('ProfileName', ProfileNameList.Strings[Count]); Reg.WriteString('Host', HostNameList.Strings[Count]); Reg.WriteString('User', UserNameList.Strings[Count]); Reg.WriteString('Password', PasswordList.Strings[Count]); Reg.WriteString('RemoteDir', RemoteDirList.Strings[Count]); Reg.WriteString('LocalDir', LocalDirList.Strings[Count]); finally Reg.CloseKey; end; end; Reg.Free; end; procedure TfrmMain.SaveOptions; var Reg : TRegistry; begin Reg := TRegistry.Create; // Сохраняем имя пользователя по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteString('UserName', edDefUserName.Text); finally Reg.CloseKey; end; // Сохраняем пароль по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteString('Password', edDefPassword.Text); finally Reg.CloseKey; end; // Сохраняем локальный каталог по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteString('DefLocalDir', edDefLocalDir.Text); finally Reg.CloseKey; end; // Сохраняем редактор, используемый по умолчанию try Reg.OpenKey(FtpClientKey, TRUE); Reg.WriteString('Editor', edDefTextEditor.Text); finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey,TRUE); case rgFTPMode.ItemIndex of 0 : Reg.WriteBool('Asynchronous',TRUE); 1 : Reg.WriteBool('Asynchronous',FALSE); end; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey, TRUE); if cbHints.Checked then Reg.WriteBool('Hints',TRUE) else Reg.WriteBool('Hints',FALSE); finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey,TRUE); case rgTransfer.ItemIndex of 0 :Reg.WriteString('DTransferMode', FtpTransferStr[STREAM]); 1 :Reg.WriteString('DTransferMode', FtpTransferStr[BLOCK]); 2 :Reg.WriteString('DTransferMode', FtpTransferStr[COMPRESSED]); end; finally Reg.CloseKey; end; try Reg.OpenKey(FtpClientKey,TRUE); case rgFileStructure.ItemIndex of 0 :Reg.WriteString('DFileStructure', FtpFileStructStr[NOREC]); 1 :Reg.WriteString('DFileStructure', FtpFileStructStr[REC]); 2 :Reg.WriteString('DFileStructure', FtpFileStructStr[PAGE]); end; finally Reg.CloseKey; end; Reg.Free; end; procedure TfrmMain.bbtnConnectClick(Sender: TObject); begin if (not UsedQFtp) and (not UsedProfile) then begin with CsShopper1 do begin HostName := HomeServer; if Status = Success then Start; end; end else if UsedQFtp then CsShopper1.Start else if UsedProfile then begin with CsShopper1 do begin UserName := edPrUserName.Text; Password := edPrPassword.Text; RemoteDir:= edPrRemDir.Text; LocalDir := edPrLocDir.Text; EditName := edDefTextEditor.Text; HostName := edPrHostName.Text; if Status = Success then Start; end; end; end; procedure TfrmMain.FormCreate(Sender: TObject); begin bbtnQuit.Enabled := FALSE; bbtnRefresh.Enabled := FALSE; bbtnViewFile.Enabled := FALSE; bbtnFtpCmds.Enabled := FALSE; bbtnAbort.Enabled := FALSE; rgFileType.Enabled := FALSE; gbMoreActions.Visible := FALSE; pbDataTransfer.Visible := FALSE; sbbtnRetr.Enabled := FALSE; sbbtnStor.Enabled := FALSE; OldProfiles := TStringList.Create; ProfileNameList := TStringList.Create; HostNameList := TStringList.Create; UserNameList := TStringList.Create; PasswordList := TStringList.Create; RemoteDirList := TStringList.Create; LocalDirList := TStringList.Create; LoadSettings; if CsShopper1.Asynchronous then begin sbStatus.Panels[2].Text := Concat('Mode : ', 'Asynchronous'); rgFTPMode.ItemIndex := 0; end else begin sbStatus.Panels[2].Text := Concat('Mode : ', 'Non-Asynchronous'); rgFTPMode.ItemIndex := 1; end; sbStatus.Panels[0].Text := Concat('Local Host : ', CsShopper1.LocalName); sbStatus.Panels[3].Text := Concat('Status : ', 'Idle'); pcShopper.ActivePage := tsProfiles; UpDate; end; procedure TfrmMain.bbtnFtpCmdsClick(Sender: TObject); begin gbMoreActions.Visible := not gbMoreActions.Visible; if gbMoreActions.Visible then begin bbtnFtpCmds.Hint := 'Click here to close the panel of FTP commands'; bbtnFtpCmds.Caption := 'Close'; end else begin bbtnFtpCmds.Hint := 'Click here to get more FTP commands'; bbtnFtpCmds.Caption := 'FTP Cmds'; end; end; procedure TfrmMain.CsShopper1Info(Sender: TObject; Msg: String); begin memLog.Lines.Add(Msg); end; procedure TfrmMain.CsShopper1UpDateList(Sender: TObject; List: TStringList); begin LbRemoteFiles.Items := List; lbRemoteFiles.UpDate; gbRemote.Caption := Concat('Files on ', CsShopper1.HostName); sbStatus.Panels[1].Text := Concat('Remote Host : ',CsShopper1.HostName); end; procedure TfrmMain.lbRemoteFilesDblClick (Sender: TObject); begin pbDataTransfer.Visible := TRUE; if lbRemoteFiles.ItemIndex <> -1 then CsShopper1.Get := lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex] else pbDataTransfer.Visible := FALSE; end; procedure TfrmMain.CsShopper1List (Sender: TObject; List: TStringList); begin lbRemoteFiles.Clear; lbRemoteFiles.Items := List; lbRemoteFiles.UpDate; gbRemote.Caption := CsShopper1.RemoteDir; end; procedure TfrmMain.bbtnSiteClick(Sender: TObject); begin CsShopper1.SiteFtp; end; procedure TfrmMain.bbtnFTPHelpClick(Sender: TObject); var Counter : Integer; begin frmHelp := TfrmHelp.Create(Application); for Counter := SFtpUser to SFtpNoop do frmHelp.lbHelpFtpCmds.Items.Add (LoadStr(Counter)); frmHelp.ShowModal; CsShopper1.FtpHelp := HelpCmd; HelpFtpCmdList.Free; frmHelp.Free; end; procedure TfrmMain.CsShopper1Busy (Sender: TObject; BusyFlag: Boolean); begin if BusyFlag then begin lbRemoteFiles.Enabled := FALSE; sbStatus.Panels[3].Text := Concat('Status : ','Busy'); end else begin lbRemoteFiles.Enabled := TRUE; sbStatus.Panels[3].Text := Concat('Status : ','Idle'); end; Update; end; procedure TfrmMain.CsShopper1Progress (Sender: TObject; Position: Integer); begin pbDataTransfer.Position := Position; pbDataTransfer.UpDate; end; procedure TfrmMain.rgFileTypeClick (Sender: TObject); begin with CsShopper1 do case rgFileType.ItemIndex of 0 : FileType := ASCII; 1 : FileType := IMAGE; 2 : FileType := AUTO; end; end; procedure TfrmMain.CsShopper1FileType (Sender: TObject; FileType: TFileTypes); begin case FileType of ASCII : rgFileType.ItemIndex := 0; IMAGE : rgFileType.ItemIndex := 1; AUTO : rgFileType.ItemIndex := 2; end; end; procedure TfrmMain.CsShopper1Error (Sender: TObject; Status: TConditions; Msg: String); begin memLog.Lines.Add(Msg); end; procedure TfrmMain.bbtnNewDirClick (Sender: TObject); begin frmMkNewDir := TfrmMkNewDir.Create(Application); frmMkNewDir.ShowModal; if Length(NewDirName) > 0 then CsShopper1.MkDirName := NewDirName; frmMkNewDir.Free; end; procedure TfrmMain.bbtnDelDirClick(Sender: TObject); begin if lbRemoteFiles.ItemIndex <> -1 then CsShopper1.RmDirName := emoteFiles.Items.Strings[lbRemoteFiles.ItemIndex]; CsShopper1.FilesList; end; procedure TfrmMain.CsShopper1Connect(Sender: TObject; sSocket: Integer); begin bbtnQuit.Enabled := TRUE; bbtnRefresh.Enabled := TRUE; bbtnViewFile.Enabled := TRUE; bbtnFtpCmds.Enabled := TRUE; rgFileType.Enabled := TRUE; if rgFTPMode.ItemIndex = 1 then begin sbbtnRetr.Enabled := TRUE; sbbtnStor.Enabled := TRUE; end else begin sbbtnRetr.Enabled := FALSE; sbbtnStor.Enabled := FALSE; end; bbtnConnect.Enabled := FALSE; bbtnExit.Enabled := FALSE; rgFTPMode.Enabled := FALSE; gbRemote.Caption := 'Remote : ' + CsShopper1.RemoteDir; sbStatus.Panels[1].Text := 'Remote Host : ' + CsShopper1.HostName; sbStatus.Panels[3].Text := 'Status : Connected'; Update; end; procedure TfrmMain.bbtnQuitClick(Sender: TObject); begin bbtnQuit.Enabled := FALSE; bbtnRefresh.Enabled := FALSE; bbtnViewFile.Enabled := FALSE; bbtnFtpCmds.Enabled := FALSE; bbtnAbort.Enabled := FALSE; rgFileType.Enabled := FALSE; sbbtnRetr.Enabled := FALSE; sbbtnStor.Enabled := FALSE; gbMoreActions.Visible := FALSE; pbDataTransfer.Visible := FALSE; bbtnConnect.Enabled := TRUE; bbtnExit.Enabled := TRUE; rgFTPMode.Enabled := TRUE; with sbStatus do begin Panels[1].Text := 'Remote Host : '; Panels[3].Text := 'Status : Idle'; end; lbRemoteFiles.Clear; Update; CsShopper1.Finish; end; (* procedure TfrmMain.Exit1Click(Sender: TObject); begin Close; end; *) procedure TfrmMain.rgFTPModeClick(Sender: TObject); begin if rgFTPMode.ItemIndex = 0 then begin CsShopper1.Asynchronous := TRUE; sbStatus.Panels[2].Text := 'Mode : ' + 'Asynchronous'; sbbtnRetr.Enabled := FALSE; sbbtnStor.Enabled := FALSE; end else begin CsShopper1.Asynchronous := FALSE; sbStatus.Panels[2].Text := 'Mode : ' + 'Non-Asynchronous'; sbbtnRetr.Enabled := TRUE; sbbtnStor.Enabled := TRUE; end; sbStatus.Update; end; procedure TfrmMain.bbtnRefreshClick(Sender: TObject); begin CsShopper1.FilesList end; procedure TfrmMain.sbbtnRetrClick(Sender: TObject); begin pbDataTransfer.Visible := TRUE; bbtnAbort.Enabled := TRUE; CsShopper1.MGet; end; procedure TfrmMain.sbbtnStorClick(Sender: TObject); begin pbDataTransfer.Visible := TRUE; bbtnAbort.Enabled := TRUE; CsShopper1.MPut; end; procedure TfrmMain.CsShopper1DataDone(Sender: TObject; Done: Boolean); begin if Done then begin pbDataTransfer.Visible := FALSE; bbtnAbort.Enabled := FALSE end else begin pbDataTransfer.Visible := TRUE; bbtnAbort.Enabled := TRUE end; pbDataTransfer.Update; end; procedure TfrmMain.bbtnStatClick(Sender: TObject); begin CsShopper1.Stat; end; procedure TfrmMain.bbtnRestartClick(Sender: TObject); begin ShowMessage('Not implemented in this version'); end; procedure TfrmMain.flbLocalDblClick(Sender: TObject); begin pbDataTransfer.Visible := TRUE; if flbLocal.ItemIndex <> -1 then CsShopper1.Put := flbLocal.Items.Strings[flbLocal.ItemIndex] else pbDataTransfer.Visible := FALSE; end; procedure TfrmMain.lbRemoteFilesClick(Sender: TObject); begin CsShopper1.RemoteFiles.Add (lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex]); end; procedure TfrmMain.flbLocalClick(Sender: TObject); begin CsShopper1.LocalFiles.Add (flbLocal.Items.Strings[flbLocal.ItemIndex]); end; procedure TfrmMain.lbPrListDblClick(Sender: TObject); begin UsedProfile := TRUE; pcShopper.ActivePage := tsConnect; ActiveControl := bbtnConnect; bbtnConnect.Click; end; procedure TfrmMain.bbtnConnectMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer); begin if Button = mbRight then // Выполняем упрощенный ftp begin UsedQFtp := TRUE; UsedProfile := FALSE; frmQuickFtp := TfrmQuickFTP.Create(Application); frmQuickFtp.ShowModal; with CsShopper1 do begin UserName := frmQuickFtp.edUserName.Text; Password := frmQuickFtp.edPassword.Text; HostName := frmQuickFtp.edHostName.Text; end; frmQuickFtp.Free; ActiveControl := bbtnConnect; bbtnConnect.Click; end else UsedQFtp := FALSE; end; procedure TfrmMain.bbtnViewFileClick(Sender: TObject); begin if lbRemoteFiles.ItemIndex <> -1 then CsShopper1.View := lbRemoteFiles.Items.Strings [lbRemoteFiles.ItemIndex]; end; procedure TfrmMain.bbtnAbortClick(Sender: TObject); begin CsShopper1.Abort; bbtnAbort.Enabled := FALSE; end; procedure TfrmMain.bbtnPrSaveClick(Sender: TObject); begin SaveProfiles; end; procedure TfrmMain.bbtnExitClick(Sender: TObject); begin OldProfiles.Free; ProfileNameList.Free; HostNameList.Free; UserNameList.Free; PasswordList.Free; RemoteDirList.Free; LocalDirList.Free; end; procedure TfrmMain.lbPrListClick(Sender: TObject); begin if lbPrList.ItemIndex <> -1 then begin LastProfileUsed := lbPrList.ItemIndex; edPrName.Text := ProfileNameList.Strings[LastProfileUsed]; edPrHostName.Text := HostNameList.Strings[LastProfileUsed]; edPrUserName.Text := UserNameList.Strings[LastProfileUsed]; edPrPassword.Text := PasswordList.Strings[LastProfileUsed]; edPrRemDir.Text := RemoteDirList.Strings[LastProfileUsed]; edPrLocDir.Text := LocalDirList.Strings[LastProfileUsed]; Update; end; end; procedure TfrmMain.bbtnPrNewClick(Sender: TObject); begin NewProfile := TRUE; edPrName.Text := ''; edPrHostName.Text := ''; edPrUserName.Text := edDefUserName.Text; edPrPassword.Text := edDefPassword.Text; edPrLocDir.Text := edDefLocalDir.Text; edPrRemDir.Text := '\'; lbPrList.Visible := FALSE; end; procedure TfrmMain.bbtnAddNewClick(Sender: TObject); begin ProfileNameList.Add(edPrName.Text); HostNameList.Add(edPrHostName.Text); UserNameList.Add(edPrUserName.Text); PasswordList.Add(edPrPassword.Text); RemoteDirList.Add(edPrRemDir.Text); LocalDirList.Add(edPrLocDir.Text); lbPrList.Items.Add(edPrName.Text); lbPrList.Visible := TRUE; lbPrList.refresh; NewProfile := FALSE; end; procedure TfrmMain.edPrNameExit(Sender: TObject); begin if (edPrName.Modified) and (not NewProfile) then begin lbPrList.Items.Strings[lbPrList.ItemIndex] := edPrName.Text; lbPrList.Refresh; ProfileNameList.Strings[lbPrList.ItemIndex] := edPrName.Text; end; end; procedure TfrmMain.edPrHostNameExit(Sender: TObject); begin if (edPrHostName.Modified) and (not NewProfile) then HostNameList.Strings[lbPrList.ItemIndex] := edPrHostName.Text; end; procedure TfrmMain.edPrUserNameExit(Sender: TObject); begin if (edPrUserName.Modified) and (not NewProfile) then UserNameList.Strings[lbPrList.ItemIndex] := edPrUserName.Text; end; procedure TfrmMain.edPrPasswordExit(Sender: TObject); begin if (edPrPassword.Modified) and (not NewProfile) then PasswordList.Strings[lbPrList.ItemIndex] := edPrPassword.Text; end; procedure TfrmMain.edPrRemDirExit(Sender: TObject); begin if (edPrRemDir.Modified) and (not NewProfile) then RemoteDirList.Strings[lbPrList.ItemIndex] := edPrRemDir.Text; end; procedure TfrmMain.edPrLocDirExit(Sender: TObject); begin if (edPrLocDir.Modified) and (not NewProfile) then LocalDirList.Strings[lbPrList.ItemIndex] := edPrLocDir.Text; end; procedure TfrmMain.bbtnPrDeleteClick(Sender: TObject); var Reg : TRegistry; Profile : String; begin Reg := TRegistry.Create; Profile := Concat('ProfileName',IntToStr (lbPrList.ItemIndex)); if Reg.DeleteKey(FtpClientKey + '\Profiles\' + Profile) then begin ProfileNameList.Delete(lbPrList.ItemIndex); HostNameList.Delete(lbPrList.ItemIndex); UserNameList.Delete(lbPrList.ItemIndex); PasswordList.Delete(lbPrList.ItemIndex); RemoteDirList.Delete(lbPrList.ItemIndex); LocalDirList.Delete(lbPrList.ItemIndex); lbPrList.Items.Delete(lbPrList.ItemIndex); edPrName.Clear; edPrHostName.Clear; edPrUserName.Clear; edPrRemDir.Clear; edPrLocDir.Clear; NoProfiles := lbPrList.Items.Count; lbPrList.Refresh; end; Reg.Free; end; procedure TfrmMain.bbtnLocateDefLocalDirClick (Sender: TObject); begin frmLocateDir := TfrmLocateDir.Create(Application); frmLocateDir.ShowModal; edDefLocalDir.Text := frmLocateDir.LocateDir; frmLocateDir.Free; end; procedure TfrmMain.bbtnLocateTxtEditorClick(Sender: TObject); begin frmLocateEditor := TfrmLocateEditor.Create (Application); frmLocateEditor.ShowModal; edDefTextEditor.Text := frmLocateEditor.EditorPath; frmLocateEditor.Free; end; procedure TfrmMain.BitBtn2Click(Sender: TObject); begin SaveOptions; end; end.Не забудьте предварительно включить CsSocket и CsShopper в палитру компонентов. Поместите компонент CsShopper на главную форму. Создайте на форме кнопку для каждой команды FTP. Например, кнопка Connect вызывает процедуру
CsShopper1.Start:procedure TfrmMain.bbtnConnectClick(Sender: TObject); begin
if (not UsedQFtp) and (not UsedProfile) then begin
with CsShopper1 do
begin
HostName := HomeServer;
if Status = Success then
Start;
end;
end else
if UsedQFtp then
CsShopper1.Start
else
if UsedProfile then
begin
with CsShopper1 do
begin
UserName := edPrUserName.Text;
Password := edPrPassword.Text;
RemoteDir:= edPrRemDir.Text;
LocalDir := edPrLocDir.Text;
EditName := edDefTextEditor.Text;
HostName := edPrHostName.Text;
if Status = Success then
Start;
end;
end;
end;
Профили SHOPPER32
Перед тем как подключаться к FTP-серверу с помощью программы SHOPPER32, вы должны создать на вкладке Profiles некий «профиль», включающий имя FTP-сервера, а также пользовательское имя и пароль для регистрации (см. рис. 6.4).
Профили сохраняются в системном реестре Windows и извлекаются из него перед регистрацией, чтобы вам не пришлось всякий раз вводить информацию для доступа к FTP-серверу.
Чтобы добавить новый профиль, нажмите кнопку New; при этом стирается содержимое всех текстовых полей на вкладке Profiles. Затем введите имя профиля, имя FTP-сервера, имя пользователя и пароль в текстовых полях edPrName, edPrHostName, edPrUserName и edPrPassword соответственно. Для анонимной регистрации следует ввести в поле edPrUserName строку anonymous, а в поле edPrPassword — ваш адрес электронной почты.
Рис. 6.4. Типичный вид профиля на вкладке Profiles
Нажмите кнопку Add, чтобы внести профиль в список, и затем сохраните новые данные в реестре кнопкой Save. Если потребуется удалить профиль из реестра, выделите его имя в списке Profiles и нажмите кнопку Delete. Чтобы подключиться к FTP-серверу, щелкните на имени профиля в списке Profiles, перейдите на вкладку Connect и нажмите кнопку Connect. Существует и другой, более удобный способ — дважды щелкнуть на имени профиля в списке. При этом автоматически активизируется вкладка Connect, и на ней нажимается кнопка Connect, как показано в следующем фрагменте обработчика события OnDblClick для списка
lbPrList:procedure TfrmMain.lbPrListDblClick(Sender: TObject);
begin
UsedProfile := TRUE;
pcShopper.ActivePage := tsConnect; ActiveControl := bbtnConnect; bbtnConnect.Click;
end;
Чтобы процесс регистрации стал еще проще, мы сохраняем информацию о локальном и удаленном каталогах в текстовых полях edPrLocDir и edPrRemDir соответственно. CsShopper пользуется этой информацией для автоматиче ского, не требующего вмешательства пользователя, перехода к нужному каталогу.
Чтобы обратиться к редко используемому FTP-серверу, для которого нет смысла заводить специальный профиль, активизируйте кнопку Connect (на вкладке Connect) и щелкните на ней правой кнопкой мыши — на экране появится диалоговое окно Quick FTP. В нем следует ввести имя пользователя и пароль. Значения по умолчанию берутся с вкладки Options. Если они окажутся подходящими, вы сразу же начинаете сеанс работы кнопкой OK.
Замечание
Для получения доступа к некоторым FTP-серверам и выполнения некоторых FTP-команд (например, удаления каталога командой RMD) необходимо ввести информацию об используемом ресурсе (она посылается серверу командой ACCT). Если вы хотите работать с таким сервером, придется добавить на вкладку Profiles дополнительное текстовое поле и изменить компонент CsShopper для посылки команды ACCT с соответствующей информацией.
Slice спешит на помощь
Похоже, объявление «с запасом» нас не спасет. Так как же передать динамические данные этим, во всех остальных отношениях замечательным функциям? Ответ кроется в малоизвестной функции Slice, спрятанной в модуле System:
function Slice(var A: array; Count: Integer): array;
Slice получает массив любого размера и тип и возвращает Count элементов так, словно они являются отдельным и независимым массивом. С помощью Slice можно объявить очень большой массив и использовать в нем лишь
нужное количество элементов.
Функция Slice возрождает идею объявления «с запасом», но на этот раз нам уже не придется заботиться о неправильном знаменателе. А это в свою очередь позволит передавать функциям динамические данные.
Вооружившись новыми знаниями, мы переходим к созданию быстрого и удобного компонента для статистической обработки данных.
Смысловые оттенки
А где-то на другом конце города в разбитое окно убогой комнаты занесло выхлопные газы последнего автобуса, отъезжающего в Бэйпорт. Не обращая внимания на уличный шум, загадочная фигура потянулась к уголку Дневника и перевернула очередную страницу.
Дневник №16, 21 марта. Сегодня ко мне обратился новый клиент — человек по имени Барри Маунтбенк. Он занимается «раскруткой» перспектив ного политика и хочет, чтобы я написал специальный текстовый редактор, который мог бы создавать различные описания для одних и тех же событий в зависимости от того, откуда подует ветер.
Я решил, что было бы полезно написать демонстрационную программу, которая покажет, как в Delphi-приложении организовать фильтрацию и преобразование нажатых клавиш, чтобы преобразовать их к требуемому виду. Когда я предложил это клиенту, он загорелся энтузиазмом.
Методика чрезвычайно проста. Объект Application умеет обрабатывать событие OnMessage, с помощью которого можно подключиться непосредственно к цепочке сообщений для всех компонентов приложения.
Я решил создать несложную программу, которая бы демонстрировала три основных положения:
Подменить одну нажатую клавишу другой несложно. Замены клавиш, выполняемые таким образом, автоматически передаются всем компонентам приложения, даже другим формам. Замену клавиш можно включать и выключать «на ходу».На рис. 14.3 изображен созданный мной пример с двумя формами. При установке соответствующего переключателя режим фильтрации включается или выключается. При включенной фильтрации прописная буква «a» меняется на строчную, и наоборот, клавиша Backspace работает как Delete, а клавиши Delete и Shift+F5 выполняют прежнюю функцию клавиши Backspace. Исходный текст программы содержится в файлах KSMAIN.PAS и KSFORM2.PAS (см. листинги 14.7 и 14.8).
Рис. 14.3. Фильтрация нажатых клавиш
Листинг 14.7. Главная форма демонстрационной программы для замены символов
{——————————} {Замена символов (демонстрационная программа)} {KSMAIN.PAS : Главная форма } {Автор: Эйс Брейкпойнт, N.T.P. } {При содействии Дона Тейлора } { } { Приложение, демонстрирующее возможности } {избирательной фильтрации и замены символов, } { вводимых с клавиатуры. } { } { Написано для *High Performance Delphi 3 } Programming* } { Copyright (c) 1997 The Coriolis } Group, Inc. } { Дата последней редакции 22/4/97 } {————————} unit KsMain; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, KSForm2, ExtCtrls; type TForm1 = class(TForm) ExitBtn: TButton; ShowBtn: TButton; Form1Memo: TMemo; Bevel1: TBevel; KeyHandlerRBGroup: TRadioGroup; procedure FormCreate(Sender: TObject); procedure ExitBtnClick(Sender: TObject); procedure ShowBtnClick(Sender: TObject); private procedure OnAppMessage(var Msg : TMsg; var Handled : Boolean); public { Public declarations } end; const Shifted : Boolean = False; var Form1: TForm1; implementation {$R *.DFM} procedure TForm1.OnAppMessage(var Msg : TMsg; var Handled : Boolean); begin if KeyHandlerRBGroup.ItemIndex = 1 then with Msg do begin case Message of WM_KEYDOWN : begin case WParam of VK_SHIFT : Shifted := True; VK_F5 : if Shifted then WParam := VK_BACK; VK_DELETE : WParam := VK_BACK; VK_BACK : WParam := VK_DELETE; end; { case } end; WM_CHAR : begin case chr(WParam) of "a" : WParam := ord("A"); "A" : WParam := ord("a"); end; { case } end; WM_KEYUP : begin case WParam of VK_SHIFT : Shifted := False; end; { case } end; end; { case } end; { with } end; procedure TForm1.FormCreate(Sender: TObject); begin Application.OnMessage := OnAppMessage; KeyHandlerRBGroup.ItemIndex := 0; end; procedure TForm1.ExitBtnClick(Sender: TObject); begin Close; end; procedure TForm1.ShowBtnClick(Sender: TObject); begin Form2.Show; end; end.Листинг 14.8. Вспомогательная форма демонстрационной программы
для замены символов
{—————————} {Замена символов (демонстрационная программа) } {KSFORM2.PAS : Вспомогательная форма } {Автор: Эйс Брейкпойнт, N.T.P. } {При содействии Дона Тейлора } { } {Приложение, демонстрирующее возможности } {избирательной фильтрации и замены символов, } {вводимых с клавиатуры. } { } {Написано для *High Performance Delphi 3 } {Programming* } {Copyright (c) 1997 The Coriolis Group, Inc. } { Дата последней редакции 22/4/97 } {————————} unit KsForm2; interface uses Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, ExtCtrls; type TForm2 = class(TForm) CloseBtn: TButton; Bevel1: TBevel; Form2Memo: TMemo; procedure CloseBtnClick(Sender: TObject); private { Private declarations } public { Public declarations } end; var Form2: TForm2; implementation {$R *.DFM} procedure TForm2.CloseBtnClick(Sender: TObject); begin Close; end; end.Кроме того, я заглянул в исходный текст объекта TApplication и посмотрел, как в нем организована обработка сообщений по умолчанию и как написан ный мной обработчик события OnMessage участвует в этом процессе. Точнее, меня интересовало, что я должен делать с переменной Handled, передаваемой обработчику событий? В листинге 14.9 приведен исходный текст метода ProcessMessage класса TApplication, вызываемого в бесконечном цикле обработ ки сообщений приложения.
Листинг 14.9. Исходный текст метода ProcessMessage класса TApplication
function TApplication.ProcessMessage: Boolean; var Handled: Boolean; Msg: TMsg; begin Result := False; if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then begin Result := True; if Msg.Message <>WM_QUIT then begin Handled := False; if Assigned(FOnMessage) then FOnMessage (Msg, Handled); if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then begin TranslateMessage(Msg); DispatchMessage(Msg); end; end else FTerminate := True; end; end;Из листинга 14.9 становится ясно, откуда взялась переменная Handled. Как нетрудно убедиться, метод ProcessMessage вызывается для обнаружения и обработки сообщений, находящихся в очереди. Обнаруженное сообщение удаляется из очереди. Если это сообщение WM_QUIT, переменной FTerminate присваивается значение True; в противном случае Handled присваивается False и вызывается обработчик OnMessage (если он был определен). Если при возвращении из него переменная Handled остается равной False и сообщение не относится к некоторым категориям (сообщения подсказок, сообщения MDI, уведомляющее сообщение от элемента или диалоговое сообщение), для обработки вызываются стандартные процедуры TranslateMessage и DispatchMessage. Очевидно, если переменной Handled в обработчике события OnMessage присвоить значение True, дальнейшая обработка сообщения прекращается. Я хочу заменить одну нажатую клавишу другой и продолжить обработку. Следовательно, значение переменной Handled не должно изменяться.
Мой обработчик OnMessage устроен достаточно просто. Если установлен переключатель Filtered, оператор case отбирает нужные сообщения и заменяет клавиши, при этом для управляющих символов используются константы виртуальных клавиш, определенные в Windows. Следует обратить внимание на один момент: клавиши, нажимаемые в сочетании с Alt, Ctrl и Shift, опознаются в два этапа. Поскольку процедура получает всего одну клавишу, она не знает, какие из управляющих клавиш были при этом нажаты. Мне пришлось отдельно обрабатывать нажатия и отпускания управляющих клавиш. Для этого я ищу константу VK_SHIFT в параметре wParam, передаваемом с сообщениями WM_KEYDOWN и WM_KEYUP, и в случае ее обнаружения — сохраняю информацию о регистре в логической переменной.
Обработчик OnMessage принадлежит приложению, а не главной форме, так что он не задается в виде свойства в режиме конструирования. Вместо этого он подключается во время выполнения в обработчике OnCreate главной формы.
Конец записи (21 марта).
Сначала построить, потом выводить
В первом воплощении этой программы за отображение ландшафта отвечала та же рекурсивная функция, в которой он рассчитывался. Если аргумент Plys (число итераций) превышал 1, функция разбивала полученный в качестве параметра треугольник на четыре новых, затем уменьшала Plys и вызывала себя для каждого из полученных треугольников. Когда аргумент Plys достигал 1, вызывалась функция, которая рисовала треугольник на экране.
Такой алгоритм выглядит достаточно просто, но при переходе от «каркасного» отображения к заполненным треугольникам приходилось заново генерировать весь ландшафт. Кроме того, применение этого алгоритма в Windows-программе означает, что ландшафт будет заново генерироваться при каждом изменении размеров окна. Очевидно, более разумный подход — сначала рассчитать ландшафт, а затем вывести его на экран. Это потребует проведения двух независимых рекурсий от внешнего треугольника до самых внутренних (которые, собственно, и отображаются на экране), но вторая рекурсия обходится достаточно дешево по сравнению с процессом отображения, так что цена подобной гибкости оказывается вполне приемлемой.
Снова о субклассировании
Чтобы субклассировать окно, необходимо получить и сохранить указатель на существующую оконную процедуру, а затем занести в структуру данных окна указатель на новую оконную процедуру. Для этого использу ются функции 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.
|
Снова в конторе Эйса
Эйс был настолько поглощен пропажей Дневника, что даже не заметил, как сквозь жалюзи начал пробиваться утренний свет. Расхаживая по маленькой комнате, Эйс едва не протер в ковре дыру, но так и не приблизился к разгадке ни на шаг.
В полном отчаянии он рухнул в кресло. «Если я действительно хороший сыщик, то почему не могу решить такую простую загадку?»— подумал он. За последние девять часов он тысячу раз вспоминал, как все произошло, но ответы упорно не появлялись. Сплошные вопросы. Он даже обшарил комнату в поисках отпечатков пальцев, но не нашел ничьих следов, кроме собственных. Ни единой зацепки.
Эйс больше часа просидел в кресле, погруженный в уныние. Пропал его Дневник, хранилище всех технических знаний, накопленных за время работы с Delphi. Кто-то неизвестный читает сейчас плоды его тайного вдохнове ния, его самые сокровенные мысли. Эйс почувствовал себя абсолютно беспомощным. По всей вероятности, ему уже никогда не суждено увидеть свой дневник. «Хоть бы какой-нибудь проблеск надежды…» — подумал он.
И вдруг его глаза широко раскрылись. Проблеск действительно был. Он видел его прошлой ночью, когда фары скользнули по кустам во время поспешного отъезда из офиса. Эйс вспомнил два крошечных отражения, которые могли означать лишь одно — человеческие глаза!
Бывший сыщик вскочил на ноги. Если там действительно кто-то стоял, на мягкой, влажной земле могли остаться следы! Он помчался наружу, однако во время тщательного осмотра земли вокруг кустов его отвлек знакомый голос.
— Привет, сосед.
Эйс повернулся.
— Ммм… привет, Мардж, — ответил он. — Я не слышал, как ты подошла.
Мардж Рейнольдс — сварливая вдова средних лет, активный сторонник движения «Сохраним искусство вязания!» Она уже два года жила по соседству с Эйсом, а ее кошка Чармин была одной из самых страстных поклонниц Мьюникса. Мардж была в курсе всех местных сплетен, а ее взгляд был постоянно прикован к щелке между занавесками, которые она никогда не задергивала полностью. От ее внимания не ускользало ничего.
— Ищешь что-нибудь конкретное? — спросила она, стрельнув глазами из-под накидки болотного цвета.
Эйс решил довериться ей и поведал свою печальную историю. Мардж особенно заинтересовалась тем человеком, которого вроде бы видел Эйс.
— Знаешь, — сказала она задумчиво, — когда прошлым вечером я открыла дверь и выпустила Чармин на улицу, в кустах рядом с дверью стоял какой-то человек. Когда я спросила его, что он здесь делает в такое время, он тут же сбежал. Наверняка это был тот, которого ты заметил.
— Во сколько это было? — поинтересовался Эйс.
— Думаю, часов в десять или полодиннадцатого, — ответила она.
— Ты можешь описать его?
— Довольно высокий и худой. Носит длинный плащ и шляпу, полностью закрывающую лицо. Он что-то держал в руке — то ли инструмент, то ли оружие. Знаешь, его мог видеть кто-нибудь еще. Думаю, стоит спросить управляющего.
— Превосходная мысль!
Они пересекли стоянку и подошли к конторе управляющего. Однако дверь была широко распахнута, а внутри никого не было! После обмена вопросительными взглядами Мардж выразила вслух мысль, тревожившую их обоих.
— Я бы хотела, чтобы здесь сейчас оказались Фрэнк и Джо Харди, — сказала она озабоченно.
