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

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

Назад: 1.1.8. Обработка сообщений с помощью VCL

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

1.2.1. Пример EnumWnd

Программа EnumWnd представляет собой простой пример использования функций EnumWindows и EnumChildWindows, а также функций обратного вызова, которые необходимы для работы этих двух функций. Программа ищет все окна, созданные на данный момент в системе, и отображает их в виде дерева: каждый узел дерева соответствует одному окну, дочерние узлы соответствуют дочерним окнам данного окна (рис. 1.8).

Программа EnumWnd является также примером того, как можно работать с параметрами типа LPTSTR, через которые функции Windows API возвращают программе строковые значения. В разд. 1.1.13 были перечислены три способа создания буфера для работы с такими параметрами: выделение памяти в стеке в виде массива элементов типа Char, использование строк типа string и строк типа PChar. Все три способа реализованы в примере EnumWnd. На главной и единственной форме программы EnumWnd размещены два компонента: TreeWindow типа TTreeView и кнопка BtnBuild. Обработчик нажатия кнопки выглядит очень лаконично (листинг 1.21).

Листинг 1.21. Обработчик нажатия кнопки BtnBuild

procedure TFomWindows.BtnBuildClick(Sender: TObject);

begin

Screen.Cursor := crHourGlass;

try

TreeWindows.Items.Clear;

EnumWindows(@EnumWindowsProc, 0);

finally

Screen.Cursor := crDefault;

end;

Рис. 1.8. Окно программы EnumWnd

Все, что делает этот обработчик, — это очищает компонент TreeWindows и вызывает EnumWindows, передавая ей функцию обратного вызова EnumWindowsProc, в которой и выполняется основная работа. Сразу отметим, что в этом примере мы будем использовать одну и ту же функцию обратного вызова как для EnumWindows, так и для EnumWindowsProc. Сама функция обратного вызова выглядит следующим образом (листинг 1.22).

Листинг 1.22. Функция обратного вызова EnumWindowsProc (первый вариант)

// Это функция обратного вызова, которая будет

// использоваться при вызове EnumWindows и EnumChildWindows.

// Тип второго параметра не совпадает с типом, который

// указан MSDN. Однако TTreeNode, как и любой класс,

// является указателем, поэтому может использоваться везде,

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

// уровне между ними нет разницы. Указатель на функцию

// обратного вызова в EnumWindows и EnumChildWindows в

// модуле Windows.dcu объявлен как нетипизированный

// указатель, поэтому компилятор не контролирует

// соответствие реального прототипа заявленному.

function EnumWindowsProc(Wnd: HWND; ParentNode: TTreeNode): Bool; stdcall;

// Система не предусматривает возможности узнать, какова

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

// приходится выделять буфер большой длины в надежде, что

// имя класса не окажется еще длиннее. В данном примере

// размер этого буфера определяется константой ClassNameLen.

// Крайне маловероятно, что имя класса скажется длиннее,

// чем 511 символов (512-й зарезервирован для завершающего

// нулевого символа).

const

ClassNameLen = 512;

var

// Здесь будет храниться заголовок окна

Text: string;

TextLen: Integer;

// Это - буфер для имени класса

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

Node: TTreeNode;

NodeName: string;

begin

Result := True;

// Функция EnumChildWindows перечисляет не только

// непосредственно дочерние окна данного окна, но и

// дочерние окна его дочерних окон и т.п. Но при

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

// прямые потомки, поэтому все окна, не являющиеся прямыми

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

if Assigned(ParentNode) and (GetParent(Wnd) <> HWND(ParentNode.Data)) then Exit;

// Получаем длину заголовка окна. Вместо функций

// GetWindowText и GetWindowTextLength мы здесь

// используем сообщения WM_GETTEXT и WM_GETTEXTLENGTH,

// потому что функции, в отличие от сообщений, не

// умеют работать с элементами управления,

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

TextLen := SendMessage(Wnd, WM_GETTEXTLENGTH, 0, 0);

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

// будет служить буфером для заголовка окна.

// Использование SetLength гарантирует, что будет

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

// будет других ссылок.

SetLength(Text, TextLen);

// Если заголовок окна - пустая строка, TextLen будет

// иметь значение 0, и указатель Text при выполнении

// Set Length получит значение nil. Но при обработке

// сообщения WM_GETTEXT оконная процедура в любом случае

// попытается записать строку по переданному адресу,

// даже если заголовок окна пустой - в этом случае в

// переданный буфер будет записан один символ -

// завершающий ноль. Но если будет передан nil, то

// попытка записать что-то в такой буфер приведет к

// Access violation, поэтому отправлять окну WM_GETTEXT

// можно только в том случае, если TextLen > 0.

if TextLen > 0 then

SendMessage(Wnd, WM_GETTEXT, TextLen + 1, LParam (Text));

// Заголовок окна может быть очень длинным - например, в

// Memo заголовком считается весь текст, который там

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

// при добавлении в TTreeView узлов с очень длинным

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

// запущенная из Delphi, вылетает в отладчик (при

// запуске вне среды Delphi проблем не замечено). Чтобы

// этого не происходило, слишком длинные строки

// обрезаются.

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 + ')';

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

// Записываем в данные узла дескриптор соответствующего

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

// потомки.

Node.Data := Pointer(Wnd);

// Вызываем EnumChildWindows, передавая функцию

// EnumWindowsProc в качестве параметра, а указатель на

// созданный узел - в качестве параметра этой функции.

// При этом EnumWindowsProc будет вызываться из

// EnumChildWindows, т.е. получается рекурсия.

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

end;

Как мы помним, первый параметр функции обратного вызова для EnumWindows содержит дескриптор найденного окна, а второй параметр может быть произвольным 4-байтным значением, которое система игнорирует, просто копируя сюда то значение, которое было передано при вызове EnumWindows или EnumChildWindows. Мы задействуем этот параметр для передачи ссылки на узел дерева, соответствующий родительскому окну. Также договоримся, что в свойство Data каждого узла будем записывать дескриптор связанного с ним окна. Для окон верхнего уровня ссылка будет иметь значение nil — это обеспечивается тем, что при вызове EnumWindows второй параметр равен нулю (см. листинг 1.21).

Работа функции начинается с проверки того, что родительским окном для данного окна действительно является то окно, чей дескриптор связан с узлом родительского окна. Эта проверка нужна потому, что функция EnumChildWindows перечисляет не только дочерние, но и "внучатые", "правнучатые" и т.д. окна. Нам здесь это не нужно, на каждом шаге нас интересуют только непосредственные "дети" окна, а до "внуков" мы доберемся, когда вызовем EnumChildWindows для дочерних окон, поэтому и отсеиваем лишнее.

Следующий шаг — получение заготовка окна. Для этого мы используем сообщение WM_GETTEXT (разница между этим сообщением и функцией GetWindowText обсуждается в разд. 1.3.1). Буфером является переменная Text типа string. Сначала с помощью сообщения WM_GETTEXTLENGTH мы узнаем длину заголовка окна, а затем выделяем под строку Text требуемое количество памяти с помощью SetLength. После этого можно получить строку с помощью сообщения WM_GETTEXT. Второй параметр этого сообщения — адрес буфера, в который будет помещена строка. Так как переменная типа string и есть указатель на буфер строки (это детально обсуждается в разд. 3.3), достаточно просто привести переменную Text к типу LParam и передать получившееся значение.

Примечание

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

Далее получаем название класса окна. Для этого мы используем статический массив ClassName, т.е. размер буфера определяется на этапе компиляции. С одной стороны, это неправильно, потому что ограничений на длину имени класса не существует (по крайней мере, в документации они не упомянуты), а мы уже говорили, что такой метод следует применять только тогда, когда существует известное на этапе компиляции ограничение длины. По с другой стороны, когда речь идет об имени класса, не существует ничего подобного сообщению WM_SETTEXTLENGTH, т.е. API не дает возможности получить длину имени класса, что делает бессмысленными все манипуляции с размером буфера во время работы программы. Поэтому мы определяем размер буфера еще на этапе компиляции, исходя из того, что слишком уж длинные имена классов встречаются редко. При вызове функции с параметром типа LPTSTR можно просто передавать массив без приведения типа, т.к. LPTSTR — это PChar, а массивы символов Char, индексирующиеся с нуля, компилятор полагает совместимыми с этим типом и все необходимые преобразования делает неявно.

И, хотя мы и взяли размер буфера с хорошим запасом, нельзя исключать ситуации, когда имя класса окажется длиннее, чем буфер. Ничего страшного при этом не произойдет, т.к. мы передаем в функцию размер буфера специально для того, чтобы она не пыталась что-то записать за пределами буфера. Но в этом случае завершающий строку символ #0 не попадет в буфер, и при попытке дальше работать с этой строкой какая-нибудь другая функция может, не найдя конца строки в пределах буфера, попытаться поискать этот конец за его пределами, что приведет к непредсказуемым результатам. Поэтому на всякий случай записываем #0 в последний символ буфера. Если имя класса оказалось длиннее буфера, это обрежет строку по границе буфера, а если короче, то это ничему не повредит, т.к. признак конца строки будет в буфере где-то раньше, а все символы после него все равно игнорируются. После этого остается только создать новый элемент в дереве, а чтобы заполнить его дочерние элементы — вызвать EnumChildWindows для получения списка дочерних окон. Так как в EnumChildWindows передается та же функция обратного вызова, получается рекурсия, которая останавливается тогда, когда функция доходит до окна, не имеющего дочерних окон. Ранее мы говорили, что программа EnumWnd демонстрирует три метода получения строки через параметр типа LPTSTR, но пока мы увидели только два (действительно, трудно показать три различных метода на примере получения двух строк). Чтобы показать третий вариант — организацию буфера через строки типа PChar — перепишем функцию EnumWindowsProc (листинг 1.23). В исходном коде программы EnumWnd этот вариант присутствует в виде комментария. Можно убрать этот комментарий, а закомментировать, наоборот, первый вариант, чтобы попробовать, как работает получение строки с помощью PChar.

Листинг 1.23. Функция обратного вызова EnumWindowsProc (второй вариант)

// Ниже приведен другой вариант функции

// EnumWindowsРrос, который отличается от предыдущего тем,

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

// вручную с помощью переменной типа PChar, а не string. По

// своим функциональным возможностям оба варианта равноценны.

