Перетаскивание элементов управления c рамкой контура
Автор: NEil
...как перетаскивать элементы управления с контурной рамкой по их форме,
"приклеенной" к курсору? Решение, найденное вами, работать не будет, поскольку
таскаемая рамка не обязательно может находиться в пределах области компонента (а
вы отрисовываете ее только на компоненте).
В общих чертах, вы должны рисовать на всей поверхности формы и даже рабочего
стола, для чего необходимо сделать растровую КОПИЮ окна или десктопа и рисовать
на ней. Вот что нам нужно.
Начните со свеженькой формы. Бросьте на нее компонент Notebook и установите
его свойство Align в alClient. Разработайте форму на первой странице компонента
Notebook. Создайте вторую страницу в Notebook, поместите туда Paintbox и
установите его свойство Align в alClient. Далее добавьте нижеследующие строчки в
секцию Private вашей формы:
Img : TBitmap;
DragX, DragY, DragW, DragH, XOff, YOff : Integer;
|
В обработчике формы OnCreate:
В общем, для всех перетаскиваемых компонентов, обработчике события
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. Попробуйте
это!
Я пытаюсь "потаскать" 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.
|