Читаем О чём не пишут в книгах по Delphi полностью

  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]);

Перейти на страницу:
Нет соединения с сервером, попробуйте зайти чуть позже