function EnumWindowsProc(Wnd: HWND; ParentNode: TTreeNode): Bool; stdcall;

const

ClassNameLen = 512;

var

TextLen: Integer;

Text: PChar;

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

Node: TTreeNode;

NodeName: string;

begin

Result := True;

if Assigned(ParentNode) and (GetParent(Wnd) <> HWND(ParentNode.Data)) then Exit;

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

// получаемой через WM_GETTEXTLENGTH, добавляется

// единица, потому что нужно вручную учесть добавочный

// байт для завершающего нуля.

TextLen := SendMessage(Wnd, WM_GETTEXTLENGTH, 0, 0) + 1;

// Выделяем требуемое количество памяти. Так как

// компилятор не освободит эту памяти автоматически,

// необходимо использовать блок try/finally, иначе будут

// утечки памяти при исключениях.

Text := StrAlloc(TextLen);

try

// Так как для буфера даже при пустом заголовке будет

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

// WM_GETTEXT, не проверяя длину строки, как это было

// в предыдущем варианте - буфер всегда будет

// корректным.

SendMessage(Wnd, WM_GETTEXT, TextLen, LParam(Text));

// Обрезаем слишком длинною строку. Модифицировать

// PChar сложнее, чем string. Вставка нуля в середину

// строки приводит к тому, что все API-функции будут

// игнорировать "хвост", но на работу StrDispose это не

// повлияет, т.к. функция StrAlloc (а также прочие

// функции выделения памяти для нуль-терминированных

// строк модуля SysUtils) сохраняет размер выделенной

// памяти рядом с самой строкой, и StrDispose

// ориентируется именно на этот размер, а не на

// завершающий ноль.

if TextLen > 104 then

begin

(Text + 104)^ := #0;

(Text + 103)^ := '.';

(Text + 102)^ := '.';

(Text + 101)^ := '.';

(Text + 100)^ := ' ';

end;

GetClassName(Wnd, ClassName, ClassNameLen);

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

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

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

Node.Data := Pointer(Wnd);

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

finally

// Вручную освобождаем память, выделенную для буфера

StrDispose(Text);

end;

Второй вариант функции EnumWindowsProc отличается от первого только тем что для организации буфера для получения имени окна вместо переменной типа string используется переменная типа PChar. Соответственно, все манипуляции с динамической памятью теперь выполняются вручную, а просто отсечь конец слишком длинной строки и прибавить к результату другую строку (многоточие) мы не можем, приходится модифицировать строку посимвольно. Тем не менее видно, что и с помощью типа PChar задача создания буфера для строки, возвращаемой API-функцией, достаточно легко решается.

1.2.2. Пример Line

Пример Line представляет собой невизуальный компонент TLine, который перехватывает оконные сообщения своего владельца (владельца в терминах VCL, разумеется, раз речь идет о неоконном компоненте). Компонент TLine рисует на своем владельце линию из точки (StartX, StartY) в точку (EndX, EndY) цветом Color. Пользователь может перемещать концы линии мышью. Достаточно разместить компонент TLine на форме, и на ней появится линия, которую пользователь может перемещать как во время проектирования формы, так и во время выполнения программы. Можно также разместить на форме, например, панель, и сделать ее владельцем компонента TLine — тогда линия будет рисоваться на панели. Но это можно сделать только во время исполнения программы, потому что владельцем всех компонентов, созданных во время проектирования формы, становится сама форма. Чтобы установить компонент, нужно выполнить следующие действия:

1. Переписать с компакт-диска файлы Line.pas и Line.dcr в папку, где вы храните компоненты. Если такой папки еще нет, самое время создать ее. Где именно она будет расположена, значения не имеет, выбирайте любое удобное для вас место. Главное — это прописать эту папку в путях, где Delphi ищет компоненты. Чтобы сделать это в Delphi 7 и более ранних версиях, откройте меню Tools\Environment Options, в появившемся диалоговом окне выберите закладку Library и добавьте свою папку в поле Library path. В BDS 2006 и выше откройте меню Tools\Options, в появившемся диалоговом окне в дереве в левой части выберите пункт Environment Options\Delphi Options\Library — Win32 и добавьте папку в поле Library path.

2. Создайте новый пакет (меню File\New\Other, в открывшемся окне выбрать Package). После этого в Delphi 7 и более ранних версиях откроется небольшое окно пакета. В BDS 2006 и более поздних версиях окно не откроется, но пакет появится в группе проектов (по умолчанию это окно Project Manager в правом верхнем углу главного окна). Сохраните пакет в ту же папку, где находится Line.pas, под любым именем, кроме Line (иначе будет конфликт имен).

3. Добавьте в пакет файл Line.pas. В BDS 2006 для этого необходимо с помощью правой кнопки мыши вызвать контекстное меню пакета в окне Project Manager и выбрать там пункт Add. В Delphi 7 и более ранних версиях в окне пакета нужно нажать кнопку Add.

4. Установите компонент. В BDS 2006 и выше для этого следует выбрать пункт Install в контекстном меню проекта, а в Delphi 7 и более ранних версиях — нажать кнопку Install в окне пакета. После этого в палитре компонентов у вас появится вкладка Delphi Kingdom Samples, a в ней — компонент TLine.

Если вы не хотите помещать компонент TLine в палитру компонентов (или у вас Turbo Delphi Explorer, и вы просто не имеете такой возможности), можно воспользоваться проектом LineSample, который во время выполнения создаёт два экземпляра TLine, владельцем одного из которых является форма, другого — панель.

Перехват сообщения владельца осуществляется путем изменения его свойства WindowProc — записи в него указателя на свой обработчик сообщений. Здесь можно применить один хитрый прием. Компонент TLine не имеет своей оконной процедуры, т.к., будучи прямым наследником класса TComponent, окном не является. Но метод Dispatch у него есть, поскольку он объявлен в классе TObject. В классе TComponent и в его предках метод Dispatch никогда не вызывается. Если мы напишем обработчик сообщений таким образом, что он будет передавать сообщения методу Dispatch, то сможем в нашем компоненте создавать свои методы для обработки сообщений, в которые метод Dispatch при необходимости будет передавать сообщения для обработки. Необработанные сообщения при этом будут передаваться в метод DefaultHandler, который у класса TComponent ничего не делает. Если мы перекроем DefaultHandler так, чтобы он вызывал оригинальный обработчик сообщений родителя, то все необработанные сообщения пойдут туда. Более того, вызов inherited из методов-обработчиков сообщений тоже будет приводить к вызову оригинального обработчика родителя, т.к. в данном случае inherited при отсутствии унаследованного обработчика приводит к вызову DefaultHandler. В листинге 1.24 показано объявление класса TLine и код его методов, относящихся к перехвату сообщений.

Листинг 1.24. Базовая часть класса TLine

type

TLine = class(TComponent)

private

// FCoords хранит координаты линии. Начало линии

// находится в точке (FCoords[0], FCoords[1]),

// конец - в (FCoords[2], FCoords[3]).

FCoords:array[0..3] of Integer;

// Конструктор класса написан так, что владельцем TLine

// может стать только TWinControl или его наследник.

// Но свойство Owner имеет тип TComponent, поэтому при

// использовании свойств и методов класса TWinControl

// Owner придется каждый раз приводить к типу

// TWinControl. Чтобы избежать приведений типа,

// используется поле FWinOwner. Оно указывает на тот же

// объект, что и Owner, но имеет тип TWinControl.

FWinOwner: TWinControl;

// Здесь хранится адрес обработчика сообщений, бывший до

// перехвата.

FOldProc: TWndMethod;

// Цвет линии

FColor: TColor;

// Состояние линии. Если FStartMoving = True, в данный

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

// FEndMoving = True - ее конец.

FStartMoving, FEndMoving: Boolean;

// Если FDrawLine = False, линия не рисуется. Это

// используется, когда нужно стереть линию.

FDrawLine: Boolean;

procedure WMPaint(var Msg: TWMPaint); message WM_PAINT;

procedure WMLButtonDown(var Msg: TWMLButtonDown); message WM_LBUTTONDOWN;

procedure WMLButtonUp(var Msg: TWMButtonUp); message WM_LBUTTONUP;

procedure WMMouseMove(var Msg: TWMMouseMove); message WM_MOUSEMOVE;

procedure SetColor(Value: TColor);

procedure SetCoord(Index, Value: Integer);

protected

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

// владельца

procedure HookOwnerMessage(var Msg: Message);

public

constructor Create(AOwner: TComponent); override;

destructor Destroy; override;

procedure DefaultHandler(var Msg); override;

published

property Color: TColor read FColor write SetColor default clWindowText;

property StartX: Integer index 0 read FCoords[0] write SetCoord default 10;

property StartY: Integer index 1 read FCoords[1] write SetCoord default 10;

property EndX: Integer index 2 reed FCoords[2] write SetCoord default 50;

property EndY: Integer index 3 read FCoords[3] write SetCoord default 50;

end;

...

constructor TLine.Create(AOwner: TComponent);

begin

if not Assigned(AOwner) then raise EWrongOwner.Create(

'Должен быть назначен владелец компонента TLine');

if not (AOwner is TWinControl) then raise EWrongOwner.Create(

'Владелец компонента TLine должен быть наследником TWinControl');

FWinOwner := AOwner as TWinControl;

inherited;

FCoords[0] := 10;

FCoords[1] := 10;

FCoords[2] := 50;

FCoords[3] := 50;

FColor := clWindowText;

FStartMoving := False;

FEndMoving := False;

FDrawLine := True;

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

// назначаем новый.

FOldProc := FWinOwner.WindowProc;

FWinOwner.WindowProc := HookOwnerMessage;

FWinOwner.Refresh;

end;

destructor TLine.Destroy;

begin

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

FWinOwner.WindowProc := FOldProc;

FWinOwner.Refresh;

inherited;

end;

procedure TLine.HookOwnerMessage(var Msg: TMessage);

begin

// Единственное, что делает перехватчик сообщений -

// передает их методу Dispatch. Было бы оптимальнее

// назначить обработчиком сообщений сам метод Dispatch,

// но формально он имеет прототип, несовместимый с

// типом TWndMethod, поэтому компилятор не разрешает

// подобное присваивание. Фактически же Dispatch

// совместим с TWndMethod, поэтому, используя хакерские

// методы, можно было бы назначить обработчиком его и

