Советы по Delphi
Перетаскивание элементов управления c рамкой контура
...как перетаскивать элементы управления с контурной рамкой по их форме, "приклеенной" к курсору? Решение, найденное вами, работать не будет, поскольку таскаемая рамка не обязательно может находиться в пределах области компонента (а вы отрисовываете ее только на компоненте).
В общих чертах, вы должны рисовать на всей поверхности формы и даже рабочего стола, для чего необходимо сделать растровую КОПИЮ окна или десктопа и рисовать на ней. Вот что нам нужно.
Начните со свеженькой формы. Бросьте на нее компонент Notebook и установите его свойство Align в alClient. Разработайте форму на первой странице компонента Notebook. Создайте вторую страницу в Notebook, поместите туда Paintbox и установите его свойство Align в alClient. Далее добавьте нижеследующие строчки в секцию Private вашей формы:
| Img : TBitmap; DragX, DragY, DragW, DragH, XOff, YOff : Integer; |
В обработчике формы OnCreate:
| Img := TBitmap.Create; |
В общем, для всех перетаскиваемых компонентов, обработчике события OnMouseDown:
| IF NOT (ssShift IN Shift) THEN Exit; Img := GetFormImage; Notebook1.PageIndex := 1; WITH Sender AS TControl DO BEGIN DragW := Width; DragH := Height; XOff:= X; YOff := Y; BeginDrag(True); END; |
В общем, для всех перетаскиваемых компонентов, обработчике события EndDrag:
| Notebook1.PageIndex := 0; WITH Sender AS Tcontrol DO BEGIN Left := X-Xoff; Top := Y-YOff; END; |
Поместите следующую строку в обработчик события OnPaint компонента PaintBox:
| PaintBox1.Canvas.Draw(0, 0, Img); |
И наконец, если вам еще это не надоело, поместите следующую строчку в обработчик OnDragOver компонента PaintBox:
| IF (X=DragX) AND (Y=DragY) THEN Exit; WITH PaintBox1.Canvas DO BEGIN DrawFocusRect(Bounds(DragX-XOff, DragY-YOff, DragW, DragH); DragX := X; DragY := Y; DrawFocusRect(Bounds(DragX-XOff, DragY-YOff, DragW, DragH); END; |
ФУ!! Но это работает! Я не хотел убирать в компонентах возможность перетаскивания их мышью обычным способом, поэтому для включения дополнительной характеристики необходимо при старте держать нажатой клавишу Shift. Попробуйте это!
- NEil
Я пытаюсь "потаскать" TPanel, используемую в качестве ToolBar и всегда почему-то получаю иконку с перечеркнутым кругом. Я понимаю, что это означает невозможность перетаскивания. К сожалению, в документации я ничего не нашел как решить эту проблему. Я пробовал и ручные, и автоматические настройки (DragMode = dmManual/dmAutomatic - В.О.), но все без толку.
Иногда я вообще не могу "оторвать" TPanel!
Начнем с самого начала. Причина того, что вы получаете курсор "crNoDrop" в том, что под курсором элемент управления не готов принять перетаскиваемый компонент. Чтобы исправить эту ситуацию, дважды щелкните (в Инспекторе Объектов) на событии формы или компонента OnDragOver и установите параметр Accept в, например так:
|
procedure TForm1.FormDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean); begin Accept := true ; end; |
Благодарю за пример создания прямоугольника при перетаскивании. Ваши инструкции помогли мне первое время и я легко интегрировал ваш код в мое приложение. Но если вы не возражаете, я хотел бы получить другой небольшой совет .... есть ли возможность во время операции перетаскивания (PaintBox1DragOver) работать с элементами управления, находящимимя под PainBox с тем, чтобы они также изменяли курсор и также могли бы принимать перетаскиваемый элемент? Когда перетаскиваемый элемент выдает сообщение EndDrag, параметр Target должен быть PaintBox (логически).
Можно как-то определить, с каким конкретно элементом управления, расположенным под PainBox, взаимодействует в данный момент перетаскиваемый элемент (для его акцептования)? Я опять что-то упустил, но я не знаю как это сделать.
Вы можете получить координаты в методе OnDragOver при сравнении BoundsRect с областью компонентов. Например, вы не хотите принимать перетаскиваемый компонент кнопкой, перекрывающей любую другую имеющуюся кнопку. В обработчике OnDragOver напишите примерно следующее:
| FOR N := 0 TO ComponentCount-1 DO IF COmponents[N] IS TButton THEN IF IntersectRect(DummyRect, TControl(Components[N]).BoundsRect, (Bounds(X-XOff, Y-YOff, DragW, DragH)) >0 THEN Accept := False; |
В этом случае курсор будет изменяться на перечеркнутый кружок при пересечении перетаскиваемым элементом границы интересующей вас кнопки. Вы должны сделать аналогичную логику или в обработчике EndDrag или OnDragDrop компонента PainBox. [000436]
