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, и если равен, то получаем контекст устройства, а если не равен, используем то, что передано.
