1.3. Обобщающие примеры

Книга: О чём не пишут в книгах по Delphi

Назад: 1.2. Примеры использования Windows API

Дальше: Глава 2 Использование сокетов Delphi

Рассмотрев основы работы с функциями API. мы переходим к обобщающим примерам — программам, использующим разные средства API для создания простого законченного примера.

1.3.1. Обобщающий пример 1 — Информация о процессах

Первым обобщающим примером станет программа для получения информации о процессах системы и об окнах, которые они открывают. На компакт-диске, прилагаемом к книге, эта программа называется ProcInfo. Окно программы ProcInfo показано на рис 1.13.

Рис. 1.13. Окно программы ProcInfo

1.3.1.1. Получение списка процессов

Исторически сложилось так, что существует два способа получить список процессов: с помощью функций Tool Help и посредством функций PSAPI. Эти две группы функций использовались в разных линиях Windows: функции Tool Help появились в Windows 95, функции PSAPI — в Windows NT 4. Windows 2000 XP также поддерживают функции Tool Help, в то время как Windows 98/ME не поддерживают PSAPI. Поэтому мы выберем функции Tool Help, что даст нашему примеру возможность работать во всех версиях Windows, кроме NT 4 (впрочем, в Windows 95 пример тоже не будет работать, но по другой причине: из-за функций GetWindowInfo и RealGetWindowClass, отсутствующих в этой версии). Функции Tool Help объявлены в модуле TlHelp32.

Для получения списка процессов необходимо сделать "снимок" состояния системы с помощью функции CreateToolhelp32Snapshot. Эта функция создает специальный объект, который может хранить информацию о процессах, модулях, нитях и кучах, созданных в системе. Этот объект называется снимком потому, что информация, хранящаяся в нем, актуальна на момент вызова функции CreateToolhelp32Snapshot; дальнейшие изменения списка процессов, модулей и т.п. не приводят к изменению снимка. Доступ к снимку, как и к большинству объектов системы, осуществляется через его дескриптор. В данном случае функция CreateToolhelp32Snapshot вызывается с параметром TH32CS_SNAPPROCESS для получения списка процессов.

Навигация по списку процессов, сохраненных в снимке, осуществляется с помощью функций Process32First и Process32Next. Они позволяют получить ряд параметров процесса, главный среди которых — идентификатор процесса (Process Identifier, PID). Это уникальный идентификатор процесса, с помощью которого можно отличать один процесс от другого.

Примечание

Не следует путать идентификатор процесса и дескриптор объекта процесса, который используется, например, в функции SetPriorityClass. Объект процесса — это специальный объект, связанный с процессом, но не тождественный ему. В частности, объект процесса может продолжать существовать уже после того, как сам процесс завершит работу (это позволяет, например, корректно синхронизироваться с уже завершенным процессом при помощи функции WaitForSingleObject). Через объект процесса можно управлять многими свойствами процесса. Поучить дескриптор объекта процесса по идентификатору процесса можно с помощью функции OpenProcess.

Код для получения списка процессов показан в листинге 1.42.

Листинг 1.42. Получение списка процессов с помощью Tool Help

procedure TProcessesInfoForm.FillProcessList;

var

SnapProc: THandle;

ProcEntry: TProcessEntry32;

Item: TListItem;

begin

ClearAll;

// Создаем снимок, в котором сохраняем все процессы, а

// затем в цикле получаем информацию о каждом из этих

// процессов, перенося ее в ListProcesses

SnapProc := CreateToolhelp32Snapshot(TH32CS_SNAPROCESSES, 0);

if SnapProc <> INVALID_HANDLE_VALUE then

try

ProcEntry.dwSize := SizeOf(TProcessEntry32);

if Process32First(SnapProc, ProcEntry) then repeat

Item := ListProcesses.Items.Add;

Item.Caption := ProcEntry.szExeFile;

