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