Листинг 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;
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 это сделать нельзя.
Примечание