Item.SubItems.Add(IntToStr(ProcEntry.tb32ProcessID);

Item.SubItems.Add(IntToStr(ProcEntry.th32ParentProcessID));

Item.SubItems.Add(IntToStr(ProcEntry.cntThreads));

// Сохраняем PID в поле Data соответствующего

// элемента списка. Вообще, поле Data имеет тип

// Pointer, а PID - это целое число, но т.к. оба этих

// типа 32-битные, их можно приводить друг к другу

Item.Data := Pointer(ProcEntry.th32ProcessID);

until not Process32Next(SnapProc, ProcEntry);

finally

CloseHandle(SnapProc);

end

else

begin

ListProcesses.Visible := False;

LabelProcessError.Caption :=

'Невозможно получить список процессов:'#13#10'Ошибка №' +

IntToStr(GetLastError);

end;

Для получения списка модулей данного процесса также используется снимок. Функция CreateToolhelp32Snapshot вызывается с параметром TH32CS_SNAPMODULE, в качестве второго параметра ей передается PID процесса, модули которого требуется получить. Навигация по снимку модулей осуществляется с помощью функций Module32First и Module32Next. В остальном код получения списка модулей совпадает с кодом, приведенным в листинге 1.42.

1.3.1.2. Получение списка и свойств окон

Список окон, созданных процессом, формируется с помощью функции EnumWindows, которая позволяет получить список всех окон верхнего уровня (т.е. расположенных непосредственно на рабочем столе). Для каждого из этих окон с помощью функции GetWindowThreadProcessID определяется идентификатор процесса. Окна, не принадлежащие выбранному процессу, отсеиваются.

Для каждого из окон верхнего уровня, принадлежащих процессу, с помощью функции EnumChildWindows ищутся дочерние окна, а для каждого из найденных таким образом дочерних окон — его дочерние окна. Здесь следует учесть, что EnumChildWindows возвращает не только дочерние окна заданного окна, но и все окна, которыми владеют эти дочерние окна. Чтобы в дереве окон не было дублирования, при построении очередного уровня дерева окон отбрасываются все окна, непосредственным родителем которых не является данное окно. Код, выполняющий построение дерева, приведен в листинге 1.43.

Листинг 1.43. Получение всех окон, относящихся к данному процессу

function EnumWindowsProc(Wnd: HWnd; ParentNode: TTreeNode): BOOL; stdcall;

var

Text: string, TextLen: Integer;

ClassName: array [0..ClassNameLen - 1] of Char;

Node: TTreeNode; NodeName: string;

begin

Result := True;

// функция EnumChildWindows возвращает список

// не только прямых потомков окна, но и потомков его

// потомков, поэтому необходимо отсеять все те окна,

// которые не являются прямыми потомками данного

if Assigned(ParentNode) and (THandle(ParentNode.Data) <> GetAncestor(Wnd, GA_PARENT)) then Exit;

TextLen := GetWindowTextLength(Wnd);

SetLength(Text, TextLen);

if TextLen > 0 then GetWindowText(Wnd, PChar(Text), TextLen + 1);

if TextLen > 100 then Text := Copy(Text, 1, 100) + '...';

GetClassName(Wnd, ClassName, ClassNameLen);

ClassName[ClassNameLen - 1] := #0;

if Text = '' then NodeName := 'Без названия (' + ClassName + ')';

else NodeName := Text + ' (' + ClassName + ')';

NodeName := '$' + IntToHex(Wnd, 8) + ' ' + NodeName;

Node := ProcessesInfoForm.TreeWindows.Items.AddChild(ParentNode, NodeName);

Node.Data := Pointer(Wnd);

EnumChildWindows(Wnd, @EnumWindowsProc, LParam(Node));

end;

function EnumTopWindowsProc(Wnd: HWnd; PIDNeeded: Cardinal): BOOL; stdcall;

var

Text: string;

TextLen: Integer;

ClassName: array[0..ClassNameLen - 1] of Chars;

Node: TTreeNode;

NodeName: string;

WndPID: Cardinal;

begin

Result := True;

// Здесь отсеиваются окна, которые не принадлежат

// выбранному процессу

GetWindowThreadProcessID(Wnd, @WndPID);

if WndPID = PIDNeeded then

begin

TextLen := GetWindowTextLength(Wnd);

SetLength(Text, TextLen);

if TextLen > 0 then GetWindowText(Wnd, PChar(Text), TextLen + 1);

if TextLen > 100 then Text := Copy(Text, 1, 100) + '...';

GetClassName(Wnd, ClassName, ClassNameLen);

ClassName[ClassNameLen - 1] := #0;

if Text = '' then NodeName := 'Без названия (' + ClassName + ')'

else NodeName := Text + ' (' + ClassName + ')';

NodeName := '$' + IntToHex(Wnd, 8) + ' ' + NodeName;

Node := ProcessesInfoForm.TreeWindows.Items.AddChild(nil, NodeName);

Node.Data := Pointer(Wnd);

EnumChildWindows(Wnd, @EnumWindowsProc, LParam(Node));

end;

procedure TProcessesInfoForm.FillWindowList(PID: Cardinal);

begin

if PID = 0 then Exit;

EnumWindows(@EnumTopWindowsProc, PID);

end;

В отличие от примера EnumWnd из разд. 1.2.1 здесь для функций EnumWindows и EnumChildWindows предусмотрены разные процедуры обратного вызова. Связано это с тем, что окна верхнего уровня необходимо фильтровать по принадлежности к выбранному процессу, и параметр функции обратного вызова служит для передачи PID этого процесса. А их дочерние окна фильтровать по процессам не обязательно (мы предполагаем, что если некоторое окно верхнего уровня принадлежит данному процессу, то и все его дочерние окна также принадлежат этому процессу), зато нужно передавать указатель на элемент дерева, соответствующий родительскому окну, чтобы процедура знала, где размещать новый элемент. Таким образом, смысл параметра меняется, поэтому требуется новая процедура обратного вызова. (В принципе, можно было бы проверять, есть ли у найденного окна родитель, и в зависимости от этого трактовать параметр так или иначе, используя приведение типов. Но сильно усложняет код, поэтому в учебном примере мы не будем использовать такой способ.)

Примечание

Как уже было сказано ранее, мы полагаем, что если некоторое окно верхнего уровня принадлежит данному процессу, то и все его дочерние окна также принадлежат этому процессу. В общем случае это неверно: функция CreateWindow(Ex) позволяет при создании нового окна использовать в качестве родительского окно другого процесса. Поэтому наш код ошибочно отнесет подобные окна к тому процессу, к которому относятся их родители, а не к тому, который их реально создал. Здесь мы пренебрегаем такой возможностью, потому что для ее учета не нужны дополнительные знания API, необходимо просто запрограммировать более сложный алгоритм отсева. В учебном примере, посвященном API, реализация такого алгоритма была бы неоправданным усложнением. но в реальных программах эту возможность следует учесть.

Для получения названия окна в приведенном коде используется функция GetWindowText. Эта функция безопасна при работе с зависшими приложениями, поскольку она гарантирует, что вызвавшее ее приложение не зависнет само, пытаясь получить ответ от зависшего приложения. Но GetWindowText не всегда может получить названия элементов управления, расположенных в окнах чужих приложений (точнее, в MSDN написано, что она вообще не может получать названия элементов управления в чужих окнах, но практика показывает, что нередко GetWindowText все же делает это). Существует альтернативный способ получения названия окна — отправка ему сообщения WM_GETTEXT. При этом ограничений на работу с чужими элементами управления нет, но и гарантии, что из-за отсутствия ответа от чужого приложения программа не зависнет, тоже нет.

Использование WM_GETTEXT показано в другой части программы — при заполнении списка параметров окна, отображающегося в правом нижнем углу формы. Чтобы программа не зависала, вместо SendMessage для отправки WM_GETTEXT применяется SendMessageTimeout. Код получения имени показан в листинге 1.44.

Листинг 1.44. Получение заголовков "чужих" окон

if SendMessageTimeout(Wnd, WM_GETTEXTLENGTH, 0, 0,

SMTO_NORMAL or SMTO_ABORTIFHUNG, 5000, TextLen) = 0 then

begin

LastError := GetLastError;

if LastError = 0 then Text := 'Приложение не отвечает'

else

Text:= 'Ошибка при получении длины заголовка: ' + IntToStr(LastError);

end

else

begin

SetLength(Text, TextLen);

if TextLen > 0 then

if SendMessageTimeout(Wnd, WM_GETTEXT, TextLen + 1, LParam(Text),

SMTO_NORMAL or SMTO_ABORTIFHUNG, 5000, TextLen) = 0 then

begin

LastError := GetLastError;

if LastError = 0 then Text := 'Приложение не отвечает'

else Text := 'Ошибка при получении заголовка:' + IntToStr(LastError);

end;

Для каждого окна программа выводит имя оконного класса и реальный класс окна. В большинстве случаев эти два класса совпадают. Они различаются только для тех окон, чьи классы "унаследованы" от стандартных классов, таких как EDIT, COMBOBOX и т.п.

Вообще, наследования оконных классов в Windows нет. Но существует один нехитрый прием, который позволяет имитировать наследование. Оконная процедура обычно не обрабатывает все сообщения, а передает часть их в одну из стандартных оконных процедур (DefWindowProc, DefFrameProc и т.п.). Программа может с помощью функции GetClassInfo узнать адрес оконной процедуры, назначенной стандартному классу, и использовать ее вместо стандартной оконной процедуры. Так как большая часть свойств окна определяется тем, как и какие сообщения оно обрабатывает, использование оконной процедуры другого класса позволяет почти полностью унаследовать свойства этого класса. (В VCL для наследования оконных классов существует метод TWinControl.CreateSubClass.) Функция RealGetWindowClass позволяет узнать имя класса-предка, если такой имеется. Соответствующая часть кода примера приведена в листинге 1.45.

Листинг 1.45. Получение реального класса окна

GetClassName(Wnd, ClassName, ClassNameLen);

ClassName[ClassNameLen - 1] := #0;

ListParams.Items[2].SubItems[0] := ClassName;

RealGetWindowClass(Wnd, ClassName, ClassNameLen);

ClassName[ClassNameLen - 1] := #0;

ListParams.Items[3].SubItems[0] := ClassName;

У окна, если оно имеет стиль WS_CHILD, должно быть родительское окно. Если такого стиля нет, то окно располагается непосредственно на рабочем столе. Кроме того, такое окно может (но не обязано) иметь владельца. Получить дескриптор родительского окна можно с помощью функции GetParent. Владельца — с помощью функции GetWindow с параметром GW_OWNER.

Примечание

Кроме GetParent существует функция GetAncestor, которая также возвращает дескриптор родительского окна, если она вызвана с параметром GA_PARENT. Разница между этими функциями заключается в том. что для окон верхнего уровня (т.е. расположенных непосредственно на рабочем столе) GetParent возвращает 0, a GetAncestor — дескриптор рабочего стопа (этот дескриптор можно получить через функцию GetDesktopWindow).

Значительную часть кода программы составляет анализ того, какие флаги присутствуют в стиле окна. В этом нет ничего сложного, но он громоздкий из-за большого числа флагов. Следует также учесть, что для стандартных классов одни и те же числовые значения могут иметь разный смысл. Так, например, константы ES_NOHIDESEL и BS_LEFT имеют одинаковые значения. Поэтому при расшифровке стиля следует также учитывать класс окна. Приводить здесь этот код мы не будем по причине его тривиальности. Его можно посмотреть в примере на компакт-диске.

1.3.2. Обобщающий пример 2 — Ассоциированные файлы и предотвращение запуска второй копии приложения

Расширения файлов могут быть связаны (ассоциированы) с определенной программой. Такие ассоциации помогают системе выбрать программу для выполнения различных действий с файлом из Проводника. Так, например, если на компьютере установлен Microsoft Office, двойной щелчок в Проводнике на файле с расширением xls приведет к запуску Microsoft Excel и открытию файла в нем. Это происходит потому, что расширение xls ассоциировано с приложением Microsoft Excel.

Примечание

Добиться аналогичного эффекта в своей программе можно используя функцию ShellExecute (стандартная системная функция, в Delphi импортируется в модуле ShellAPI). Эта функция запускает файл, имя которого передано ей как параметр. Если это исполняемый файл, он запускается непосредственно, если нет — функция ищет ассоциированное с расширением файла приложение и открывает файл в нем.

Пример, который мы здесь рассмотрим (программа DKSView), умеет ассоциировать файлы с расширением dks с собой, а также проверять, не были ли они ассоциированы с другим приложением. DKSView является MDI-приложением, т.е. может открывать одновременно несколько файлов. Если приложение уже запущено, а пользователь пытается открыть еще один dks-файл, желательно, чтобы он открывался не в новом экземпляре DKSView, а в новом окне уже имеющегося. Поэтому наш пример будет также уметь обнаруживать уже запущенный экземпляр программы и переадресовывать открытие файла ему.

1.3.2.1. Ассоциирование расширения с приложением

Файловые ассоциации прописываются в реестре, в разделе HKEY_CLASSES_ROOT. Чтобы связать расширение с приложением, необходимо выполнить следующие действия:

1. В корне раздела HKEY_CLASSES_ROOT нужно создать новый раздел, имя которого совладает с расширением с точкой перед ним (в нашем случае это будет раздел с именем ".dks"). В качестве значения по умолчанию в этот раздел должна быть записана непустая строка, которая будет идентифицировать соответствующий тип файла. Содержимое этой строки может быть произвольным и определяется разработчиком (в нашем случае эта строка имеет значение "DKS_View_File").

2. Далее в корне раздела HKEY_CLASSES_ROOT следует создать раздел, имя которого совпадает со значением ключа из предыдущего пункта (т.е. в нашем случае — с именем "DKS_View_File"). В качестве значения по умолчанию для этого ключа нужно поставить текстовое описание типа (это описание будет показываться пользователю в Проводнике в качестве типа файла).

3. В этом разделе создать подраздел Shell, в нем — подраздел Open, а в нем — подраздел Command, значением по умолчанию которого должна стать командная строка для запуска файла. Имя файла в ней заменяется на %1 (подробнее о командной строке чуть ниже).

4. Описанных действий достаточно, чтобы система знала, как правильно открывать файл из Проводника или с помощью ShellExecute. Однако правила хорошего тона требуют, чтобы с файлом была ассоциирована также иконка, которую будет отображать рядом с ним Проводник. Для этого в разделе, созданном во втором пункте, следует создать подраздел "DefaultIcon" и в качестве значения по умолчанию задать ему имя файла, содержащего иконку. Если это ico-файл, содержащий только одну иконку, к имени файла ничего добавлять не нужно. Если иконка содержится в файле, в котором может быть несколько иконок (например, в exe или dll), после имени файла следует поставить запятую и номер требуемой иконки (иконки нумеруются, начиная с нуля).

Приведенный список — это самый минимальный набор действий, необходимых для ассоциирования расширения с приложением. Вернемся к третьему пункту. Имя подраздела "Open" задает команду, связанную с данным расширением, т.е. в данном случае — команду "Open". В разделе Shell можно сделать несколько аналогичных подразделов — в этом случае с файлом будет связано несколько команд. У функции ShellExecute есть параметр lpOperation, в котором задается имя требуемой команды. Пользователь Проводника может выбрать одну из возможных команд через контекстное меню, которое появляется при нажатии правой кнопки мыши над файлом. Существует возможность установить для этих пунктов меню более дружественные имена. Для этого нужно задать значение по умолчанию соответствующего подраздела. В этой строке допустим символ "&" для указания "горячей" клавиши, аналогично тому, как это делается, например, в компоненте TButton.

Если в ShellExecute команда не указана явно, используется команда по умолчанию (то же самое происходит при двойном щелчке на файле в Проводнике). Если не оговорено обратное, командой по умолчанию является команда "Open" или, если команды "Open" нет. первая команда в списке. При необходимости можно задать другую команд) по умолчанию. Для этого нужно указать ее название в качестве значения по по умолчанию раздела Shell.

В нашем примере будет две команды: Open (открыть для редактирования) и View (открыть для просмотра). Поэтому информация в реестр заносится так, как показано в листинге 1.46.

Листинг 1.46. Занесение в реестр информации, необходимой для ассоциирования файла с приложением

const

FileExt = '.dks';

FileDescr = 'DKS_View_File'.

FileTitle = 'Delphi Kingdom Sample file';

OpenCommand = '&Открыть';

ViewCommand = '&Просмотреть';

// Занесение в реестр информации об ассоциации

// Расширения dks с программой

procedure TDKSViewMainForm.SetAssociation(Reg: TRegistry);

begin