// обойтись без метода HookOwnerMessage. Но хакерские

// методы - вещь небезопасная, они допустимы только

// тогда, когда других средств решения задачи нет.

Dispatch(Msg);

end;

procedure TLine.DefaultHandler(var Msg);

begin

FOldProc(TMessage(Msg));

end;

Собственно рисование линии на поверхности владельца обеспечивает метод WMPaint (листинг 1.25).

Листинг 1.25. Метод WMPaint

procedure TLine.WMPaint(var Msg: TWMPaint);

var

NeedDC: Boolean;

PS: TPaintStruct;

Pen: HPEN;

begin

if FDrawLine then

begin

// Проверка, был ли DC получен предыдущим обработчиком

NeedDC := Msg.DC = 0;

if NeedDC then Msg.DC := BeginPaint(FWinOwner.Handle, PS);

inherited;

Pen := CreatePen(PS_SOLID, 1, ColorToRGB(FColor));

SelectObject(Msg.DC, Pen);

MoveToEx(Msg.DC, FCoords[0], FCoords[1], nil);

LineTo(Msg.DC, FCoords[2], FCoords[3]);

SelectObject(Msg.DC, GetStockObject(BLACK_PEN));

DeleteObject(Pen);

if NeedDC then EndPaint(FWinOwner.Handle, PS);

end

else inherited;

end;

Поскольку рисуется простая линия, мы не будем здесь создавать экземпляр TCanvas и привязывать его к контексту устройства, обойдемся вызовом функций GDI. Особенности работы с контекстом устройства при перехвате сообщения WM_PAINT описаны в разд. 1.2.4.

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

Листинг 1.26. Обработка сообщений мыши

procedure TLine.WMLButtonDown(var Msg: TWMLButtonDown);

var

DC: HDC;

OldMode: Integer;

begin

if PTInRect(Rect(FCoords[0] - 3, FCoords[1] - 3, FCoords[0] + 4, FCoords[1] + 4), Point(Msg.XPos, Msg.YPos)) then

begin

FStartMoving := True;

FDrawLine := False;

FWinOwner.Refresh;

FDrawLine := True;

DC := GetDC(FWinOwner.Handle);

OldMode := SetROP2(DC, R2_NOT);

SelectObject(DC, GetStockObject(BLACK_PEN));

MoveToEx(DC, FCoords[0], FCoords[1], nil);

LineTo(DC, FCoords[2], FCoords[3]);

SetROP2(DC, OldMode);

ReleaseDC(FWinOwner.Handle, DC);

SetCapture(FWinOwner.Handle);

Msg.Result := 0;

end

else

if PTInRect(Rect(FCoords[2] - 3, FCoords[3] - 3, FCoords[2] + 4, FCoords[3] + 4), Point(Msg.XPos, Msg.YPos)) then

begin

FEndMoving := True;

FDrawLine := False;

FWinOwner.Refresh;

FDrawLine := True;

DC := GetDC(FWinOwner.Handle);

OldMode := SetROP2(DC, R2_NOT);

SelectObject(DC, GetStockObject(BLACK_PEN));

MoveToEx(DC, FCoords[0], FCoords[1], nil);

LineTo(DC, FCoords[2], FCoords[3]);

SetROP2(DC, OldMode);

ReleaseDC(FWinOwner.Handle, DC);

SetCapture(FWinOwner.Handle);

Msg.Result := 0;

end

else inherited;

end;

procedure TLine.WMLButtonUp(var Msg: TWMLButtonUp);

begin

if FStartMoving then

begin

FStartMoving := False;

ReleaseCapture;

FWinOwner.Refresh;

Msg.Result := 0;

end

else if FEndMoving then

begin

FEndMoving := False;

ReleaseCapture;

FWinOwner.Refresh;

Msg.Result := 0;

end

else inherited;

end;

procedure TLine.WMMouseMove(var Мsg: TWMMouseMove);

var

DC: HDC;

OldMode: Integer;

begin

if FStartMoving then

begin

DC := GetDC(FWinOwner.Handle);

OldMode := SetROP2(DC, R2_NOT);

SelectObject(DC, GetStockObject(BLACK_PEN));

MoveToEx(DC, FCoords[0], FCoords[1], nil);

LineTo(DC, FCoords[2], FCoords[3]);

FCoords[0] := Msg.XPos;

FCoords[1] := Msg.YPos;

MoveToEx(DC, FCoords[0], FCoords[1], nil);

LineTo(DC, FCoords[2], FCoords[3]));

SetROP2(DC, OldMode);

ReleaseDC(FWinOwner.Handle, DC);

Msg.Result := 0;

end

else if FEndMoving then

begin

DC := GetDC(FWinOwner.Handle);

OldMode := SetROP2(DC, R2_NOT);

SelectObject(DC, GetStockObject(BLACK_PEN));

MoveToEx(DC, FCoords[0], FCoords[1], nil);

LineTo(DC, FCoords[2], FCoords[3]);

FCoords[2] := Msg.XPos;

FCoords[3] := Msg.YPos;

MoveToEx(DC, FCoords[0], FCoords[1], nil);

LineTo(DC, FCoords[2], FCoords[3]);

SetROP2(DC, OldMode);

ReleaseDC(FWinOwner.Handle, DC);

Msg.Result := 0;

end

else inherited;

end;

Здесь реализован инверсный способ создания "резиновой" линии, когда при рисовании линии все составляющие ее пикселы инвертируются, а при стирании инвертируются еще раз. Этот способ подробно описан в разд. 1.3.4.2. Перехват сообщений родителя — дело относительно простое, гораздо хуже обстоят дела с удалением компонента, перехватившего сообщения родителя. Пока такой компонент один, проблем не возникает, но когда их несколько приходится обращаться с ними очень аккуратно. Рассмотрим, например, такой код (листинг 1.27).

Листинг 1.27. Пример кода, вызывающего ошибку

Line1 := TLine.Create(Form1);

Line2 := TLine.Create(Form2);

...

Line1.Free;

...

Line2.Free;

Проанализируем, что происходит при выполнении этого кода. Для простоты предположим, что других компонентов, перехватывающих сообщения, здесь нет, и перед выполнением этого кода Form1.WindowProc ссылается на Form1.WndProc, т.е. на собственный обработчик сообщений формы. При создании объекта Line1 он перехватывает обработчик, и Form1.WindowProc начинает ссылаться на Line1.HookOwnerMessage, а ссылка на Form1.WndProc сохраняется в Line1.FOldProc. Объект Line2 также перехватывает обработчик сообщений, и после его создания Form1.WindowProc будет ссылаться на Line2.HookOwnerMessage, a Line2.FOldProc — на Line1.HookOwnerMessage.

Теперь удалим Line1. При удалении объект восстановит ссылку на тот обработчик сообщений, который был установлен на момент его создания, т.е. Form1.WindowProc вновь станет указывать на Form1.WndProc. Соответственно, компонент Line2 потеряет способность реагировать на сообщения владельца. Поле Line2.FOldProc при этом останется без изменений. Но самое неприятное начнется при удалении объекта Line2. Он тоже восстановит ссылку на обработчик, который был назначен на момент его создания, т.е. запишет в свойство Form1.WindowProc ссылку на Line1.HookOwnerMessage. Но поскольку объекта Line1 уже не существует, это будет ссылка в никуда, и обработка первого же сообщения, пришедшего форме, даст ошибку Access violation.

Примечание

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

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

1.2.3. Пример CoordLabel

CoordLabel — это пример визуального компонента, перехватывающего сообщения своего родителя. Компонент TCoordLabel отслеживает нажатие левой кнопки мыши на своем родителе и отображает координаты точки, в которой произошло нажатие. Для перехвата сообщений родителя используется тот же способ через свойство WindowProc, что и в предыдущем примере, но т.к. теперь перехватываются сообщения родителя, а не владельца, появляются некоторые нюансы.

Установка компонента TCoordLabel полностью аналогична установке компонента TLine из предыдущего раздела. На прилагаемом компакт-диске находится также проект LineCoordSample для того, чтобы работу компонента можно было увидеть без установки в палитру компонентов. На форме проекта LineCoordSample находится панель, кнопка Переместить и компонент TLineCoordSample, который по нажатию кнопки меняет родителя с формы на панель и обратно.

Код компонента TCoordLabel приведен в листинге 1.28.

Листинг 1.28. Компонент TCoordLabel

type

TCoordLabel = class(TLabel)

private

// Здесь хранится адрес обработчика

// сообщений, бывший до перехвата.

FOldProc: TWndMethod;

protected

procedure SetParent(AParent: TWinControl); override;

// Этот метод будет новым обработчиком

// сообщений владельца

procedure HookParentMessage(var Msg: TMessage);

end;

...

procedure TCoordLabel.SetParent(AParent: TWinControl);

begin

if Assigned(Parent) and Assigned(FOldProc) then Parent.WindowProc := FOldProc;

inherited;

if Assigned(Parent) then

begin

FOldProc := Parent.WindowProc;

Parent.WindowProc := HookParentMessage;

end;

procedure TCoordLabel.HookParentMessage(var Msg: TMessage);

begin

if Msg.Msg = WM_LBUTTONDOWN then

Caption := '(' + IntToStr(Msg.LParamLo) + ', ' + IntToStr(Msg.LParamHi) + ')';

FOldProc(Msg);

end;

Класс TLabel, предок TCoordLabel, является визуальным компонентом и сам может получать и обрабатывать сообщения, поэтому метод Dispatch у него уже "занят". Соответственно, мы не можем диспетчеризовать с его помощью перехваченные сообщения и должны обрабатывать их внутри метода HookParentMessage.

Сам перехват осуществляется не в конструкторе, т.к. на момент вызова конструктора родитель компонента еще неизвестен. Он устанавливается позже, через свойство Parent, которое приводит к вызову виртуального метода SetParent. Мы перекрываем этот метод и выполняем в нем как восстановление обработчика старого родителя, так и перехват сообщений нового. Это позволяет компоненту менять родителя во время работы программы. Писать отдельно деструктор для восстановления оригинального обработчика родителя в данном случае нужды нет, поскольку деструктор, унаследованный от TControl, содержит вызов метода SetParent с параметром nil. Так как мы уже перекрыли SetParent, это приведет к восстановлению оригинального обработчика, т.е. к тому, что нам нужно.

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

1.2.4. Пример PanelMsg

