Появилась задача – ограничить движение мыши прямоугольной областью, чтобы корректно работал механизм DragOver. Дело в том, что если разместить TreeView и ListView и прописать в каждом из них взаимоисключающие Accept параметры, то при переносе на соседний элемент иногда возникают проблемы. В итоге, решил ограничить область действия мыши для каждого из них отдельно. Поскольку я разрабатывал компонент, то использовал свойства для точного определения координат прямоугольника.
Получилось так…
В секции type private
|
1 |
FParentLeftTop:TPoint; |
В секции public
|
1 |
property ParentLeftTop:TPoint read FParentLeftTop write FParentLeftTop; |
В implementation
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 |
procedure TDBListView.ListViewDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); var myrect:TRect; begin myrect.Left:=Self.Left+ParentLeftTop.X; myrect.Top:=0; myrect.Width:=Self.Width; myrect.Height:=Screen.Height; ClipCursor(@myrect); end; |
Снятие ограничения в DragDrop, но у меня оно почему-то не срабатывало как нужно
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 |
procedure TDBListView.ListViewDragDrop(Sender, Source: TObject; X, Y: Integer); var DBNamePlusTable: String; idParent: String; id: string; DBConnectionLocal: TDBConnectionBPL; qEditParentKey: TFDQuery; myrect:TRect; begin myrect.Left:=0; myrect.Top:=0; myrect.Height:=Screen.Height; myrect.Width:=Screen.Width; ClipCursor(@myrect); end; |
И тогда я добавил снятие ограничения в MouseMove
|
1 2 3 4 5 6 7 8 9 10 11 12 13 14 |
procedure TDBListView.ListViewMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer); var myrect:TRect; begin myrect.Left:=0; myrect.Top:=0; myrect.Height:=Screen.Height; myrect.Width:=Screen.Width; ClipCursor(@myrect); end; |
В принципе, это всё!
Да, в интернетах пишут, что правильно снимать ограничение нужно так, в принципе это одно и тоже
|
1 |
ClipCursor(nil); |
Теперь, если это у нас компонент, то нам нужно вводить координаты родителя, и при каждом его перемещении передавать их заново, я сделал это так, в родителе прописал следующее
|
1 |
procedure OnMove(var Msg: TWMMove); message WM_MOVE; |
|
1 2 3 4 5 6 7 8 9 |
procedure TMainForm.OnMove(var Msg: TWMMove); var P:TPoint; begin P.X:=Self.Left; P.Y:=Self.Top; if DBTreeView1<>nil then DBTreeView1.ParentLeftTop:=P; end; |