Reg.OpenKey('\' + FileExt, True);

Reg.WriteString('' , FileDescr);

Reg.OpenKey('\' + FileDescr, True);

Reg.WriteString(FileTitle);

Reg.OpenKey('Shell', True);

Reg.OpenKey('Open', True);

Reg.WriteString('', OpenCommand);

Reg.OpenKey('command', True);

Reg.WriteString('', '"' + ParamStr(0) + '" "%1"');

Reg.OpenKey('\' + FileDescr, True);

Reg.OpenKey('Shell', True);

Reg.OpenKey('View', True);

Reg.WriteString('', ViewCommand);

Reg.OpenKey('command', True);

Reg.WriteString('' + ParamStr(0) + '" "%1" /v');

Reg.OpenKey('\' + FileDescr, True);

Reg.OpenKey('DefaultIcon', True);

Reg.WriteString('', ParamStr(0) + ',0');

end;

1.3.2.2. Командная строка

Командная строка досталась Windows по наследству от DOS. Там основным средством общения пользователя с системой был ввод команд с клавиатуры. Команда запуска приложения выглядела так:

<Имя приложения> <Строка параметров>

Строка параметров — это произвольная строка, которая без изменений передавалась программе. От имени программы она отделялась пробелом (пробелы в именах файлов и директорий в DOS не допускались). Разработчик конкретного приложения мог, в принципе, интерпретирован, эту строку как угодно, но общепринятым стал способ, когда строка разбивалась на отдельные параметры, которые разделялись пробелами. Вид и смысл параметров зависел от конкретной программы. В качестве параметров нередко передавались имена файлов, с которыми должна была работать программа.

В Windows мало что изменилось — функции CreateProcess и ShellExecute, запускающие приложение, по-прежнему используют понятие командной строки. Разве что теперь максимальная длина строки стала существенно больше, и командную строку можно получить в кодировке Unicode. Но, как и раньше, разделителем параметров считается пробел. Однако теперь пробел может присутствовать и в имени файла, как в имени самой программы, так и в именах файлов, передаваемых в качестве параметров. Чтобы отличать такой пробел от пробела-разделителя, параметры, содержащие пробелы, заключаются в двойные кавычки. Если имя программы содержит пробелы, они тоже заключаются в двойные кавычки. И, конечно же, если в кавычки окажется заключенным параметр, в котором нет пробелов, хуже от этого не будет.

Для работы с параметрами командной строки в Delphi существуют две стандартные функции: ParamCount и ParamStr. Функция ParamCount возвращает количество параметров, переданных в командной строке. ParamStr — параметр с заданным порядковым номером. Параметры нумеруются начиная с единицы, нулевым параметром считается имя самой программы (при подсчетах с помощью ParamCount этот "параметр" не учитывается). Эти функции осуществляют разбор командной строки по описанным ранее правилам: разделитель —пробел, за исключением заключенных в кавычки. Кавычки, в которые заключен параметр, функция ParamStr не возвращает.

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

<Имя программы> "%1"

Если существуют разные варианты запуска одного файла (т.е. как в нашем случае — open и view), они различаться дополнительным параметрами. В частности, в нашем примере для открытия для редактирования не будут требоваться дополнительные параметры, для открытия для просмотра в качестве второго параметра должен передаваться кляч v, т.е. в реестр для этой команды будет записана такая строка:

<Имя программы> "%1" v

Программа должна анализировать переданные ей параметры и открывать соответствующий файл в требуемом режиме. В нашем случае этот код выглядит очень просто (листинг 1.47).

Листинг 1.47. Анализ командной строки

procedure TDKSViewMainForm.FormShow(Sender: TObject);

var

OpenForView: Bооlean;

begin

// Проверяем наличие ключа "/v" в качестве второго параметра

OpenForView := (ParamCount > 1) and (CompareText(ParamStr(2), '/v') = 0);

if ParamCount > 0 then OpenFile(ParamStr(1), OpenForView);

...

end;

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

1.3.2.3. Поиск уже запущенной копии приложения

Во многих случаях желательно не давать пользователю возможности запустить второй экземпляр вашего приложения. В 16-разрядных версиях Windows все приложения выполнялись в одной виртуальной машине, и каждому из них через переменную HPrevInstance передавался дескриптор предыдущей копии. По значению HPrevInstance программа легко могла найти свой предыдущий экземпляр или определить, что других экземпляров нет, если HPrevInstance равна нулю. В 32-разрядных версиях эта переменная для совместимости оставлена, но всегда равна нулю, т.к. предыдущая копия работает в своей виртуальной машине, и ее дескриптор не имеет смысла. Альтернативного механизма обнаружения уже запущенной копии система не предоставляет, приходится выкручиваться своими силами.

Для обнаружения уже запущенного приложения многие авторы предлагают использовать именованные системные объекты (мьютексы, семафоры, атомы и т.п.). При запуске программа пытается создать такой объект с определенным именем. Если оказывается, что такой объект уже создан, программа "понимает", что она — вторая копия, и завершается. Недостаток такого подхода — с его помощью можно установить только сам факт наличия предыдущей копии, но не более того. В нашем случае задача шире: при запуске второго экземпляра приложения должен активизироваться первый, а если второму экземпляру была передана непустая командная строка, первый должен получить эту строку и выполнить соответствующее действие, поэтому описанный способ нам не подходит.

Для решения задачи нам подойдут почтовые ящики (mailslots). Это специальные системные объекты для односторонней передачи сообщений между приложениями (ничего общего с электронной почтой эти почтовые ящики не имеют). Под сообщением здесь понимаются не сообщения Windows, а произвольный набор данных (здесь больше подходит скорее термин "дейтаграмма", а не "сообщение"). Каждый почтовый ящик имеет уникальное имя. Алгоритм отслеживания повторного запуска с помощью почтового ящика следующий. Сначала программа пытается создать почтовый ящик как сервер. Если оказывается, что такой ящик уже существует, то она подключается к нему как клиент и передает содержимое своей командной строки и завершает работу. Сервером в таком случае становится экземпляр приложения, запустившийся первым, — он-то и создаёт почтовый ящик. Остальным экземплярам останется только передать ему данные.

Примечание

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

Почтовый ящик лучше создать как можно раньше, поэтому мы будем его создавать не в методе формы, а в основном коде проекта, который обычно программист не исправляет. В результате код в dpr-файле проекта будет выглядеть так, как показано в листинге 1.48.

Листинг 1.48 Создание почтового ящика в главном файле проекта

const

MailslotName = '\\.\mailslot\DelphiKingomSample_Viewer_FileCommand';

EventName = 'DelphiKingdomSamplе_Viewer_Command_Event';

var

ClientMailslotHandle: THandle;

Letter: string;

OpenForView: Boolean;

BytesWritten: DWORD;

begin

// Пытаемся создать почтовый ящик

ServerMailslotHandle := CreateMailSlot(MailslotName, 0,

MAILSLOT_WAIT_FOREVER, nil);

if ServerMailslotHandle = INVALID_HANDLE_VALUE then

begin

if GetLastError = ERROR_ALREADY_EXISTS then

begin

// Если такой ящик уже есть, подключаемся к нему, как клиент

ClientMailslotHandle := CreateFile(MailslotName, GENERIC_WRITE,

FILE_SHARE_READ, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);

// В зависимости от того, какие переданы параметры, формируем

// строку для передачи предыдущему экземпляру. Первый символ

// строки - команда:

// e - открыть файл для редактирования

// v — открыть файл для просмотра

// s — просто активизировать предыдущий экземпляр

// Для команд e и v к строке, начиная со 2-го символа,

// добавляется имя файла

if ParamCount > 0 then

begin

OpenForView := (ParamCount > 1) and

(CompareText(ParamStr(2), '/v') = 0);

if OpenForView then Letter := 'v' + ParamStr(1)

elsе Letter := 'e' + ParamStr(1);

end

else Letter := 's';

// Отправляем команду в почтовый ящик

WriteFile(ClientMailslotHandle, Letter[1], Length(Letter),

BytesWritten, nil);

// Сигнализируем об отправке данных через специальное событие

CommandEvent := OpenEvent(EVENT_MODIFY_STATE, False, EventName);

SetEvent(CommandEvent);

// Закрываем все дескрипторы

CloseHandle(CommandEvent);

CloseHandle(ClientMailslotHandle);

end;

end

else

begin

// Создаем событие для сигнализирования о поступлении данных

CommandEvent := CreateEvent(nil, False, False, EventName);

// Выполняем обычный для VCL-приложений цикл

Application.Initialize;

Application.CreateForm(TDKSViewMainForm, DKSViewMainForm);

Application.Run;

// Закрываем все дескрипторы

CloseHandle(ServerMailslotHandle);

CloseHandle(CommandEvent);

end;

end.

Теперь осталось "научить" первую копию приложения обнаруживать момент, когда в почтовом ящике оказываются сообщения, и забирать их оттуда. Было бы идеально, если при поступлении данных главная форма получала бы какое-то сообщение, но готового такого механизма, к сожалению, не существует. Из положения можно выйти, задействовав события.

Примечание

События — это объекты синхронизации, использующиеся в системе. Событие может быть взведено и сброшено. С помощью функции WaitForSingleObject можно перевести нить в состояние ожидания до тех пор. пока указанное событие не будет взведено. Подробное рассмотрение объектов синхронизации выходит за рамки нашей книги; они детально описаны, например, в [2].

В принципе, при использовании перекрытого ввода-вывода система может сама взводить указанное программой событие при получении данных почтовым ящиком, но перекрытый ввод-вывод имеет ограниченную поддержку в Windows 9х/МЕ и на почтовые ящики не распространяется. Чтобы приложение могло работать не только в Windows NT/2000/XP, мы не будем применять перекрытый ввод-вывод.

События относятся к именованным объектам, поэтому с их помощью можно синхронизировать разные процессы. В нашем случае первая копия приложения с помощью CreateEvent создает событие, а последующие копии с помощью OpenEvent получают дескриптор этого события и взводят его. чтобы послать сигнал о появлении данных в почтовом ящике. Для обнаружения этого момента в первой копии приложения создается отдельная нить, которая ожидает событие и, дождавшись, посылает главной форме сообщение (эта нить практически не требует процессорного времени, потому что почти все время находится в режиме ожидания, т.е. квант времени планировщик задач ей не выделяет, по крайней мере, проверка наличие данных в главной нити по таймеру отняла бы больше ресурсов). Это сообщение определяется пользователем и берется из диапазона WM_USER, т.к. его широковещательной рассылки не будет. При получении этого сообщения форма выполняет код, приведенный в листинге 1.49.

Листинг 1.49. Реакция формы на поступление данных в почтовый ящик

// Реакция на получение команд от других экземпляров приложения

procedure TDKSViewMainForm.WMCommandArrived(var Message: TMessage);

var

Letter: string;

begin

// Переводим приложение на передний план

GoToForeground;

// Пока есть команды, читаем их и выполняем

Letter := ReadStringFromMailslot;

while Letter <> '' do

begin

// Анализируем и выполняем команду.

// Команда "s" не требует никаких действий, кроме перевода

// приложения на передний план, поэтому здесь мы ее не учитываем

case Letter[1] of

'e': OpenFile(Copy(Letter, 2, MaxInt), False);

'v': OpenFile(Copy(Letter, 2, MaxInt), True);

end;

Letter := ReadStringFronMailslot;

end;

// Чтение очередного сообщения из почтового ящика

function TDksViewMainForm.ReadStringFromMailslot: string;

var

MessageSize: DWORD;

begin

// Получаем размер следующего сообщения в почтовом ящике

GetMailslotInfo(ServerMailslotHandle, nil, MessageSize, nil, nil);

// Если сообщения нет, возвращаем пустую строку

if MessageSize = MAILSLOT_NO_MESSAGE then

begin

Result := '';

Exit;

end;

// Выделяем для сообщения буфер и читаем его в этот буфер

SetLength(Result, MessageSize);

ReadFile(ServerMailslotHandle, Result[1], MessageSize, MessageSize, nil);

end;

Примечание

Так как события являются именованными объектами, второй экземпляр приложения мог бы обнаруживать наличие первого не по почтовому ящику, а по событию. Более того, если бы нам требовалось не передавать данные первому экземпляру, а только активизировать его, можно было бы вообще обойтись одним только событием.

1.3.2.4. Перевод приложения на передний план

Первая копия приложения, получив команду от другой копии, должна вывести себя на передний план. Казалось бы, все просто: с помощью функции SetForegroundWindow мы можем вывести туда любое окно. Однако так было только до Windows 95 и NT 4. В более поздних версиях введены ограничения, и теперь программа не может вывести себя на передний план по собственному усмотрению. Функция SetForegroundWindow просто заставит мигать соответствующую кнопку на панели задач.

Тем не менее, если программа свернута, команда Application.Restore не только восстанавливает окно, но и выводит его на передний план, что нам и требуется. Ну а если программа не свернута, то "выливаем из чайника воду и тем самым сводим задачу к предыдущей": сначала сворачиваем приложение с помощью Application.Minimize, а потом разворачиваем его. Цели мы добились — главное окно на переднем плане.

Дело портит только то, что изменение состояния окна сопровождается анимацией: видно, как главное окно сначала сворачивается, а потом разворачивается. Чтобы убрать этот неприятный эффект, можно на время сворачивания/разворачивания окна запретить анимацию, а потом восстановить ее. С учетом этого метод GoToForeground выглядит так, как показано в листинге 1.50.

Листинг 1.50. Перевод приложения на передний план

// Перевод приложения на передний план

procedure TDKSViewMainForm.GoToForeground;

var

Info: TAnimationInfo;

Animation: Boolean;

begin

// Проверяем, включена ли анимация для окон

Info.cbSize := SizeOf(TAnimationInfo);

Animation := SystemParametersInfo(SPI_GETANIMATION,

SizeOf(Info), @Info, 0 and (Info.iMinAnimate <> 0);

// если включена, отключаем, чтобы не было ненужного мерцания

if Animation then

begin

Info.iMinAnimate := 0;

SysteParametersInfo(SPI_SETANIMATION, SizeOf(Info), @Info, 0);

end;

// Если приложение не минимизировано, минимизируем

if not IsIconic(Application.Handle) then Application.Minimize;

// Восстанавливаем приложение. При этом оно автоматически выводится

// на передний план

Application.Restorе;

// Если анимация окон была включена, снова включаем ее

if Animation than

begin

Info.iMinAnimate := 1;

SystemParametersInfo(SPI_SETANIMATION, SizeOf(Info), @Info, 0);

end;

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

1.3.3. Обобщающий пример 3 — "Дырявое" окно

В этом примере мы создадим "дырявое" окно. Те, кто уже знаком с функцией SetWindowRgn, знает, что сделать "дырку" в окне или придать ему какую-либо другую необычную форму не так уж и сложно. Но мы здесь пойдем дальше: у дырки в нашем окне будет рамка, и пользователь сможет изменять размеры и положение дырки так же, как он может изменять положение и размеры окна. Как это выглядит, показано на рис. 1.14.

Рассмотрим те средства, которые нам понадобятся для реализации этого.

1.3.3.1. Сообщение WM_NCHCHITTEST

Каждое окно в Windows делится на две области: клиентскую и не клиентскую. Клиентской называется та область, в которой отображается содержимое окна. Неклиентская область — это различные служебные области окна: рамка, заголовок, полосы прокрутки, главное меню и т.п. Положение клиентской части окна относительно неклиентской определяет само окно при обработке сообщения WM_NCCALCRECT. Многие окна (особенно различные элементы управления) вообще не имеют неклиентской части.

Некоторые сообщения для клиентской части окна имеют аналоги для неклиентской. Например, перерисовка клиентской области осуществляется с помощью сообщения WM_PAINT, а неклиентской — WM_NCPAINT. Нажатие левой кнопки мыши над клиентской частью окна генерирует сообщение WM_LBUTTONDOWN, а над неклиентской — WM_NCLBUTTONDOWN и т.п. Неклиентская область неоднородна: в нее входит заголовок, кнопки сокрытия, разворачивания и закрытия окна, иконка системного меню, главное меню, вертикальная и горизонтальная полосы прокрутки и рамка. Рамка тоже неоднородна — она имеет левую, правую, верхнюю и нижнюю границы и четыре угла. Сообщение WM_NCCALCSIZE позволяет выяснить, какая область окна является неклиентской, но не позволяет узнать, где какая часть неклиентской области находится. Эта задача решается с помощью другого сообщения — WM_NCHITTEST. В качестве входных параметров WM_NCHITTEST получает координаты точки, а результат кодирует, к какой части окна относится эта точка (например, HTCLIENT означает, что точка принадлежит к клиентской части окна, HTCAPTION — к заголовку, HTLEFT — к левой границе рамки, меняющей размер, и т.п.).

Рис. 1.14. "Дырявое" окно

При любых событиях от мыши система начинает с того, что посылает окну сообщение WM_NCHITTEST с координатами положения мыши. Получив результат, система решает, что делать дальше. В частности, при нажатии левой кнопки мыши окну посылается WM_NCHITTEST. Затем, если результатом был HTCLIENT, посылается сообщение WM_LBUTTONDOWN, в противном случае — WM_NCLBUTTONDOWN. При каждом перемещении мыши окно также получает WM_NCHITTEST — это позволяет системе постоянно отслеживать, над какой частью окна находится курсор, при необходимости меняя его вид (как, например, при прохождении курсора над рамкой).

Что будет, если подменить обработчик WM_NCHITTEST? Например, так, чтобы при попадании точки в клиентскую часть окна он возвращал не HTCLIENT, а HTCAPTION? Это приведет к тому, что любые события от мыши над клиентской областью будут восприниматься так же, как над заголовком. Например, можно будет взять окно за клиентскую часть и переместить его, а двойной щелчок на ней приведет к разворачиванию окна. Однако это полностью блокирует нормальную реакцию на мышь, потому что вместо клиентских "мышиных" сообщений окно будет получать неклиентские.

С практической точки зрения окно, которое можно таскать за любую точку, обычно не очень интересно (особенно это касается приложений, разработанных с помощью VCL: на мышь перестанет правильно реагировать не только само окно, но и расположенные на нем неоконные элементы управления). Однако обработчик WM_NCHITTEST можно сделать более интеллектуальным и получить довольно интересные эффекты. Например, положив на форму панель и переопределив у панели обработчик WM_NCHITTEST таким образом, чтобы при нахождении мыши около границ панели возвращался результат, соответствующий различным частям рамки с изменяемым размером, можно получить панель, размеры которой пользователь программы сможет изменять: система будет реагировать на эту область панели как на обычную рамку, которую можно взять и потянуть. (Пример такой панели можно увидеть в статье "Компонент, который меняет свои размеры в режиме run-time аналогично тому, как это происходит в design-time" http://www.delphikingdom.com/asp/viewitem.asp?catalogid=22.) Фантазия может подсказать и многие другие способы получения интересных эффектов с помощью WM_NCHITTEST.

1.3.3.2. Регионы

Регионы — это особые графические объекты, представляющие собой области произвольной формы. Ограничений на форму региона нет, они даже не обязаны быть связными. Существует ряд функций для создания регионов простых форм (CreateRectRgn, CreateEllipticRgn, CreatePolygonRgn и т.п.), а также функция СombineRgn для объединения регионов различными способами. Все это вместе позволяет получать регионы любых форм. Область применения регионов достаточно широка. Ранее мы уже видели, как с помощью регионов можно ограничить область вывода графики. Здесь же мы будем с помощью функции SetWindowRgn изменять форму окна, придавая ему форму заданного региона.

1.3.3.3. Сообщения WM_SIZE и WM_SIZING

События WM_SIZE и WM_SIZING позволяют окну реагировать на перемещение его пользователем. В "классическом" варианте, когда пользователь начинает тянуть рамку окна, на экране рисуется "резиновый" прямоугольник, соответствующая сторона или угол которого движется за курсором мыши. Окно получает сообщение WM_SIZING при каждом изменении размера этого прямоугольника. Параметр lParam при этом содержит указатель на структуру TRect с новыми координатами прямоугольника. Окно может не только прочитать эти координаты, но и изменить их, блокировав тем самым нежелательные изменения размера. На этом, в частности, основано использование свойства Constraints: если размер окна при перемещении становится меньше или больше заданного, при обработке сообщения WM_SIZING размер увеличивается или уменьшается до необходимого. Параметр wParam содержит информацию о том, за какую сторону или угол тянет пользователь, чтобы программа знала, координаты какого из углов прямоугольника нужно смещать, если возникнет такая необходимость.

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

Описанный "классический" вариант в чистом виде существует только в Windows 95. Во всех более поздних версиях по умолчанию включена опция отображения содержимого окна при перетаскивании и изменении размеров (начиная с Windows ХР эта опция не только включается по умолчанию, но и не отключается средствами пользовательского интерфейса). В таком режиме при изменении размеров окна вместо прямоугольника "резиновым" становится само окно, и любое перемещение мыши при изменении размеров приводит к перерисовке окна. В этом режиме окно получает сообщение WM_SIZE каждый раз после сообщения WM_SIZING, а не только при завершении изменения размеров. Но в целом логика этих сообщений остается прежней, просто с точки зрения программы это выглядит так, как будто пользователь изменяет размеры окна "по чуть-чуть".

1.3.3.4. А теперь — все вместе

Комбинация описанных достаточно простых вещей позволяет построить окно с дыркой, имеющей изменяемые размеры.

Для начала объявим несколько констант, которые нам потребуются при вычислении размеров дырки и т.п. (листинг 1.51).

Листинг 1.51. Константы примера WndHole

const

// минимальное расстояние от дырки до края окна

HoleDistance = 40;

// Зона чувствительности рамки панели - на сколько пикселов

// может отстоять курсор вглубь от края панели, чтобы его

// положение расценивалось как попадание в рамку.

BorderMouseSensivity = 3;

// Зона чувствительности угла рамки панели - на сколько пикселов

// может отстоять курсор от угла панели, чтобы его

// положение расценивалось как попадание в угол рамки.

CornerMouseSensivity = 15;

// Толщина рамки дырки, использующаяся при вычислении региона

HoleBorder = 3;

// Минимальная ширина и высота дырки

MinHoleSize = 10;

// Смещение стрелки относительно соответствующего угла

ArrowOffset = 8;

Теперь приступаем к созданию программы. На форму "кладем" панель. С помощью функции SetWindowRgn устанавливаем такую форму окна, чтобы от панели была видна только рамка, а на всю внутреннюю часть панели пришлась дырка. Рамку выбираем такую, чтобы панель выглядела утопленной, так края дырки будут выглядеть естественней. Для расчета региона используется метод SetRegion (листинг 1.52), он вызывается всегда, когда нужно изменить регион окна.

Листинг 1.52. Метод SetRegion, устанавливающий регион окна

procedure TFormHole.SetRegion;

var

Rgn1, Rgn2: HRGN;

R, R2: TRect;

begin

// Создаем регион, соответствующий прямоугольнику окна

Rgn1 := CreateRectRgn(0, 0, Width, Height);

// Нам потребуются координаты панели относительно левого

// верхнего угла окна (а не относительно левого верхнего

// угла клиентской области, как это задается свойствами

// Left и Тор). Функций для получения смещения клиентской

// области относительно левого верхнего угла окна нет.

// Придется воспользоваться сообщением WM_NCCalcRect

R2 := Rect(Left, Top, Left + Width, Top + Height);

Perform(WM_NCCALCSIZE, 0, LParam(@R2));

// Переводим координаты полученного прямоугольника из

// экранных в координаты относительно левого верхнего

// угла окна

OffsetRect(R2, -Left, -Top);

// получаем координаты панели относительно левого

// верхнего угла клиентской области и пересчитываем их

// в координаты относительно верхнего левого угла окна

R := Rect(0, 0, PanelHole.Width, PanelHole.Height);

OffsetRect(R, PanelHole.Left + R2.Left, PanelHole.Top + R2.Top);

// уменьшаем прямоугольник на величину рамки и создаем

// соответствующий регион

InflateRect(R, -HoleBorder, -HoleBorder);

Rgn2 := CreateRectRgnIndirect(R);

// вычитаем один прямоугольный регион из другого, получая

// прямоугольник с дыркой

CombineRgn(Rgn1, Rgn1, Rgn2, RGN_DIFF);

// уничтожаем вспомогательный регион

DeleteObject(Rgn2);

// Назначаем регион с дыркой окну

SetWindowRgn(Handle, Rgn1, True);

// обратите внимание, что регион, назначенный окну, нигде

// не уничтожается. После выполнения функции SetWindowRgn

// регион переходит в собственность системы, и она сама

// уничтожит его при необходимости

end;

Сообщения, поступающие с панели, перехватываются через ее свойство WindowProc (подробно эта технология описана в первой части данной главы, здесь мы ее касаться не будем). Сообщение WM_NCHITTEST будем обрабатывать так, чтобы при попадании мыши на рамку панели возвращались такие значения, чтобы за эту рамку можно было тянуть. В обработчике сообщения WM_SIZE панели изменяем регион так, чтобы он соответствовал новому размеру панели. Все, дырка с изменяемыми размерами готова. Теперь нужно научить "дырку" менять размеры при изменении размеров окна, если окно стало слишком маленьким, чтобы вместить в себя дырку. Осталось только немного "навести красоту". "Красота" заключается в том, чтобы пользователь не мог уменьшить размеры дырки до нуля и увеличить так, чтобы она вышла за пределы окна, а также уменьшить окно так. чтобы дырка оказалась за пределами окна. Первая из этих задач решается просто: добавляется обработчик сообщения WM_SIZING для дырки таким образом, чтобы ее размеры не могли стать меньше, чем MinHoleSize на MinHoleSize пикселов, а границы нельзя было придвинуть к границам окна ближе, чем на HoleDistance пикселов. Вторая задача решается еще проще: в обработчике WM_SIZE дырки меняем свойство Constraints формы таким образом, чтобы пользователь не мог слишком сильно уменьшить окно. Теперь окно с дыркой ведет себя корректно при любых действиях пользователя с дыркой. Получившийся в результате код обработчика сообщений панели приведен в листинге 1.53.

Листинг 1.53. Обработчик сообщений панели, образующей "дырку"

procedure TFormHole.PanelWndProc(var Msg: TMessage);

var

Pt: TPoint;

R: TRect;

begin

POldPanelWndProc(Msg);

if Msg.Msg = WM_NCHITTEST then

begin

// Вся хитрость обработки сообщения WM_NCHITTEST

// заключается в правильном переводе экранных координат

// в клиентские и в несколько муторной проверке попадания

// мыши на сторону рамки или в ее угол. Дело упрощается

// тем, что у панели нет неклиентской части, поэтому

// верхний левый угол окна и верхний левый угол клиентской

// части совпадают.

Pt := PanelHole.ScreenToClient(Point(Msg.LParamLo, Msg.LParamHi));

if Pt.X < BorderMouseSensivity then

if Pt.Y < CornerMouseSensivity then Msg.Result := HTTOPLEFT

else

if Pt.Y >= PanelHole.Height - CornerMouseSensivity then

Msg.Result := HTBOTTOMLEFT

else Msg.Result := HTLEFT

else

if Pt.X >= PanelHole.Width - BorderMouseSensivity then

if Pt.Y < CornerMouseSensivity then Msg.Result := HTTOPRIGHT

else

if Pt.Y >= PanelHole.Height - CornerMouseSensivity then

Msg.Result := HTBOTTOMRIGHT

else Msg.Result := HTRIGHT

else

if Pt.Y < BorderMouseSensivity then

if Pt.X < CornerMouseSensivity then Msg.Result := HTTOPLEFT

else

if Pt.X >= PanelHole.Width - CornerMouseSensivity then

Msg.Result := HTTOPRIGHT

else Msg.Result := HTTOP

else

if Pt.Y >= PanelHole.Height - BorderMouseSensivity then

if Pt.X < CornerMouseSensivity then

Msg.Result := HTBOTTOMLEFT

else

if Pt.X >= PanelHole.Width - CornerMouseSensivity then

Msg.Result := HTBOTTOMRIGHT

else Msg. Result := HTBOTTOM;

end

else if Msg.Msg = WM_SIZE then

begin

// Пересчитываем регион SetRegion;

// Устанавливаем новые ограничения для размеров окна.

// учитывающие новое положение дырки

Constraints.MinWidth :=

Width - ClientWidth + PanelHole.Left + MinHoleSize + HoleDistance;

Constraints.MinHeight :=

Height - ClientHeight + PanelHole.Top + MinHoleSize + HoleDistance;

end

else if Msg.Msg = WM_SIZING then

begin

// Копируем переданный прямоугольник в переменную R,

// одновременно пересчитывая координаты из экранных

// в клиентские

R.TopLeft := ScreenToClient(PRect(Msg.LParam)^.TopLeft);

R.BottomRight := ScreenToClient(PRect(Msg.LParam)^.BottomRight);

// Если ширина слишком мала, проверяем, за какую

// сторону тянет пользователь. Если за левую -

// корректируем координаты левой стороны, если за

// правую - ее координаты

if R.Right - R.Left < MinHoleSize then

if Msg.WParam in [WMSZ_BOTTOMLEFT, WMSZ_LEFT, WMSZ_TOPLEFT] then

R.Left := R.Right - MinHoleSize

else

R.Right := R.Left + MinHoleSize;

// Аналогично действуем, если слишком мала высота

if R.Bottom - R.Top < MinHoleSize then

if Msg.WParam in [WMSZ_TOP, WMSZ_TOPLEFT, WMSZ_TOPRIGHT] then

R.Top := R.Bottom - MinHoleSize

else R.Bottom := R.Top + MinHoleSize;

// Сдвигаем стороны, слишком близко подошедшие

// к границам окна

if R.Left < HoleDistance then R.Left := HoleDistance;

if R.Top < HoleDistance then R.Top := HoleDistance;

if R.Right > ClientWidth - HoleDistance then

R.Right := ClientWidth - HoleDistance;

if R.Bottom > ClientHeight - HoleDistance then

R.Bottom := ClientHeight - HoleDistance;

// Копируем прямоугольник R, переводя его координаты

// обратно в экранные

PRect(Msg.LParam)^.TopLeft := ClientToScreen(R.TopLeft);

PRect(Msg.LParam)^.BottomRight := ClientToScreen(R.BottomRight);

end;

Остается еще одна ситуация, когда границы "дырки" могут подойти к границам окна слишком близко: когда пользователь меняет не границы "дырки", а границы самого окна. Чтобы этого не случилось, нужно отслеживать изменения размеров окна и соответствующим образом менять размеры дырки — для этого нам потребуется изменить размеры панели и пересчитать регион. Пересчет региона необходим и в случае увеличения размеров окна: если его не пересчитать, получится, что часть окна не будет попадать в регион и будет отрезана. Все перечисленные действия выполняются в обработчике сообщения WM_SIZE окна (листинг 1.54).

Листинг 1.54. Обработчик сообщения WM_SIZE главного окна

procedure TFormHole.WMSize(var Msg: TWMSize);

begin

inherited;

// При уменьшении размеров окна уменьшаем размер дырки,

// если границы окна подошли слишком близко к ней

if PanelHole.Left + PanelHole.Width > ClientWidth - HoleDistance then

PanelHole.Width := ClientWidth - HoleDistance - PanelHole.Left;

if PanelHole.Top + PanelHole.Height > ClientHeight - HoleDistance then

PanelHole.Height := ClientHeight - HoleDistance - PanelHole.Top;

// На случай увеличения окна пересчитываем его регион,

// иначе та часть, которая добавилась, окажется за его

// пределами и будет отрезана SetRegion;

// Пересчитываем координаты стрелок

CalculateArrows;

Invalidate;

end;

Напоследок добавим к программе один "бантик": красные стрелки по углам формы, за которые можно потянуть, чтобы изменить ее размер. Каждая стрелка будет представляться отдельным регионом. Координаты регионов должны быть привязаны к соответствующим углам окна, поэтому при изменении размеров окна эти координаты придется пересчитывать (в листинге 1.54 можно найти соответствующий вызов). Все стрелки выглядят одинаково, но являются зеркальным отражением друг друга. Чтобы рассчитывать координаты стрелок, мы зададим координаты одной нарисованной заранее стрелки в виде константы, а потом будем рассчитывать на основе этих данных координаты реальных стрелок, отражая их от нужной плоскости и добавляя требуемое смещение (листинг 1.55).

Листинг 1.55. Расчет координат стрелок

// координаты верхней левой стрелки, отсчитанные от точки

// (0,0). Для получения координат реальных стрелок эти точки

// будут смещаться и отражаться

const

ArrowTemplate: TArrowCoords = (

(X:0; Y:0), (X:24; Y:0), (X:17; Y:7), (X:29; Y:19),

(X:19; Y:29), (X:7; Y:17), (X:0; Y:24));

procedure TFomHole.CalculateArrows;

var

Arrow: TArrowCoords;

I: Integer;

begin

// Вычисление региона левой верхней стрелки

// Координаты просто смещаются на постоянную величину

for I := 0 to High(Arrow) do

begin

Arrow[I].X := ArrowTemplate[I].X + ArrowOffset;

Arrow[I].Y := ArrowTemplate[I].Y + ArrowOffset;

end;

// При необходимости уничтожаем старый регион

if ArrowTopLeft <> 0 then DeleteObject(ArrowTopLeft);

ArrowTopLeft :=

CreatePolygonRgn(Arrow[0], Length(Arrow), WINDING);

// Вычисление региона правой верхней стрелки

// Координаты по X отражаются и смещаются

// на постоянную величину относительно правого края окна

for I := 0 to High(Arrow) do

begin

Arrow[I].X := ClientWidth - ArrowOffset - 1 - ArrowTemplate[I].X;

Arrow[I].Y := ArrowTemplate[I].Y + ArrowOffset;

end;

if ArrowTopRight <> 0 then DeleteObject(ArrowTopRight);

ArrowTopRight := CreatePolygonRgn(Arrow[0], Length(Arrow), WINDING);

// Вычисление региона левой нижней стрелки

// Координаты по Y отражаются и смещаются

// на постоянную величину относительно нижнего края окна

for I := 0 to High(Arrow) do

begin

Arrow[I].X := ArrowTemplate[I].X + ArrowOffset;

Arrow[I].Y := ClientHeight - ArrowOffset - 1 - ArrowTemplate[I].Y;

end;

if ArrowBottomLeft <> 0 then DeleteObject(ArrowBottomLeft);

ArrowBottomLeft := CreatePolygonRgn(Arrow[0], Length(Arrow), WINDING);

// Вычисление региона правой нижней стрелки

// Координаты по обеим осям отражаются и смещаются

// на постоянную величину относительно правого нижнего угла окна

for I := 0 to High(Arrow) do

begin

Arrow[I].X := ClientWidth - ArrowOffset - 1 - ArrowTemplate[I].X;

Arrow[I].Y := ClientHeight - ArrowOffset - 1 - ArrowTemplate[I].Y;

end;

if ArrowBottomRight <> 0 then DeleteObject(ArrowBottomRight);

ArrowBottomRight := CreatePolygonRgn(Arrow[0], Length(Arrow), WINDING);

end;

Следующий шаг — рисование стрелки на форме. Делается это очень просто (листинг 1.56).

Листинг 1.56. Рисование стрелок на форме

procedure TFormHole.FormPaint(Sender: TObject);

begin

// Закрашиваем регионы стрелок

Canvas.Brush.Style := bsSolid;

Canvas.Brush.Color := clRed;

FillRgn(Canvas.Handle, ArrowTopLeft, Canvas.Brush.Handle);

FillRgn(Canvas.Handle, ArrowTopRight, Canvas.Brush.Handle);

FillRgn(Canvas.Handle, ArrowBottomLeft, Canvas.Brush.Handle);

FillRgn(Canvas.Handle, ArrowBottomRight, Canvas.Brush.Handle);

Остался последний шаг — объяснить системе, что пользователь может, ухватив за стрелки, изменять размеры формы. Очевидно, что делается это через обработчик WM_NCHITTEST. Вопрос только в том, как узнать, когда координаты мыши попадают внутрь нарисованной стрелки, поскольку стрелка является объектом сложной формы, вычислить это не очень просто. Данная задача также решается с помощью регионов: попадание координат курсора в регион каждой из стрелок отслеживается с помощью стандартной функции PtInRegion (листинг 1.57).

Листинг 1.57. Обработчик WM_NCHITTEST формы

procedure TFormHole.WMNCHitTest(var Msg: TWMNCHitTest);

var

Pt: TPoint;

begin

// Чтобы правильно обрабатывать стандартную неклиентскую область,

// вызываем унаследованный обработчик

inherited;

// Не забываем, что параметры WM_NCHITTEST дают экранные,

// а не клиентские координаты

Pt := ScreenToClient(Point(Msg.XPos, Msg.YPos));

// Проверяем координаты на попадание в регионы стрелок

if PtInRegion(ArrowTopLeft, Pt.X, Pt.Y) then

Msg.Result := HTTOPLEFT

else if PtInRegion(ArrowTopRight, Pt.X, Pt.Y) then

Msg.Result := HTTOPRIGHT

else

if PtInRegion(ArrowBottomLeft, Pt.X, Pt.Y) then

Msg.Result := HTBOTTOMLEFT

else

if PtInRegion(ArrowBottomRight, Pt.X, Pt.Y) then

Msg.Result := HTBOTTOMRIGHT;

end;

Вот и все. С помощью нескольких нехитрых приемов мы получили окно, которое имеет такой необычный вид (см. рис. 1.14).

1.3.4. Обобщающий пример 4 — Линии нестандартного стиля

GDI позволяет рисовать линии разных стилей, но бывают ситуации, когда стандартных возможностей по изменению стиля линий не хватает. В этом разделе мы покажем, как рисовать линии произвольного стиля (начнем с прямых, потом перейдем к кривым Безье), а также сделаем "резиновую" линию, которую пользователь может тянуть мышью.

1.3.4.1. Получение координат точек прямой

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

Существует ряд алгоритмов вычисления этих координат. Наиболее известный из них — алгоритм Брезенхэма (Bresengham), который заключается в равномерном разбрасывании "ступенек" разной длины вдоль линии. В Windows используется алгоритм GIQ (Grid Intersection Quantization). Каждый пиксел окружается воображаемым ромбом из четырех пикселов. Если прямая имеет общие точки с этим ромбом, то пиксел рисуется.

Самостоятельно реализовывать один из таких алгоритмов нет необходимости — в Windows существует функция LineDDA, которая возвращает вызвавшей ее программе координаты линии. Эта функция в качестве параметра принимает координаты начала и конца линии, а также указатель на функцию, которой будут передаваться координаты пикселов. Данная функция должна быть реализована в программе. За время выполнения LineDDA эта функция будет вызвана столько раз, сколько пикселов содержит линия (как обычно в Windows, последний пиксел не считается принадлежащим прямой). Каждый раз при вызове ей будут передаваться координаты очередного пиксела, причем пикселы будут упорядочены от начала к концу прямой.

В примере Lines (рис. 1.15) с помощью LineDDA рисуется пять различных типов линий. Рассмотрим на примере самого сложного из реализуемых программой типов линии ("Зеленая елочка"), как это делается (листинг 1.58).

Рис. 1.15. Окно программы Lines

Листинг 1.58. Рисование линии сложного стиля

// константы для типа "Зеленая елочка"

const

// Угол отклонения "иголки" от направления линии

FirNeedleAngle = 30;

//Длина иголки

FirNeedleLength = 8;

var

Counter: Integer; // Счетчик точек линии

// Вспомогательные переменные для построения "елочки"

DX1, DY1, DX2, DY2: Integer;

// Линия в виде "елочки"

procedure LineDrawFir(X, Y: Integer; Canvas: TCanvas); stdcall;

begin

with Canvas do case Counter mod 10 of

0: begin

MoveTo(X, Y);

LineTo(X + DX1, Y + DY1);

end;

begin

MoveTo(X, Y);

LineTo(X + DX2, Y + DY2);

end;

Inc(Counter);

end;

procedure TLinesForm.Line(X1, Y1, X2, Y2: Integer);

var

Angle: Extended;

begin

case RGroupLine.ItemIndex of

...

begin

Counter := 0;

Angle := ArcTan2(Y2 - Y1, X2 - X1);

DX1 := Round(FirNeedleLength *

Cos(Angle + Pi / 180 * FirNeedleAngle));

DY1 := Round(FirNeedleLength *

Sin(Angle + Pi / 180 * FirNeedleAngle));

DX2 := Round(FirNeedleLength *

Cos(Angle - Pi / 180 * FirNeedleAngle));

DY2 := Round(FirNeedleLength *

Sin(Angle - Pi / 180 * FirNeedleAngle));

LineDDA(X1, Y1, X2, Y2, @LineDrawFir, Integer(Canvas));

end;

Каждая "иголка" — это линия длиной FirNeedleLength пикселов, отклоняющаяся от направления прямой на угол FirNeedleAngle градусов. "Иголки" отклоняются попеременно то в одну, то в другую сторону от прямой. В процедуре Line сначала рассчитываются смещения координат конца "иголки" относительно начала и результаты помещаются в глобальные переменные DX1, DY1, DX2, DY2. Переменная Counter служит для определения номера точки. Перед вызовом LineDDA она инициализируется нулем. Затем вызывается функция LineDDA, в качестве одного из параметров которой передается указатель на функцию обратного вызова LineDrawFir. В результате этого функция LineDrawFir будет вызвана последовательно для каждого из пикселов, составляющих линию, начиная с (X1, Y1). LineDrawFir ведет подсчет пикселов, каждый раз увеличивая Counter на единицу. Если остаток от деления номера точки на 10 равен 0, рисуется "иголка", отклоняющаяся в положительном направлении, если 5 — в отрицательном. В остальных случаях не рисуется ничего. Так получается "елочка".

1.3.4.2. "Резиновая" линия и растровые операции

Теперь нужно дать пользователю возможность рисовать линии. Для этого мы используем стандартную "резиновую" линию: пользователь нажимает левую кнопку мыши и, удерживая ее, передвигает мышь. До тех пор, пока кнопка удерживается, за курсором тянется линия. Как только пользователь отпускает кнопку, линия "впечатывается" в рисунок.

Сама по себе реализация "резиновой" линии очень проста: при наступлении события OnMouseDown запоминаются координаты начала линии и взводится флаг, показывающий, что включен режим рисования "резиновой" линии. Также запоминаются координаты конца отрезка, который на данный момент совпадает с началом. В обработчике OnMouseMove, если включен режим рисования "резиновой" линии, стирается линия со старыми координатами конца и рисуется с новыми. При наступлении OnMouseUp программа выходит из режима рисования "резиновой" линии, рисуя окончательный ее вариант с текущими координатами конца.

Самое сложное в этой последовательности действий — стереть нарисованную ранее линию. Если бы у нас был однородный фон, можно было бы просто нарисовать старую линию еще раз цветом фона — это выглядело бы как ее стирание. Но поскольку фон не однородный, а составлен из нарисованных ранее линий, этот способ мы применить не можем.

Для решения этой задачи мы здесь рассмотрим самый простой метод — инверсное рисование (более сложный метод будет рассмотрен чуть позже). При этом каждая точка, принадлежащая линии, закрашивается не каким-либо фиксированным цветом, а инвертируется (т.е. к текущему цвету точки применяется операция not). Для стирания линии просто рисуем ее еще раз: двойная инверсия восстанавливает предыдущий цвет точек (not not X = X для любого X).

При рисовании пером и кистью GDI позволяет использовать различные растровые операции, которые определяют результирующий цвет каждого пиксела в зависимости от цвета фона и пера или кисти. По умолчанию применяется операция R2_COPYPEN, в которой цвет фона игнорируется, а результирующий цвет пиксела совпадает с цветом пера или кисти. Изменить растровую операцию можно с помощью функции SetROP2 (двойка в названии функции показывает, что устанавливаемая растровая операция имеет два аргумента — цвет рисования и цвет фона: при выводе растровых рисунков могут применяться растровые операции с тремя аргументами — см. функцию BitBlt). Нас будет интересовать операция R2_NOT, которая инвертирует фоновый цвет, игнорируя цвет пера или кисти.

Примечание

Растровая операция влияет на все, что рисуется с помощью пера и кисти, т.е. на рисование границ фигур и их заливку. Кроме того, растровая операция влияет также на результат работы функции SetPixel (и, соответственно, изменение цвета с помощью Canvas.Pixels[X, Y]), т.к. эта операция выполняется с мощью кистей.

Код, рисующий "резиновую" линию, приведен в листинге 1.59.

Листинг 1.59. Рисование "резиновой" линии инверсным методом

procedure TLinesForm.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

if Button = mbLeft then begin

OldX := X;

OldY := Y;

BegX := X;

BegY := Y;

LineDrawing := True;

end;

procedure TLinesForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

if LineDrawing and ((X <> OldX) or (Y <> OldY)) then

with Canvas do

begin

SetROP2(Handle, R2_NOT);

Line(BegX, BegY, OldX, OldY); // Стираем старую линию.

Line(BegX, BegY, X, Y); // Рисуем новую.

OldX := X;

OldY := Y;

end;

procedure TLinesFom.FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

if (Button = mbLeft) and LineDrawing then

begin

case RGroupLine.ItemIndex of

2: Canvas.Pen.Color := clBlue;

3: begin

Canvas.Brush.Color := clRed;

Canvas.Pen.Color := clRed;

end;

4: Canvas.Pen.Color := clGreen;

end;

Line(BegX, BegY, X, Y);

LineDrawing := False;

end;

Обратите внимание, что резиновая линия следует за мышью даже тогда, когда мышь выходит за пределы формы, т.е. форма получает сообщения мыши, когда курсор находится за ее пределами. Это становится возможным благодаря захвату мыши окном. Любое окно в Windows может захватить мышь для монопольного использования, и тогда все сообщения от мыши будет получать это окно, независимо от того, где находится курсор. В VCL любой визуальный компонент, у которого установлен стиль csCaptureMouse (а у формы он по умолчанию установлен) автоматически захватывает мышь при нажатии левой кнопки и освобождает при ее отпускании, поэтому мы получаем требуемый нам эффект автоматически.

1.3.4.3. Кривые Безье

Сделаем следующий шаг — научимся рисовать произвольным стилем не только прямые, но и кривые. Проще всего это сделать с так называемыми кривыми Безье — они, во-первых, поддерживаются системой Windows, а во-вторых, ими можно аппроксимировать многие другие кривые (в частности, в Windows NT/2000 XP все кривые — окружности, эллипсы, дуги — аппроксимируются кривыми Безье).

Теорию кривых Безье разработал П. де Кастело в 1959 году и, независимо от него, П. Безье в 1962 году. Для построения кривой Безье N-го порядка необходимо N+1 точек, две из которых определяют концы кривой, а остальные N-1 называются опорными. В компьютерной графике наибольшее распространение получили квадратичные кривые Безье, строящиеся по трем точкам, и кубические кривые Безье, строящиеся по четырем точкам. Квадратичные кривые Безье используются, например, в шрифтах TrueType при определении контуров символов. Windows API позволяет строить только кубические кривые Безье.

Кубические кривые Безье задаются следующей формулой:

P(t) = А(1-t)³ + 3Bt(1-t)² + 3Ct²(1-t)+Dt³ (1)

где А — начало кривой, D — ее конец, а В и С — первая и вторая опорные точки. Прямая АВ касательная к кривой в точке А, прямая CD — в точке D. Параметр t изменяется от 0 до 1. При t = 0 P(t) = А, при t = 1 P(t) = D.

Одним из важнейших свойств кривой Безье является ее делимость. Если кривую разделить на две кривых в точке t = 0,5, каждая из полученных кривых также будет являться кривой Безье. На этом свойстве основывается алгоритм рисования кривых Безье: если кривая может быть достаточно точно аппроксимирована прямой, рисуется отрезок прямой, если нет — она разбивается на две кривых Безье, к каждой из которых вновь применяется этот алгоритм. Для рисования кривых Безье служат функции PolyBezier, PolyBezierTo и PolyDraw.

В некоторых случаях удобно строить кривую Безье не по опорным точкам, а по точкам, через которые она должна пройти. Пусть кривая начинается в точке А, при t=⅓ проходит через точку В', при t=⅔ — через точку С', и заканчивается в точке D. Подставляя эти точки в уравнение (1), получаем систему, связывающую В' и С' с В и С . Решая систему, получаем

(2)

Из этих уравнений, в частности, следует, что для любых четырех точек плоскости существует, и притом единственная, кривая Безье, которая начинается в первой точке, проходит при t=⅓ через вторую точку, при t=⅔ — через третью и завершается в четвертой точке. Аналогичным образом можно вычислить опорные точки для кривой, которая должна проходить через заданные точки при других значениях t.

1.3.4.4. Траектории

API Windows реализует поддержку специфических объектов, называемых траекториями (path). Траектория представляет собой запись движения пера и включает один или несколько замкнутых контуров. Каждый контур состоит из отрезков прямых и кривых Безье. Для построения траектории в Windows NT/2000/XP могут быть задействованы все графические функции рисования прямых, кривых и замкнутых контуров, а также функции вывода текста (в этом случае замкнутые контуры будут совпадать с контурами символов). В Windows 9x/Me могут быть использованы только функции рисования прямых, ломаных, многоугольников (за исключением PolyDraw и Rectangle), кривых Безье и функций вывода текста. Функции рисования эллипсов, окружностей и эллиптических дуг не могут быть использованы для создания траектории в Windows 9x/Me, т.к. в этих системах эллиптические кривые рисуются специальным алгоритмом, а не аппроксимируются кривыми Безье. Для создания траектории предусмотрены функции BeginPath и EndPath. Все вызовы графических функций, расположенные между BeginPath и EndPath, вместо вывода в контекст устройства будут создавать в нем траекторию.

После того как траектория построена, ее можно отобразить или преобразовать. Мы не будем здесь перечислять все возможные операции с траекториями, остановимся только на преобразовании траектории в ломаную. Как уже отмечалось, все контуры траектории представляют собой набор отрезков прямых и кривых Безье. С другой стороны, при построении кривой Безье она аппроксимируется ломаной. Следовательно, вся траектория может быть аппроксимирована набором отрезков прямой. Функция FlattenPath преобразует кривые Безье, входящие в состав траектории, в ломаные линии. Таким образом, после вызова этой функции траектория будет состоять из отрезков прямой.

Отметим также некоторые другие преобразование траектории, полезные для создания графических редакторов и подобных им программ. Функция PathToRegion позволяет преобразовать траекторию в регион. Это может понадобиться, в частности, при определении того обстоятельства, попадает ли курсор мыши в область объекта, представляемого сложной фигурой. Функция WidenPath превращает каждый контур траектории в два контура — внутренний и внешний. Расстояние между ними определяется толщиной текущего пера. Таким образом, траектория как бы утолщается. После преобразования утолщенной траектории в регион можно определить, попадает ли курсор мыши на кривую с учетом погрешности, определяемой толщиной пера.

Получить информацию о точках текущей траектории можно с помощью функции GetPath. Для каждой точки траектории эта функция возвращает координаты и тип точки (начальная линии, замыкающая точка отрезка, точка кривой Безье, конец контура).

Таким образом, создав траекторию из кривой Безье (BeginPath/PoliBezier/EndPath), мы можем преобразовать эту траекторию в ломаную (FlattenPath), а затем получить координаты угловэтой ломаной (GetPath). А каждое звено этой ломаной мы можем нарисовать произвольным стилем, используя LineDDA. Таким образом, задача построения кривой Безье сведена к уже решенной задаче построения отрезка.

В листинге 1.60 реализован метод DrawCurve, выполняющий указанные действия. Здесь FCurve — это поле формы типа TCurve, в котором хранятся координаты четырех точек, образующих кривую.

Листинг 1.60. Работа с траекторией на основе кривой Безье

type

// Тип TCurve хранит координаты кривой в следующем порядке: начало,

// первую промежуточную точку, вторую промежуточную точку, конец

TCurve = array[0..3] of TPoint;

// Функция обратного вызова для LineDDA

procedure LineDrawFunc(X, Y: Integer; Canvas: TCanvas); stdcall;

begin

case CurveForm.RGroupType.ItemIndex of

// Разноцветные шарики

0: if CurveForm.FCounter mod 10 = 0 then

begin

Canvas.Pen.Style := psSolid;

Canvas.Pen.Width := 1;

Canvas.Brush.Style := bsSolid;

if CurveForm.FCounter mod 15 = 0 then Canvas.Pen.Color := clBlue

else if CurveForm.FCounter mod 15 = 5 then Canvas.Pen.Color := сlLime

else Canvas.Pen.Color := clRed;

Canvas.Brush.Color := Canvas.Pen.Color;

Canvas.Ellipse(X - 2, Y - 2, X + 3, Y + 3);

end;

// Поперечные полосы

1: it CurveForm.FCounter mod 5 = 0 then

begin

Canvas.Pen.Style := psSolid;

Canvas.Pen.Width := 1;

Canvas.Pen.Color := clBlue;

Canvas.MoveTo(X - CurveForm.FDX, Y - CurveForm.FDY);

Canvas.LineTo(X + CurveForm.FDX, Y + CurveForm.FDY);

end;

// Плакатное перо

2: begin

Canvas.Pen.Style := psSolid;

// Предположим, некоторая точка прямой имеет координаты (X, Y),

// а соседняя с ней - координаты (Х+1, Y-1). Тогда при проведении

// через эти точки наклонной линии одинарной ширины между ними

// останутся незаполненные точки, как на шахматной доске.

// Поэтому потребовалось увеличить толщину пера

Canvas.Pen.Width := 2;

Canvas.Pen.Color := clBlack;

Canvas.MoveTo(X - 5, Y - 5);

Canvas.LineTo(X + 6, Y + 6);

end;

// Цепочка

3: begin

case CurveForm.FCounter mod 15 of

0: begin

Canvas.Pen.Style := psSolid;

Canvas.Pen.Width := 1;

Canvas.Pen.Color := clBlack;

Canvas.Brush.Style := bsClear;

Canvas.Ellipse(X - 5, Y - 5, X + 6, Y + 6);

end;

2..13: Canvas.Pixels[X, Y] := clBlack;

end;

Inc(CurveForm.FCounter);

end;

procedure TCurveForm.DrawCurve(Canvas: TCanvas);

var

LCurve: TCurve;

I, Size: Integer;

PtBuf: array of TPoint;

TpBuf: array of Byte;

L: Extended;

begin

// LCurve хранит координаты начала и конца кривой и ее

// опорных точек. Если включен режим рисования по опорным

// точкам, LCurve совпадает с FCurve, если включен режим

// рисования по точкам кривой, опорные точки LCurve[1]

// и LCurve[2] рассчитываются по приведенным в книге

// формулам на основании точек FCurve

LCurve := FCurve;

if RGroupDrawMethod.ItemIndex = 1 then

begin

LCurve[1].X :=

Round((-5 * FCurve[0].X + 18 * FCurve[1].X -

9 * FCurve[2].X + 2 * FCurve[3].X) / 6);

LCurve[1].Y :=

Round((-5 * FCurve[0].Y + 18 * FCurve[1].Y -

9 * FCurve[2].Y + 2 * FCurve[3]-Y) / 6);

LCurve[2].X :=

Round((2 * FCurve[0].X - 9 * FCurve[1].X +

18 * FCurve[2].X - 5 * FCurve[3].X) / 6);

LCurve[2].Y :=

Round((2 * FCurve[0].Y - 9 * FCurve[1].Y +

18 * FCurve[2].Y - 5 * FCurve[3].Y) / 6);

end;

// Создаем траекторию на основе кривой

BeginPath(Canvas.Handle);

Canvas.PolyBezier(LCurve);

EndPath(Canvas.Handle);

// Аппроксимируем траекторию отрезками прямых

FlattenPath(Canvas.Handle);

// Получаем число точек траектории. Так как сами точки никуда

// пока не копируются, в качестве фиктивного буфера можно указать

// любую переменную. В данном случае - переменную I

Size := GetPath(Canvas.Handle, I, I, 0);

// Выделяем память для хранения координат и типов точек траектории

SetLength(PtBuf, Size);

SetLength(TpBuf, Size);

// Получаем координаты и типы точек. Типы точек нас в данном случае

// не интересуют: у первой точки будет тип PT_MOVETO,

// а у остальных - PT_LINETO. Появление PT_MOVETO у других точек

// невозможно, т.к. траектория содержит только один замкнутый

// контур, состояний из кривой и соединяющей ее концы прямой.

// Появление точек типа PT_BEZIERTO также исключено, т.к. после

// вызова FlattenPath контур содержит только отрезки прямых.

// Поэтому значения, записанные в TpBuf, будут в дальнейшем

// игнорироваться

GetPath(Canvas.Handle, PtBuf[0], TpBuf[0], Size);

FCounter := 0;

// Рисуем по отдельности каждый из отрезков, составляющих контур

for I := 1 to Size - 1 do

begin

// Вычисляем длину отрезка

L :=

Sqrt(Sqr(PtBuf[I - 1].X - PtBuf[I].X) +

Sqr(PtBuf[I - 1].Y - PtBuf[I].Y));

// Практика показала, что аппроксимированный контур может

// содержать отрезки нулевой длины - видимо, это издержки

// алгоритма аппроксимации. Так как в дальнейшем нам придется

// делить на L, такие отрезки мы просто игнорируем, т.к.

// на экране они все равно никак не отображаются

if L > 0 then begin

// переменные FDX и FDY используются только при рисовании

// линии типа "поперечные полосы". Если бы линии этого

// типа не было, то FDX, FDY, а так же L можно было бы

// не рассчитывать

FDX := Round (4 * (PtBuf[I - 1].Y - PtBuf[I].Y) / L);

FDY := Round(4 * (PtBuf[I].X - PtBuf[I - 1].X) / L);

LineDDA(PtBuf[I - 1].X, PtBuf[I - 1].Y, PtBuf[I].X, PtBuf[I].Y,

@LineDrawFunc, Integer(Canvas));

end;

1.3.4.5. Интерактивная кривая

Описанная технология создания "резиновой" линии не годится для рисования кривой Безье, т. к. пользователь должен задать координаты не двух точек, а четырех. Удобнее всего это сделать следующим образом: сначала нарисовать "резиновую" прямую, задав тем самым начало и конец кривой, а потом дать пользователю возможность перемещать опорные или промежуточные точки кривой до тех пор, пока она не будет завершена. При этом логично дать возможность перемещать и концы линии, а также менять ее стиль, т.е. свободно манипулировать незавершенной кривой. Для ее завершения будет использоваться кнопка Завершить (рис. 1.16).

Чтобы кривая была более дружественной для пользователя, мы не будем применять здесь растровые операции, а попытаемся нарисовать незавершенную кривую без искажения цветов. Для этого нужно хранить картинку с завершенными кривыми, и при выводе нового положения незавершенной кривой сначала выводить эту картинку, а потом поверх нее — незавершенную кривую в новом положении. Так как фон в нашем случае состоит только из нарисованных ранее кривых, то можно было бы просто хранить список, содержащий координаты и стиль каждой кривой, и при перерисовке фона сначала заливать всю форму фоновым цветом, а потом рисовать на ней каждую из этих кривых заново. Но рисование одной кривой — достаточно медленная операция, т.к. на основе кривой нужно создать траекторию, аппроксимировать ее отрезками и нарисовать каждый из них по отдельности с помощью LineDDA. При большом количестве кривых эта реакция на перемещение мыши будет занимать слишком много времени. Поэтому мы выберем другой метод: будет создан растр, содержащий все завершенные кривые, и при перерисовке формы этот растр будет просто копироваться на нее. Так как операции с растрами выполняются очень быстро, мерцания фона не будет. Чтобы незавершенная кривая также не мерцала, будет установлен режим двойной буферизации.

Рис. 1.16. Окно программы Bezier. Красные квадратики — области за которые можно перемещать концы и опорные точки незавершенной кривой

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

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

При нажатии кнопки Завершить незавершенная кривая рисуется уже не на самой форме, а на растре, содержащем фон. После этого кривая перестает существовать как кривая и становится набором пикселов на фоновой картинке, а программа вновь переходит в режим, когда нажатие кнопки мыши интерпретируется как создание новой кривой.

Реализацию интерактивной кривой в данном случае иллюстрирует листинг 1.61.

Листинг 1.61. Реализация интерактивной кривой

const

// чтобы перемещать точку кривой, пользователь должен попасть мышью

// в некоторую ее окрестность. Константа RectSize задает размер этой

// окрестности

RectSize = 3;

type

// Тип TDragPoint показывает, какую точку перемещает пользователь:

// ptNone — пользователь пытается тянуть несуществующую точку

// ptFirst - пользователь перемещает вторую точку "резиновой" прямой

// ptBegin - пользователь перемещает начало кривой

// ptInter1, ptInter2 - пользователь перемещает промежуточные точки

// ptEnd - пользователь перемещает конец кривой

TDragPoint = (dpNone, dpFirst, dpBegin, dpInter1, dpInter2, dpEnd);

TCurveForm = class(TForm)

BtnEnd: TButton;

RGroupType: TRadioGrour;

RGroupDrawMethod: TRadioGroup;

procedure FormCreate(Sender: TObject);

procedure FomMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

procedure FormMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

procedure FormPaint(Sender: TObject);

procedure BtnEndClick(Sender: TObject);

procedure RGroupTypeClick(Sender: TObject);

procedure FormDestroy(Sender: TObject);

private

// Если FNewLine = True, незавершённых кривых нет, и при нажатии на

// кнопку мыши начинает рисоваться новая кривая.

// Если FNewLine = False, есть незавершенная кривая, и нажатия мыши

// интерпретируются как попытки ее редактирования

FNewLine: Boolean;

// Поле FDragPoint указывает, какую точку перемещает пользователь

FDragPoint: TDragPoint;

// Поле FCurve хранит координаты незавершенной кривой

FCurve: TCurve;

// FBack - фоновый рисунок с завершенными кривыми

FBack: TBitmap;

// FCounter - счетчик точек, использующийся при рисовании отрезков

// с помощью LineDDA

FCounter: Integer;

// FDX, FDY - смещения относительно координаты точки кривой для

// рисования поперечной полосы

FDX, FDY: Integer;

// Функция PtNearPt возвращает True, если точка с координатами

// (X1, Y1) удалена от точки Pt по каждой из координат не более

// чем на RectSize

functionPtNearPt(X1, Y1: Integer; const Pt: TPoint): Boolean;

// Процедура DrawCurve рисует кривую по координатам FCurve вида,

// задаваемого RadioGroup.ItemIndex

procedure DrawCurve(Canvas: TCanvas);

end;

...

procedure TCurveForm.FormCreate(Sender: TObject);

begin

FNewLine := True;

FDragPoint := dpNone;

FBack := TBitmap.Create;

FBack.Canvas.Brush.Color := Color;

// Устанавливаем размер фонового рисунка равным размеру развернутого

// на весь рабочий стол окна

FBack.Width := GetSystemMetrics(SM_CXFULLSCREEN);

FBack.Height := GetSystemMetrics(SM_CYFULLSCREEN);

// Включаем режим двойной буферизации, чтобы незавершенная кривая

// не мерцала

DoubleBuffered := True;

end;

procedure TCurveForm.FormMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

begin

if Button = mbLeft then

begin

// Если незавершенных кривых нет, начинаем рисование новой кривой

if FNewLine then

begin

FDragPoint := dpFirst;

FCurve[0].X := X;

FCurve[0].Y := Y;

FCurve[3] := FCurve[0];

end

else

begin

// Если есть незавершенная кривая, определяем, в какую точку попал

// курсор мыши. Строго говоря, необходимо также запоминать,

// насколько отстоят координаты курсора мыши от координат

// контрольной точки, чтобы при первом перемещении не было скачка.

// Но т.к. окрестность точки очень мала, этот прыжок практически

// незаметен, и в данном случае этим можно пренебречь, чтобы

// не усложнять программу

if PtNearPt(X, Y, FCurve[0]) then FDragPoint := dpBegin

else if PtNearPt(X, Y, FCurve[1]) then FDragPoint := dpInter1

else if PtNearPt(X, Y, FCurve[2]) then FDragPoint : = dpInter2

else if PtNearPt(X, Y, FCurve[3]) then FDragPoint := dpEnd

else FDragPoint := dpNone;

end;

procedure TCurveForm.FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);

begin

if ssLeft in Shift then

begin

case FDragPoint of

dpFirst, dpEnd: begin

FCurve[3].X := X;

FCurve[3].Y := Y;

Refresh;

end;

dpBegin: begin

FCurve[0].X := X;

FCurve[0].Y := Y;

Refresh;

end;

dpInter1: begin

FCurve[1].X := X;

FCurve[1].Y := Y;

Refresh;

end;

dpInter2: begin

FCurve[2].X := X;

FCurve[2].Y := Y;

Refresh;

end;

procedure TCurve Form.FormMouseUp(Sender: TObject; Button: ТМouseButton; Shift: TShiftState; X, Y: Integer);

begin

// Если кнопка отпущена при отсутствии незавершенной кривой, значит,

// пользователь закончил рисование резиновой прямой, на основе которой

// нужно делать новую кривую

if (Button = mbLeft) and (FDragPoint = dpFirst) then

begin

FNewLine := False;

FDragPoint := dpNone;

// Промежуточные точки равномерно распределяем по прямой

FCurve[1].X := FCurve[0].X + Round((FCurve[3].X - FCurve[0].X) / 3);

FCurve[1].Y := FCurve[0].Y + Round((FCurve[3].Y - FCurve[0].Y) / 3);

FCurve[2].X := FCurve[0].X + Round(2 + (FCurve[3].X - FCurve[0].X) / 3);

FCurve[2].Y := FCurve[0].Y + Round(2 + (FCurve[3].Y - (Curve[0].Y) / 3);

Refresh;

end;

procedure TCurveForm.FormPaint(Sender: TObject);

var

I: Integer;

L: Extended;

begin

// Сначала выводим фон

Canvas.Draw(0, 0, FBack);

if FNewLine then

begin

// Если программа находится в режиме рисования резиновой прямой,

// рисуем прямую от точки FCurve[0] до FCurve[3]. Значение FCurve[1]

// и FCurve[2] на данном этапе игнорируется

if FDragPoint = dpFirst then

begin

FCounter := 0;

L :=

Sqrt(Sqr(FCurve[0].X - FCurve[3].X) +

Sqr(FCurve[0].Y - FCurve[3].Y));

if L > 0 then

begin

FDX := Round(4 * (FCurve[0].Y -FCurve[3].Y) / L);

FDY := Round(4 * (FCurve[3].X - FCurve[0].X) / L);

LineDDA(FCurve[0].X, FCurve[0].Y, FCurve[3].X, FCurve[3].Y,

@LineDrawFunc, Integer(Canvas));

end;

end

else

begin

// Если есть незавершённая кривая и установлен режим рисования

// по опорным точкам, выводим отрезки, показывающие касательные

// к кривой в её начале и конце

if RGroupDrawMethod.ItemIndex = 0 then

begin

Canvas.Pen.Style := psDot;

Canvas.Pen.Width := 3;

Canvas.Pen.Color := clDkGrey;

Canvas.MoveTo(FCurve[0].X, FCurve[0].Y);

Canvas.LineTo(FCurve[1].X, FCurve[1].Y);

Canvas.MoveTo(FCurve[3].X, FCurve[3].Y);

Canvas.LineTo(FCurve[2].X, FCurve[2].Y);

end;

// Рисуем красные квадраты, показывающие точки, которые пользователь

// может перемещать

Canvas.Pen.Style := psSolid;

Canvas.Pen.Width := 1;

Canvas.Pen.Color := clRed;

Canvas.Brush.Style := bsClear;

for I := 0 to 3 do

Canvas.Rectangle(FCurve[I].X - RectSize, FCurve[I].Y - RectSize,

FCurve[I].X + RectSize + 1, FCurve[I].Y + RectSize + 1);

end;

// функция PtNearPt возвращает True, если точка с координатами (X1, Y1)

// удалена от точки Pt по каждой из координат не более чем на RectSize

function TCurveForm.PtNearPt(X1, Yl: Integer; const Pt: TPoint): Boolean;

begin

Result :=

(X1 >= Pt.X - RectSize) and (X1 <= Pt.X + RectSize) and

(Y1 >= Pt.Y - RectSize) and (Y1 <= Pt.Y + RectSize);

end;

procedure TCurveForm.BtnEndClick(Sender: TObject);

begin

if not FNewLine then

begin

DrawCurve(FBack.Canvas);

FNewLine := True;

Refresh;

end;

Размеры фонового растра устанавливаются равными размеру развернутого на весь экран окна. Таким образом, если уменьшить окно, то те завершенные кривые, которые окажутся за его пределами, не пропадут — они вновь будут видимы, если увеличить размеры окна. Однако в программе не предусмотрено, что система позволяет пользователю менять разрешение экрана. Это можно учесть, добавив реакцию на сообщение WM_DISPLAYCHANGE и меняя в нем размеры фонового рисунка.

Назад: 1.2. Примеры использования Windows API

Дальше: Глава 2 Использование сокетов Delphi