[Aptyp]

Здравствуйте. Есть панель. На ней есть к примеру TShape.
Когда я жму на TShape я запоминаю координаты нажатия и перемещаю панель с её родителя, на другую плавающую форму FDrag. Далее при движении курсора по TShape я двигаю FDrag. И при отжатии перестаю следить за движением курсора.

Код:

procedure TShape.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  FMoving := ssLeft in Shift;
  if not FMoving then Exit;  
  FdX := X;
  FdY := Y; 
  TControl(Sender).Parent.Parent := FDrag; 
  FDrag.Show;       
  FDrag.Left := Mouse.CursorPos.X - FdX;
  FDrag.Top := Mouse.CursorPos.Y - FdY;
end; 

procedure TShape.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin       
  if not FMoving then Exit;
  FDrag.Left := FDrag.Left + X - FdX;
  FDrag.Top := FDrag.Top + Y - FdY; 
end;

procedure TShape.MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
msg(2340);
  if not FMoving then Exit; 
  FMoving := False; 
end;

Без изменения родителя, если панель уже находится на FDrag, перемещение работает правильно. Но если с перемещением, то TShape как-то теряет привязку к курсору и если резко дёрнуть, то курсор просто выходит за рамки TShape и естественно MouseMove уже не отрабатывает. Как сохранить эту привязку к курсору и после смены родителя панели?

[NumLock]

c:\>______

procedure TShape.MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
FMoving := ssLeft in Shift;
if not FMoving then Exit;
FdX := X;
FdY := Y;
TControl(Sender).Parent.Parent := FDrag;
FDrag.Show;
FDrag.Left := Mouse.CursorPos.X - FdX;
FDrag.Top := Mouse.CursorPos.Y - FdY;
SetCapture(TControl(Sender).Parent.Handle);
end;

procedure TShape.MouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
if not FMoving then Exit;
FDrag.Left := FDrag.Left + X - FdX;
FDrag.Top := FDrag.Top + Y - FdY;
end;

procedure TShape.MouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
msg(2340);
if not FMoving then Exit;
ReleaseCapture;
FMoving := False;
end;

[Aptyp]

Супер, спасибо, а то я уже голову поломал.

Только наверное правильнее будет написать:

Код:

SetCaptureControl(TControl(Sender));

Дабы следить непосредственно за объектом, а не за панелью, хотя в моём случае без разницы.

[NumLock]

SetCaptureControl делает тоже самое, что и API SetCapture в примере, только большим количеством строк кода, вместо одной. В исходнике можно посмотреть. Потому что TShape не является окном!

[Aptyp]

Сообщение от NumLock

SetCaptureControl делает тоже самое, что и API SetCapture в примере, только большим количеством строк кода, вместо одной. В исходнике можно посмотреть. Потому что TShape не является окном!

В том то и дело, что у меня там может быть и TShape и TImage и всё что угодно.

[NumLock]

SetCaptureControl это VCL обертка над SetCapture. Поэтому работает и то и другое.