Программа PanelMsg показывает, как можно перехватить оконные сообщения, поступающие компоненту, лежащему на форме. В данном случае этим компонентом будет TPanel. Для перехвата сообщений используется свойство WindowProc панели.

Мы будем обрабатывать два сообщения, приходящих с панели: WM_RBUTTONDBLCLK и WM_PAINT. Таким образом, наша панель получит возможность реагировать на двойной щелчок правой кнопки мыши, а также рисовать что-то на своей поверхности. С помощью одной только библиотеки VCL это сделать нельзя.

Примечание

Для рисования на поверхности панели, вообще говоря, существует более простой и правильный способ: нужно положить на панель компонент TPaintBox, растянуть его на всю область панели и рисовать в его событии OnPaint. Мы здесь используем более сложный способ перехвата сообщения WM_PAINT только в учебных целях.

При перехвате сообщения WM_PAINT любого компонента, на котором расположены неоконные визуальные компоненты, может возникнуть проблема с перерисовкой этих компонентов. Чтобы продемонстрировать способ решения этих проблем, разместим на панели компонент TLabel, который заодно будет показывать пользователю реакцию на двойной щелчок правой кнопкой мыши. В результате получается окно, показанное на рис. 1.9. При двойном щелчке правой кнопкой мыши на панели надпись Сделайте двойной щелчок правой кнопкой перемещается в то место, где находится курсор. Чтобы перехватить оконную процедуру панели, следует написать метод, который ее подменит, а адрес старого метода сохранить в предназначенном для этого поле. Сам перехват будем осуществлять в обработчике события OnCreate формы (листинг 1.29).

Рис. 1.9. Окно программы PanelMsg

Листинг 1.29. Перехват обработчика сообщений панели

type

TForm1 = class(TForm)

Panel: TPanel;

Label1: TLabel;

procedure FormCreate(Sender: TObject);

private

// Здесь будет храниться исходный обработчик сообщений

// панели

FOldPanelWndProc: TWndMethod;

// Этот метод будет перехватывать сообщения,

// предназначенные панели

procedure NewPanelWndProc(var Msg: TMessage);

end;

...

procedure TForm1.FontCreate(Sender: TObject);

begin

FOldPanelWndProc := Panel.WindowProc;

Panel.WindowProc := NewPanelWndProc;

end;

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

Листинг 1.30. Метод-перехватчик сообщений панели

procedure TForm1.NewPanelWndProc(var Msg: TMessage);

var

NeedDC: Boolean;

PS: TPaintStruct;

PanelCanvas: TCanvas;

begin

if Msg.Msg = WM_RBUTTONDBLCLK then

begin

Label1.Left := Msg.LParamLo;

Label1.Top := Msg.LParamHi;

Msg.Result := 0;

end

else if Msg.Msg = WM_PAINT then

begin

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

// обработчиком, стоящим раньше по цепочке, и если не

// был, то запрашиваем его.

NeedDC := Msg.WParam = 0;

if NeedDC then Msg.WParam := BeginPaint(Panel.Handle, PS);

// Вызываем старый обработчик WM_PAINT. Его нужно

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

// на поверхности что-то свое, т.к. в противном случае

// это что-то будет закрашено стандартным обработчиком.

POldPanelWndProc(Msg);

// При использовании графических функций API самое

// неудобное - это вручную создавать и уничтожать кисти,

// карандаш и т.п. Поэтому здесь создается экземпляр

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

// с дескриптором, полученным при вызове BeginPaint.

PanelCanvas := TCanvas.Create;

try

PanelCanvas.Handle := Msg.WParam;

FanelCanvas.Pen.Style := psClear;

PanelCanvas.Brush.Style := bsSolid;

PanelCanvas.Brush.Color := clWhite;

PanelCanvas.Ellipse(10, 10, Panel.Width - 10, Panel.Height - 10);

PanelCanvas.Brush.Color := clYellow;

PanelCanvas.Rectangle(100, 100, Panel.Width - 100, Panel.Height - 100);

finally

PanelCanvas.Free;

end;

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

// компонент TLabel. Отрисовка неоконных компонентов

// происходит при обработке WM_PAINT родительского

// компонента, т.е. здесь она была выполнена при вызове

// стандартного обработчика. Таким образом, сделанный

// рисунок закрасил не только фон панели, но и

// неоконные компоненты. Чтобы компоненты были поверх

// рисунка, их приходится перерисовывать еще раз,

// вызывая protected-метод PaintControls. Это не очень

// эффективно, т.к. получается, что компоненты рисуются

// дважды: в стандартном обработчике и здесь. Но

// другого способа решить проблему, видимо, нет. Если

// бы на панели лежали только оконные компоненты,

// вызывать PaintControls не понадобилось, поскольку то, что

// мы рисуем на панели, не может затереть поверхность

// лежащих на этой панели других окон.

TFakePanel(Panel).PaintControls(Msg.WParam, nil);

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

// освободить его.

if NeedDC then

begin

EndPaint(Panel.Handle, PS);

Msg.WParam := 0;

end;

end

else FOldPanelWndProc(Msg);

end;

Так как в наш обработчик поступают все сообщения, передающиеся в оконную процедуру панели, начинается он с проверки того, какое сообщение пришло. Сначала реализуем реакцию на WM_RBUTTONDBLCLK просто перемещаем метку Label1 на то место, где пользователь щелкнул мышью. Затем обнуляем результат, давая понять системе, что сообщение полностью обработано. Вызов унаследованного обработчика в данном случае не выполняем, потому что никакая унаследованная реакция на данное событие нам не нужна. Обработка сообщения WM_PAINT сложнее. Сначала необходимо разобраться с контекстом устройства, на котором будет производиться рисование. Вообще говоря, обработчик WM_PAINT должен получать этот контекст с помощью функции BeginPaint. Но если до написанного нами кода сообщение WM_PAINT уже начало обрабатываться, то контекст устройства уже получен, а вызывать BeginPaint два раза нельзя. В этом случае контекст устройства передаётся через параметр сообщения WParam. Соответственно, обработка сообщения WM_PAINT начинается с того, что мы проверяем, равен ли нулю параметр wParam, и если равен, то получаем контекст устройства, а если не равен, используем то, что передано.

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

Примечание

Перекрывая обработку сообщения WM_PAINT, мы лишаем код VCL возможности полностью контролировать процесс перерисовки. В частности, это означает что значение свойства DoubleBuffered будет игнорироваться, двойной буферизации не будет. Поэтому еще раз напоминаем, что программа PanelMsg — это учебный пример, помогающий разобраться с механизмами взаимодействия VCL и Windows API, но не являющийся образцом для подражания. Если в реальной жизни потребуется рисовать что-то непосредственно на панели, нужно порождать от класса TPanel наследника и перекрывать в нем метод Paint.

Теперь можно нарисовать что-то свое. Здесь мы рисуем большой белый круг, а на его фоне — желтый прямоугольник. Для этого используем класс TCanvas способом, который был продемонстрирован в листинге 1.17 (см. разд. 1.1.11). Если бы мы остановились на этом, то увидели бы интересную картину: нарисованные фигуры лежат поверх текста метки Label1. Объяснение этому очень простое: метка является неоконным визуальным компонентом и рисуется на поверхности своего родительского компонента при обработке его сообщения WM_PAINT. А поскольку стандартный обработчик у нас вызывается до того, как рисуются круг и прямоугольник, любой неоконный компонент будет перекрыт ими. К оконным компонентам это, разумеется, не относится, они лежат над родительской панелью, и то, что мы рисуем на этой панели, не может оказаться над ними.

Мы не можем вставить свой код между рисованием непосредственно поверхности панели и рисованием компонентов на ней. Поэтому после отработки нашего кода приходится рисовать неоконные компоненты еще раз. Проще всего это сделать, вызвав метод PaintControls, который и используется стандартным обработчиком. Конечно, получится, что неоконные компоненты рисуются дважды: в стандартном обработчике и в нашем, и это не очень хорошо. Но повторим еще раз, что программа PanelMsg — не образец для подражания, а что-то вроде зонда для исследования особенностей работы VCL.

Вызов метода PaintControls затруднен тем, что он объявлен в разделе protected, а потому не может быть вызван из метода NewPanelWndProc, который относится к классу формы. Чтобы обойти это ограничение, нужно породить наследника от TPanel — TFakePanel. Этот наследник ничего не добавляет к классу TPanel и ничего не переопределяет в нем. Но раз он объявлен в нашем модуле, все его protected-члены, в том числе и унаследованный метод PaintControls, становятся доступными в нем. После этого мы можем привести поле, содержащее ссылку на панель, к этому типу и вызвать PaintControls. Так как структуры типов TPanel и TFakePanel идентичны, это приведет к вызову нужного метода.

Для завершения обработки сообщения WM_PAINT осталось только вызвать EndPaint, разумеется, только в том случае, если BeginPaint вызывали мы сами.

И последнее, что мы должны сделать, — это передать все остальные сообщения стандартному обработчику. После этого программа PanelMsg готова.

1.2.5. Пример NumBroadcast

Программа NumBroadcast демонстрирует широковещательную рассылку глобальных сообщений. Окно программы показано на рис. 1.10.

Рис 1.10. Окно программы NumBroadcast

Для того чтобы увидеть, как работает программа, нужно запустить несколько ее экземпляров. После ввода числа и нажатия кнопки Разослать любому из экземпляров программы число под кнопкой меняется во всех экземплярах. Чтобы добиться такого эффекта, программа NumBroadcast регистрирует глобальное сообщение с помощью функции RegisterWindowMessage, а в оконной процедуре предусмотрена реакция на это сообщение (число передастся через параметр WParam). Код программы приведен в листинге 1.31.

Листинг 1.31. Модуль главного окна программы NumBroadcast

unit NBMain;

interface

uses

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

type TForm1 = class(TForm)

EditNumber: TEdit;

BtnBroadcast: TButton;

LabelNumber: TLabel;

procedure BtnBroadcastClick(Sender: TObject);

private

// Здесь будет храниться номер, присвоенный системой

// глобальному сообщению

FSendNumberMessage: Cardinal;

protected

// Так как номер сообщения станет известным только при

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

// с помощью директивы message нельзя. Приходится

// перекрывать метод WndProc и обрабатывать сообщение в

// нем. Можно было бы вместо WndProc перекрыть метод

