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

Листинг 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.