// DefaultHandler, но при этом зарегистрированное

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

// сначала выполнялся бы метод WndProc, затем Dispatch

// пытался бы найти подходящий обработчик среди методов

// объекта, и лишь затем дело доходило бы до перекрытого

// DefaultHandler. Но, с другой стороны, при перекрытии

// WndProc обработка всех сообщений начинается со

// сравнения их номера с FSendNumberMessage и вызова

// унаследованного WndProc, если это другое сообщение.

// А до DefaultHandler многие сообщения не дойдут, т.к.

// будут обработаны ранее, и накладные расходы на

// сравнение и вызов унаследованного метода будут меньше.

procedure WndProc(var Msg: TMessage); override;

public

constructor Create(AOwner: TComponent); override;

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

constructor TForm1.Create(AOwner: TComponent);

begin

// Регистрируем глобальное сообщение с именем

// WM_DelphiKingdom_APISample_SendNumber. Имя достаточно

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

// никакое другое приложение не зарегистрирует сообщение с

// таким же именем. Регистрация сообщения выполняется до

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

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

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

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

// RegisterWindowMessage, то поле FSendNumberMessage

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

// а это - код сообщения WM_NULL. Таким образом, если в

// это время окно получит сообщение WM_NULL, оно будет

// неправильно обработано. Конечно, вероятность получения

// WM_NULL во время выполнения унаследованного

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

// сделать так, чтобы поле FSendNumberMessage на момент

// первого вызова WndProc уже имело правильное значение.

FSendNumberMessage := RegisterWindowMessage('WM_DelphiKingdom_APISample_SendNumber');

inherited;

// Здесь мы меняем стиль окна поля ввода, добавляя в него

// ES_NUMBER. Стиль ES_NUMBER запрещает полю ввода

// вводить какие-либо символы, кроме цифр. Это уменьшает

// риск ошибки ввода в тех случаях, когда требуется целое

// неотрицательное число.

SetWindowLong(EditNumber.Handle, GWL_STYLE, GetWindowLong(EditNumber.Handle, GWL_STYLE) or ES_NUMBER);

end;

procedure TForm1.BtnBroadcastClick(Sender: TObject);

var

Num: Integer;

Recipients: DWORD;

begin

try

Num := StrToInt(EditNumber.Text);

// Для широковещательной рассылки сообщения служит

// функция BroadcastSystemMessage. В литературе обычно

// советуют использовать более простую функцию

// PostMessage, указывая в качестве адресата

// HWND_BROADCAST. Однако PostMessage рассылает

// сообщения только окнам верхнего уровня, не имеющим

// владельца (в терминах системы). Но главная форма

// приложения имеет владельца - это невидимое окно

// приложения, реализуемое объектом TApplication.

// Поэтому такое широковещательное сообщение главная

// форма приложения не получит — его получит только

// невидимое окно приложения (это сообщение можно

// будет перехватить, назначив обработчик

// Application.OnMessage - вручную или с помощью

// компонента TApplicationEvents). Чтобы главная форма

// тоже попала в список окон, получающих

// широковещательное сообщение, используется функция

// BroadcastSystemMessage.

Recipients := BSM_APPLICATIONS;

BroadcastSystemMessage(BSF_POSTMESSAGE, @Recipients, FSendNumberMessage, Num, 0);

except

on EConvertError do

begin

Application.MessageBox(

'Введенное значение не является числом', 'Ошибка',

MB_OK or MB_ICONSTOP);

end;

procedure TForm1.WndProc(var Msg: TMessage);

begin

if Msg.Msg = FSendNumberMessage then

LabelNumber.Caption := IntToStr(Msg.WParam)

else inherited;

end;

end.

Как уже отмечалось ранее, для обработки глобального сообщения нельзя использовать методы с директивой message, т.к. номер сообщения на этапе компиляции еще не известен. Здесь для обработки глобального сообщения мы перекрываем метод WndProc. Соответственно, все оконные сообщения, в том числе и те, которые окно получает при создании, будет обрабатывать перекрытый метод WndProc. Это значит, что поле FSendNumberMessage, которое задействовано в этом методе, должно быть правильно инициализировано раньше, чем окно получит первое сообщение. Поэтому вызов функции RegisterWindowMessage выполнять, например, в обработчике события OnCreate формы уже поздно. Его необходимо выполнить в конструкторе формы, причем до того, как будет вызван унаследованный конструктор.

Примечание

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

Нажатие на кнопку BtnBroadcast приводит к широковещательной отправке сообщения. Отправить широковещательное сообщение можно двумя способами: функцией PostMessage с адресатом HWND_BROADCAST вместо дескриптора окна и с помощью функции BroadcastSystemMessage. Первый вариант позволяет отправить сообщения только окнам верхнего уровня, не имеющим владельца в терминах системы. Таким окном в VCL-приложении является только невидимое окно приложения, создаваемое объектом Application. Главная форма имеет владельца в терминах системы — то самое невидимое окно приложения. Поэтому широковещательное сообщение, посланное с помощью PostMessage, главная форма не получит, это сообщение пришлось бы ловить с помощью события Application.OnMessage. Мы здесь применяем другой способ — отправляем сообщение с помощью функции BroadcastSystemMessage, которая позволяет указывать тип окон, которым мы хотим отправить сообщения. В частности, здесь мы выбираем тип BSM_APPLICATION, чтобы сообщение посылалось всем окнам верхнего уровня, в том числе и тем, которые имеют владельца. При таком способе отправки главная форма получит это широковещательное сообщение, поэтому его обработку можно реализовать в главной форме.

1.2.6. Пример ButtonDel

Программа ButtonDel демонстрирует, как можно удалить кнопку в обработчике нажатия этой кнопки. Очень распространенная ошибка — попытка написать код, один из примеров которого приведен в листинге 1.32.

Листинг 1.32. Неправильный вариант удаления кнопки в обработчике ее нажатия

procedure TForm1.Button1Click(Sender: TObject);

begin

Button1.Free;

end;

Рассмотрим, что произойдет в случае выполнения этого кода. Когда пользователь нажимает на кнопку, форма получает сообщение WM_COMMAND. При обработке форма выясняет, что источником сообщения является объект Button1 и передает этому объекту сообщение CN_COMMAND. Button1, получив его, вызывает метод Click, который проверяет, назначен ли обработчик OnClick, и, если назначен, вызывает его. Таким образом, после завершения Button1Click управление снова вернется в метод Click объекта Button1, из него — в метод CNCommand, из него — в Dispatch, оттуда — в WndProc, а оттуда — в MainWndProc. А из MainWndProc управление будет передано в оконную процедуру, сформированную компонентом с помощью MakeObjectInstance. В деструкторе Button1 эта оконная процедура будет уже удалена. Таким образом, управление получат последовательно пять методов уже не существующего объекта и одна несуществующая процедура. Это может привести к самым разным неприятным эффектам, но, скорее всего, — к ошибке Access violation (обращение к памяти, которую программа не имеет права использовать). Поэтому приведенный в листинге 1.32 код будет неработоспособным. В классе TCustomForm для безопасного удаления формы существует метод Release, который откладывает уничтожение объекта до того момента, когда это будет безопасно, но остальные компоненты подобного метода не имеют.

Примечание

Метод TCustomForm.Release на поверку тоже оказывается не совсем безопасным — подробнее об этом написано в разд. 3.4.3.

Очевидно, что для безопасного удаления кнопки эту операцию следует отложить до того момента, когда все методы удаляемой кнопки уже закончат свою работу. Вставить требуемый код в обработчик WM_COMMAND формы достаточно сложно, поэтому мы будем использовать другой способ: пусть обработчик кнопки посылает форме сообщение, в обработчике которого она будет удалять кнопку. Здесь важно, что сообщение посылается, а не отправляется, т.е. ставится в очередь, из которой извлекается уже после того, как будет полностью обработано сообщение WM_COMMAND. В этом случае методы удаляемой кнопки не будут вызваны, и удаление пройдет без неприятных последствий.

Как раз для подобных случаев и предусмотрена возможность определять свои сообщения, т.к. ни одно из стандартных для наших целей не подходит. Свое сообщение мы будем посылать только одному окну, без широковещания, поэтому для него вполне подходит диапазон сообщений класса. Номер сообщения становится известным на этапе компиляции, поэтому для обработки этого сообщения мы можем применить самый удобный способ написать метод-обработчик с помощью директивы message. С учётом всего этого код выглядит следующим образом (листинг 1.33).

Листинг 1.33. Модуль главной формы программы ButtonDel

unit BDMain;

interface

uses

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

// Определяем свое сообщение. Константа, добавляемая к

// WM_USER, может иметь произвольное значение в диапазоне

// от 0 до 31743.

const

WM_DELETEBUTTON = WM_USER + 1;

type TForm1 = class(TForm)

BtnDeleteSelf: TButton;

procedure BtnDeleteSelfClick(Sender: TObject);

private

// Определяем метод - обработчик событий WM_DELETEBUTTON.

// Ему будет передано управление через Dispatch.

procedure WMDeleteButton(var Msg: TMessage); message WM_DELETEBUTTON;

public

{ Public declarations }

end;

var

Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.BtnDeleteSelfClick(Sender: TObject);

begin

// Помещаем сообщение WM_DELETEBUTTON в очередь формы.

// Указатель на объект, который нужно удалить, помещаем

// в LParam. В 32-разрядных версиях Windows указатель

// можно помещать как в wParam, так и в lParam, но по

// традиции, берущей начало в 16-разрядных версиях,

// указатель обычно передают через lParam.

PostMessage(Handle, WM_DELETEBUTTON, 0, LParam(BtnDeleteSelf));

// Здесь принципиально использование PostMessage, а не

// SendMessage. SendMessage в данном случае привел бы к

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

// WMDeleteButton был бы вызван до завершения работы

// BtnDeleteSelfClick. Это привело бы к тому же

// результату, что и прямой вызов BtnDeleteSelf.Free.

end;

procedure TForm1.WMDeleteButton(var Msg: TMessage);

begin

// Просто удаляем объект, указатель на который передан

// через lParam.

TObject(Msg.LParam).Free;

end;

end.

Приведенный здесь способ хорошо работает в такой простой ситуации, но в более сложных случаях может не дать результата. Рассмотрим, например, ситуацию, когда на форме лежат две кнопки: Button1 и Button2. Обработчик нажатия Button1 содержит длительную операцию, и поэтому в нем вызывается Application.ProcessMessages. Обработчик нажатия Button2 содержит строку Button1.Free. Если после запуска программы сразу нажать Button2, проблем не возникнет и объект Button1 будет благополучно удален. Но если сначала нажать Button1, а затем — Button2, возникнет ошибка. Это произойдёт потому, что нажатие Button2 будет в данном случае обработано локальной петлей сообщения, и после обработки управление вернется Button1Click, а оттуда — в методы уже не существующего объекта Button1. Посылка в Button2Click сообщения форме здесь не поможет, потому что это сообщение также будет извлечено и обработано локальной петлей. Общего решения таких проблем, видимо, не существует. В сложных случаях можно посоветовать не удалять объект, а просто прятать его (Visible := False) — видимый результат для пользователя будет тот же самый.

1.2.7. Пример GDIDraw

Программа GDIDraw демонстрирует некоторые возможности GDI, которые не поддерживаются классом TCanvas. Выбраны только те возможности, которые поддерживаются не только в Windows NT/2000/XP, но и в 9x/ME. Окно программы показано на рис. 1.11.

В своей работе программа использует рисунок из стандартных картинок Delphi, предполагая, что эти картинки установлены в папку "С:\Program Files\Common Files\Borland Shared\Images". Если у вас эти картинки установлены в другую папку, или по каким-то причинам вы хотите выбрать другой рисунок, измените обработчик события OnCreate формы так, чтобы он загружал рисунок из нужного вам файла. Загруженный рисунок сохраняется в поле FBitmap формы.

Рис. 1.11. Окно программы GDIDraw

Основная работа выполняется в обработчике события OnPaint формы. Мы здесь будем разбирать этот обработчик не целиком, а по частям в соответствии с тем, что каждая часть рисует. Начнем с надписи Delphi Kingdom в левом верхнем углу окна (листинг 1.34).

Листинг 1.34. Вывод надписи Delphi Kingdom

var

R: TRect;

...

// Формируем регион, использующийся для отсечения.

// Формируем его только при первом вызове метода, а при

// дальнейших используем созданный ранее. Поле FRgn

// содержит дескриптор этого региона

if FRgn = 0 then

begin

Canvas.Font.Name := 'Times New Roman';

Canvas.Font.Style := [fsBold];

Canvas.Font.Height := 69;

// Начинаем рисование траектории. Все вызовы

// графических функций, находящиеся между BeginPath

// и EndPath, не будут приводить к выводу на экран.

// Вместо этого информация о том, что рисуется, будет

// сохраняться а специальном объекте GDI - траектории.

BeginPath(Canvas.Handle);

R := Rect(10, 10, 10 + FBitmap.Width, 10 + FBitmap.Height);

// Если не установить с помощью SetBkMode прозрачный

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

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

SetBkMode(Canvas.Handle, TRANSPARENT);

// Выводим текст "Delphi Kingdom", выравнивая его по

// центру по вертикали и горизонтали.

DrawText(Canvas.Handle, 'Delphi'#13#10'Kingdom', -1, R,

DT_CENTER or DT_VCENTER);

EndPath(Canvas.Handle);

// Превращаем траекторию в регион. В результате вызова

// этой функции получится регион, контуры которого

// совпадают с контурами надписи "Delphi Kingdom",

// сделанной в указанных координатах выбранным шрифтом.

FRgn := PathToRegion(Canvas.Handle);

end;

// Устанавливаем регион отсечения. Все, что не будет

// попадать в выбранный регион, при выводе будет

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

SelectClipRgn(Canvas.Handle, FRgn);

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

// региона, отсекается. Таким образом, получаем надпись

// "Delphi Kingdom", подсвеченную выбранным изображением.

Canvas.Draw(10, 10, FBitmap);

// Отменяем отсечение по региону

SelectClipRgn(Canvas.Handle, 0);

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

Соответственно, чтобы сделать такую надпись, нужно создать регион, совпадающий по форме с этой надписью. В GDI есть целый ряд функций для создания регионов различной формы, но вот для создания региона в форме букв функции нет. Зато GDI поддерживает другие объекты — траектории. Строго говоря, это не совсем объекты, траектория не имеет дескриптора (по крайней мере, API не предоставляет этот дескриптор программам), и в каждом контексте устройства может быть только одна траектория. Создание траектории начинается с вызова функции BeginPath, заканчивается вызовом функции EndPath. Графические функции, вызванные между BeginPath и EndPath, не выводят ничего в контекст устройства, а то, что должно быть выведено, вместо этого запоминается в траектории (которая представляет собой совокупность замкнутых кривых). С траекторией можно выполнить много полезных операций (см., например, разд. 1.3.4). В нашем случае между вызовами BeginPath и EndPath мы вызываем DrawText. формируя таким образом траекторию, состоящую из контуров букв. Затем с помощью функции PathToRegion мы создаем регион, границы которого совпадают с контурами траектории, т.е., в данном случае, регион, совпадающий по форме с надписью.

Примечание

На самом деле не все графические функции, вызванные между BeginPath и EndPath, добавляют контуры к траектории. Это зависит от версии операционной системы. Подробнее этот вопрос обсуждается в разд. 1.3.4.

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

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

Теперь рассмотрим, как рисуются звезды в правом верхнем углу окна (листинг 1.35).

Листинг 1.35. Рисование звезд

var

I: Integer;

Star: array[0..4] of TPoint;

...

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

// надписи. Эти звезды демонстрируют использование двух

// режимов заливки: WINDING и ALTERNATE. Для простых

// фигур эти режимы дают одинаковые результаты, разница

// возникает только при закрашивании сложных фигур,

// имеющих самопересечения.

Canvas.Pen.Style := psSolid;

Canvas.Pen.Width := 1;

Canvas.Pen.Color := clRed;

Canvas.Brush.Style := bsSolid;

Canvas.Brush.Color := clRed;

// Вычисляем координаты вершин звезды. Они помещаются

// в массив Star в следующем порядке (если первой

// считать верхнюю вершину и нумеровать остальные по

// часовой стрелке от нее): 1-3-5-2-4

for I := 0 to 4 do

begin

Star[I].X := Round(380 + 90 * Sin(0.8 * I * Pi));

Star[I].Y := Round(100 - 90 * Cos(0.8 * I * Pi));

end;

// Устанавливаем режим заливки WINDING. При

// использовании этого режима закрашивается все

// содержимое многоугольника независимо от того,

// как именно он нарисован.

SetPolyFillMode(Canvas.Handle, WINDING);

Canvas.Polygon(Star);

// Сдвигаем координаты звезды, чтобы нарисовать ее

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

for I := 0 to 4 do Inc(Star([I].X, 200);

// Устанавливаем режим заливки ALTERNATE. При

// использовании этого режима заполняются горизонтальные

// линии, лежащие между нечетной и четной сторонами

// многоугольника. В результате пятиугольник в центре

// звезды оказывается незаполненным.

SetPolyFillMode(Canvas.Handle, ALTERNATE);

Canvas.Polygon(Star);

Самое интересное здесь то, что обе звезды рисуются практически одинаково, меняется только режим заливки. Сначала с помощью простейшей тригонометрии вычисляются координаты вершин звезды, помещаются в массив Star и эта звезда рисуется с режимом заливки WINDING. При этом закрашиваются все точки, для которых выполняется условие, что луч, выпущенный из этой точки, пересекает контур многоугольника нечетное число раз, т.е. всю внутренность контура. Затем координаты вершин звезды смещаются вправо, и такая же звезда рисуется точно так же, но уже с режимом заливки ALTERNATE. В этом режиме закрашиваются только те точки, которые оказались между четной и нечетной сторонами многоугольника, и пятиугольник внутри звезды остается незакрашенным. Обратите внимание, что звезду мы здесь рисуем с помощью класса TCanvas, и только режимы заливки переключаем API-функциями.

Следующий шаг — это рисование черной прямоугольной рамки на фоне пересекающихся зеленых линий. Линии рисуются до рамки для того, чтобы показать, что центр рамки действительно остается прозрачным, а не заливается цветом фона. Сама рамка рисуется вызовом одной функции PolyPolygon, позволяющей за один раз нарисовать фигуру, ограниченную несколькими замкнутыми многоугольными контурами (листинг 1.36).

Листинг 1.36. Рисование рамки с использованием PolyPolygon

const

Pts: array[0..7] of TPoint = (

(X: 40; Y: 230), (X: 130; Y: 230),

(X: 130; Y: 320), (X: 40; Y: 320),

(X: 60; Y: 250), (X: 60; Y: 300),

(X: 110; Y: 300), (X: 110; Y: 250));

Cnt: array[0..1] of Integer = (4, 4);

...

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

Canvas.Pen.Color := clLime;

Canvas.Pen.Width := 3;

// Эти линии рисуются для того, чтобы показать, что

// центр рамки остается прозрачным.

Canvas.MoveTo(30, 220);

Canvas.LineTo(140, 330);

Canvas.MoveTo(140, 220);

Canvas.LineTo(30, 330);

Canvas.Pen.Color := clBlack;

Canvas.Brush.Color := clBlack;

// Функция PolyPolygon позволяет нарисовать несколько

// многоугольников одной командой. Второй параметр

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

// параметр задает массив, содержащий число вершин

// каждого из многоугольников. В нашем случае массив

// Cnt имеет значение (4, 4). Это значит, что первые

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

// многоугольника, следующие четыре - второго. Отметим,

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

// очень простым способом: сначала нужно получить

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

// этот указатель разыменовать. Формальные параметры,

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

// PolyPolygon в модуле Windows.dcu объявлены как

// нетипизированные параметры-переменные, поэтому

// компилятор не разрешает просто передать Pts и Cnt в

// качестве фактических параметров - он запрещает

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

// Это не совсем корректно, т.к. локальная

// типизированная константа - это на самом деле не

// константа, а глобальная переменная с локальной

// областью видимости. Тем не менее компилятор имеет

// такую особенность, которую приходится учитывать.

// В данном примере функция PolyPolygon используется для

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

// лежит внутри другого. При этом содержимое внутреннего

// квадрата остается незаполненным. Обратите внимание,

// что квадраты рисуются в разных направлениях: внешний

// по часовой стрелке, внутренний - против. Если

// установлен режим заполнения ALTERNATE, это никак не

// влияет на результат, но если установить режим WINDING,

// внутренний квадрат не будет закрашен только в том

// случае, если квадраты рисуются в противоположных

// направлениях.

PolyPolygon(Canvas.Handle, (@Pts)^, (@Cnt)^, 2);

Вся хитрость в этом коде — как передать параметры в функцию PolyPolygon. Ее второй параметр — это указатель на массив элементов TPoint, содержащий координаты вершин всех контуров в массиве: сначала все вершины первого контура в нужном порядке, затем — все вершины второго контура и т.д. Третий параметр — это указатель на массив, содержащий число точек в каждом контуре: первый элемент массива содержит число точек в первом контуре, второй — во втором и т.д. Общее число контуров определяется четвёртым, последним параметром функции PolyPolygon. Число элементов во втором массиве должно быть равно значению четвертого параметра, a число элементов в первом массиве — сумме значений элементов второго массива. За выполнением этих требований должен следить сам программист, если он ошибется, функция может обратиться к памяти, лежащей за пределами массивов, и последствия будут непредсказуемыми.

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

Нетрудно убедиться, что первые четыре элемента массива Pts содержат координаты вершин внешнего квадрата рамки, последние четыре — внутреннего квадрата. Массив Cnt, соответственно, содержит два элемента, оба из которых имеют значение 4. Это означает, что в нашей фигуре два замкнутых контура, и оба содержат по четыре вершины. Порядок следования вершин во внешнем квадрате — по часовой стрелке, во внутреннем — против. Это имеет значение, если выбран режим заливки WINDING, тогда направления обхода контуров должны быть противоположными, иначе отверстие тоже окажется закрашенным. Для режима заливки ALTERNATE направление обхода контуров не имеет значения.

Далее программа GDIDraw демонстрирует работу функции InvertRect, которая инвертирует цвета в заданной прямоугольной области контекста устройства. Для того чтобы это было нагляднее, мы сначала выведем на форму загруженный в OnCreate рисунок (только на этот раз без региона отсечения) и инвертируем область, частично пересекающуюся с областью рисунка (листинг 1.37).

Листинг 1.37. Пример использования функции InvertRect

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

// его часть

Canvas.Draw(300, 220, FBitmap);

// Функция InvertRect делает указанный прямоугольник

// "негативом".

InvertRect(Canvas.Handle, Rect(320, 240, 620, 340));

Ещё одна забавная функция GDI, которая почему-то не нашла отражения в классе TCanvas — это GrayString. Она предназначена для вывода "серого" текста, т.е. текста, который по яркости находится посредине между черным и белым. Обычно для этого просто устанавливается цвет RGB(128, 128, 128), но некоторые черно-белые устройства не поддерживают полутона (это касается, прежде всего, старых моделей принтеров) — именно на них и ориентирована функция GrayString. Она позволяет рисовать серый текст произвольным образом с помощью функции обратного вызова, но эту функцию можно не указывать, и тогда рисование осуществляется функцией TextOut. Но при этом текст выводится через промежуточную растровую картинку в памяти, что обеспечивает полупрозрачность текста, т.к. закрашиваются не все пикселы, а только половина в шахматном порядке. На черно-белых принтерах с большим разрешением это действительно выглядит как серый текст, на экране же можно получать "полупрозрачные" надписи. Пример использования функции GrayString приведен в листинге 1.38.

Листинг 1.38. Пример использования функции GrayString

// Следующая группа команд выводит "полупрозрачную"

// надпись "Windows API"

Canvas.Brush.Color := clBlue;

// Функция GrayString при выводе текста закрашивает

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

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

// эффект полупрозрачности.

Canvas.Font.Name := 'Times New Roman';

Canvas.Font.Style := [fsBold];

Canvas.Font.Height := 69;

GrayString(Canvas.Handle, Canvas.Brush.Handle, nil, LPARAM(PChar('Windows API')), 0, 20, 350, 0, 0);

Обратите внимание на второй параметр — через него передается дескриптор кисти, с помощью которой будет осуществляться закраска пикселов в выводимой строке. Функция GrayString игнорирует ту кисть, которая выбрана в контексте устройства и использует свою. Здесь для простоты мы передаем ей кисть контекста устройства, но, в принципе, это могла бы быть любая другая кисть. Третий параметр — это указатель на функцию обратного вызова. В нашем случае он равен nil, что указывает на использование функции TextOut. Четвертый параметр имеет тип LPARAM и содержит произвольные данные, которые передаются функции обратного вызова. В случае использования TextOut это интерпретируется как указатель на строку, которую нужно вывести, поэтому здесь приходится возиться с приведением типов. Пятый параметр содержит длину выводимой строки. Это очень характерно для функций GDI, предназначенных для вывода текста, конец строки в них определяется не обязательно по завершающему символу #0, можно вывести только часть строки, явно задав нужное число символов. Но этот же параметр можно сделать равным нулю (как в нашем случае), и тогда длина строки определяется обычным образом — по символу #0. Прочие параметры функции определяют координаты выводимой строки.

Последняя часть примера посвящена вопросу, который долгое время был очень популярен в форумах: как вывести текст, расположенный наклонно (в программе примером такого текста является надпись Sample, выведенная под углом 60 градусов). Это связано с тем, что только в BDS 2006 у класса TFont появилось свойство Orientation, позволяющее задавать направление текста (в справке BDS 2006 информация об этом свойстве отсутствует, она появляется только в справке Delphi 2007, но это свойство, тем не менее, есть и в BDS 2006, а также в Turbo Delphi). В более ранних версиях текст под углом можно было вывести только с помощью функций GDI, вручную создавая шрифт (листинг 1.9).

Листинг 1.39. Вывод текста под углом средствами GDI

// Следующая группа функций выводит надпись "Sample".

// повернутую на угол 60 градусов.

Canvas.Brush.Style := bsClear;

// При создании логического шрифта для контекста

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

// угол поворота. Однако класс TFont игнорирует такую

// возможность, поэтому шрифт нужно создавать вручную.

// Чтобы выбрать шрифт в контексте устройства, легче

// всего присвоить его дескриптор свойству

// Canvas.Font.Handle. Параметры fdwItalic, fdwUnderline

// и fdwStrikeOut, согласно справке, могут принимать

// значения True или False, но имеют тип DWORD. Для

// С/C++ это не имеет значения - целый и логический типы

// в этих языках совместимы. Но в Delphi приходится

// использовать 0 и 1 вместо True и False. Угол поворота

// шрифта задается в десятых долях градуса, т.е.

// значение 600 означает 60 градусов.

Canvas.Font.Handle := CreateFont(60, 0, 600, 600, FW_NORMAL, 0, 0, 0,

ANSI_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS,

DEFAULT_QUALITY, DEFAULT_РIТСН, 'Times New Roman');

Canvas.TextOut(140, 320, 'Sample');

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

// корректно в BDS2006 и выше. В этой версии у класса

// TFont появилось свойство Orientation, задающее

// направление текста, и этот класс научился определять

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

// оно было задано функцией GDI, а не через свойство

// Orientation. Чтобы этого не происходило, нужно снова

// придать шрифту горизонтальное направление. В версиях

// Delphi, более ранних, чем BDS 2006, эта строка

// не нужна: при изменении шрифта через класс TFont

// направление текста и так станет горизонтальным.

Canvas.Font.Handle := Create Font(60, 0, 0, 0, FW_NORMAL, 0, 0, 0,

ANSI_CHARSET, OUT_TT_PRECIS, CLIP_DEFAULT_PRECIS,

DEFAULT_QUALITY, DEFAULT_PITCH, 'Times New Roman');

Новый шрифт создается функцией CreateFont. Если бы мы программировали без VCL, то полученный в результате вызова этой функции дескриптор шрифта необходимо было бы выбрать в контексте устройства (функция SelectObject) и вывести надпись. Затем в устройстве следовало бы выбрать другой шрифт, а созданный ранее удалить. Но т.к. VCL мы все же используем, можно поступить проще: присвоить созданный дескриптор свойств Canvas.Font.Handle, а все остальное сделают классы TCanvas и TFont.

Примечание

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

Функция CreateFont имеет 14 параметров, определяющих свойства создаваемого шрифта. Мы не будем перечислять их все, отметим только, что мы здесь создаем шрифт на основе гарнитуры Times New Roman, имеющий размер 60 обычный (т.е. не жирный и не наклонный). О точных значениях всех параметров рекомендуем посмотреть в MSDN.

Самые интересные для нас параметры — это третий (nEscapement) и четвертый (nOrientation), которые и определяют угол наклона шрифта. Они задаются в десятых долях градуса, т.е., чтобы получить нужное значение параметра, следует требуемое число градусов умножить на 10) (в нашем примере оба эти параметра равны 600, что означает 60 градусов). Параметр nEscapement задает угол поворота базовой линии текста относительно горизонтальной оси. Параметр nOrientation задаст угол поворота отдельных букв относительно своего нормального положения. По умолчанию в контекст устройства включен режим GM_COMPATIBLE при котором эти два значения должны совпадать, т.е. угол поворота надписи в целом и угол поворота отдельной буквы всегда совпадают. В Windows NT/2000/ХР с помощью функции SetGraphicsMode можно установить для контекста устройства режим GM_ADVANCED, при котором, в частности, параметры (nOrientation и nEscapement могут принимать различные значения (в Windows 9х/МЕ тоже есть функция SetGraphicsMode, но установить режим GM_ADVANCED она не позволяет). Когда мы присваиваем значение свойству TFont.Handle, все прочие свойства объекта TFont меняют свои значения в соответствии с тем, какой шрифт установлен. Так как в Delphi до 7-й версии свойство TFont.Orientation отсутствует, направление шрифта, установленное нами, в этом классе не запоминается, и поэтому при дальнейшем изменении шрифта с помощью свойств Canvas.Font.Name, Canvas.Font.Size и т.п. мы снова получим горизонтальный шрифт. Другое дело — BDS 2006 и выше. В этих версиях направление шрифта тоже запоминается, и поэтому дальнейшие манипуляции со свойствами Canvas.Font будут снова давать наклонный шрифт, пока мы явно не присвоим значение 0 свойству Canvas.Font.Orientation. В нашем случае это означает, что при повторном вызове события OnPaint при вызове функции GrayString будет выведен наклонный текст, если не принять дополнительные меры. Как мы уже сказали, проблема легко решается присваиванием нуля свойству Canvas.Font.Orientation, но, т.к. наши примеры должны работать во всех версиях Delphi, начиная с пятой, этот вариант нам не подходит. Поэтому мы здесь вновь вручную создаем шрифт, на этот раз не важно, какой именно, главное, чтобы его параметры nOrientation и nEscapement были равны нулю. В Delphi до 7-й версии программа GDIDraw будет корректно работать и без второго вызова функции CreateFont.

Отметим, что во всех версиях до Delphi 2007 как минимум, класс TFont имеет свойство Orientation, но не имеет свойства Escapement. Это означает, что если вы хотите вывести надпись, у которой угол наклона букв и угол наклона базовой линии будут разными, вам все-таки придется самостоятельно вызывать функцию CreateFont.

1.2.8. Пример BitmapSpeed

Программа BitmapSpeed предназначена для сравнения скорости работы с растровыми изображениями в формате DDB и DIB через класс TBitmap. Тестируются три операции: рисование прямых линий, вывод растра на экран и работа со свойством ScanLine. Окно программы показано на рис 1.12.

Рис. 1.12. Окно программы BitmapSpeed после завершения теста

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

Листинг 1.40. Метод DoTest, выполняющий тесты скорости

procedure TForm1.DoTest(Cnt, XOfs, ColNum: Integer; PixelFormat: TPixelFormat);

{ Cnt - число повторов операции при тестах

XOfs - X-координата области, в которой будет выполняться вывод изображения во втором тесте

ColNum - номер колонки в GridResults, в которую будут выводиться результаты

Pixel Format - формат изображения }

var

Pict: TBitmap;

I: Integer;

P: Pointer;

Freq, StartTime, EndTime: Int64;

begin

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

QueryPerformanceFrequency(Freq);

// Создаем изображение

Pict := TBitmap.Create;

try

Pict.PixelFormat := PixelFormat;

Pict.Width := PictSize;

Pict.Height := PictSize;

Pict.Canvas.Pen.Width := 0;

// Вывод линий на картинку

// Выводится Cnt линий со случайными координатами

QueryPerformanceCounter(StartTime);

for I := 1 to Cnt do

begin

Pict.Canvas.Pen.Color :=

RGB(Random(256), Random(256), Random(256));

Pict.Canvas.MoveTo(Random(PictSize), Random(PictSize));

Pict.Canvas.LineTo(Random(PictSize), Random(PictSize));

end;

QueryPerformanceCounter(EndTime);

GridResults.Cells[ColNum, 1] :=

FloatToStrF((EndTime - StartTime) / Freq * 1000, ffFixed, 10, 2);

// Вызываем Application.ProcessMessages, чтобы GridResults

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

Application.ProcessMessages;

// Второй тест - вывод рисунка на экран

QueryPerformanceCounter(StartTime);

// Повторяем вывод рисунка на экран Cnt раз

// Чтобы пользователь мог видеть, когда вывод

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

// случайную величину

for I := 1 to Cnt do

Canvas.Draw(XOfs + Random(50), 10 + Random(50), Pict);

QueryPerformanceCounter(EndTime);

GridResults.Cells[ColNum, 2] :=

FloatToStrF((EndTime - StartTime) / Freq + 1000, ffFixed, 10, 2);

Application.ProcessMessages;

// Третий тест - доступ к свойству ScanLine

QueryPerformanceCounter(StartTime);

// Обращаемся к случайной строке свойства ScanLine

// Cnt раз

for I := 1 to Cnt do

P := Pict.ScanLine(Random(PictSize));

QueryPerformanceCounter(EndTime);

GridResults.Cells[ColNum, 3] :=

FloatToStrF((EndTime - StartTime) / Freq * 1000, ffFixed, 10, 2);

Application.ProcessMessages;

finally

Pict.Free;

end;

Для измерения скорости работы будем использовать счетчик производительности — это высокопроизводительный счетчик, поддерживаемый системой для измерения производительности. Текущее значение счетчика можно узнать с помощью функции QueryPerformanceCounter, число тактов счетчика в секунду — с помощью функции QueryPerformanceFrequency. Этот счетчик позволяет получить более точные результаты, чем традиционно применяющаяся для таких целей функция GetTickCount. Теоретически, счетчик производительности может не поддерживаться аппаратной частью (в этом случае функция QueryPerformanceFrequency вернет нулевую частоту), однако все современные компьютеры такой счетчик поддерживают, поэтому его можно применять без опасений.

В зависимости от параметра PixelFormat метод DoTest создает DDB- или DIB-изображение и тестирует скорость исполнения операций с ним. В первом тесте Cnt раз рисуется линия случайного цвета со случайными координатами — так проверяется скорость рисования на картинке. Разумеется, это весьма односторонний тест, т.к. при рисовании других примитивов будет, скорее всего, иное соотношение скоростей для DIB и DDB. Но общее представление о соотношении скоростей он все же дает.

Во втором тесте полученное изображение Cnt раз выводится на экран. Если бы оно выводилось всегда в одном и том же месте, пользователь не видел бы процесс вывода на экран, т.к. каждый следующий раз картинка рисовалась бы точно в том же месте, что и в предыдущий, и общее изображение не менялось бы. Чтобы этого не происходило, изображение выводится со случайным смещением относительно базовых координат, и пользователь может наблюдать за процессом. Кроме того, координаты определяются также параметром XOfs — это сделано для того, чтобы при тестировании DDB- и DIB-изображений рисунки выводились в разных частях окна и не накладывались друг на друга.

На некоторых компьютерах в этом тесте с DDB-изображением наблюдается интересный эффект: время, измеренное программой, заметно меньше, чем время, когда картинка меняется на экране (например, пользователь ясно видит, что тест выполняется в течение примерно трех секунд, в то время как программа дает значение около одной секунды). Это связано со способностью некоторых видеокарт буферизовать переданные им команды и выполнять их асинхронно, т.е. вызов функции завершается очень быстро, программа продолжает работать дальше, а видеокарта параллельно ей выполняет команду. Если вы столкнетесь с такой ситуацией, можете провести небольшой эксперимент: вставить вызов функции Beep сразу после окончания второго теста. Вы услышите звуковой сигнал раньше, чем изображение закончит меняться.

Третий тест самый простой: Cnt раз значение свойства ScanLine присваивается переменной P. Так как значение P потом нигде не используется, компилятор выдает соответствующую подсказку, но в данном случае ее можно игнорировать.

Таким образом, метод DoTest нужно вызвать два раза: для DDB-изображения и для DIB это делает обработчик нажатия кнопки BtnStart (листинг 1.41).

Листинг 1.41. Обработчик нажатия кнопки BtnStart

procedure TForm1.BtnStartClick(Sender: TObject);

var

IterCnt, RandomStart: Integer;

begin

IterCnt := StrToInt(EditIter.Text);

GridResults.Cells[1, 1] := '';

GridResults.Cells[1, 2] := '';

GridResults.Cells[1, 3] := '';

GridResults.Cells[2, 1] := '';

GridResults.Cells[2, 2] := '';

GridResults.Cells[2, 3] := '';

// Чтобы новый текст ячеек отобразился в GridResults,

// нужно, чтобы было извлечено их очереди и обработано

// сообщение WM_PAINT. Чтобы сделать это немедленно,

// вызываем Application.ProcessMessages.

Application.ProcessMessages;

Random.Start := Random(MaxInt);

Screen.Cursor := crHourGlass;

// Точное измерение времени выполнения кода в Windows

// невозможно, потому что это многозадачная система, и

// часть измеренного времени может быть потрачена на

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

// уменьшить погрешность измерения, нужно установить

// наивысший приоритет процессу и его главной нити -

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

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

// высокий приоритет приводит к тому, что во время

// выполнения теста система перестаёт реагировать на

// перемещение мыши. Поэтому необходимо использовать блок

// try/finally, чтобы даже при возникновении исключения

// приоритет процесса и нити был снижен до нормального

// уровня.

SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL);

SetPriorityClass(GetCurrentProcess, REALTIME_PRIORITY_CLASS);

try

// В тестах активно используются псевдослучайные числа.

// Чтобы сравнение было корректно, нужно, чтобы

// последовательности чисел в экспериментах с DIB и DDB

// были одинаковыми. Каждое следующее псевдослучайное

// число генерируется на основе значения глобальной

// переменной модуля System RandSeed. Значение RandSeed

// при этом обновляется по определенному закону. Таким

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

// RandSeed, то последовательность псевдослучайных чисел

// будет строго детерминирована. Это свойство генератора

// случайных чисел используется, чтобы в обоих

// экспериментах были одинаковые последовательности.

RandSeed := RandomStart;

DoTest(IterCnt, 200, 1, pfDevice);

RandSeed := RandomStart;

DoTest(IterCnt, 450, 2, pf24bit);

finally

Screen.Cursor := crDefault;

SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_NORMAL);

SetPriorityClass(GetCurrentProcess, NORMAL_PRIORITY_CLASS);

end;

Все три теста используют случайные числа. Чтобы условия были одинаковыми, нужно обеспечить идентичность последовательностей случайных чисел при тестировании DDB- и DIB-изображений. К счастью, этою легко добиться, установив перед тестированием одинаковые значения переменной RandSeed модуля System, которая и определяет последующее случайное число. Начальное значение RandSeed также выбирается случайным образом, а т.к. в обработчике события OnCreate формы есть вызов Randomize, при каждом запуске будет сгенерирована новая последовательность случайных чисел. Это одна из причин того, что результаты тестов будут меняться от запуска к запуску.

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

Что касается самих результатов, то они, конечно, сильно зависят от конфигурации компьютера. По первым двум тестам время выполнения для DDB-растра может быть как в два-три раза меньше, чем для DIB, так и несколько превышать его. В третьем тесте DIB-растр, разумеется, существенно опережает по скорости DDB, хотя отношение и здесь зависит от компьютера. Также наблюдается некоторая зависимость от версии Delphi, под которой откомпилирован проект. Например, первый тест и для DIB, и для DDB выполняется несколько быстрее под Delphi 2007, чем под Delphi 5, а вот третий тест под Delphi 2007 выполняется несколько медленнее.

Назад: 1.1.8. Обработка сообщений с помощью VCL

Дальше: 1.3. Обобщающие примеры