Недавно добавленные исходники

•  DeLiKaTeS Tetris (Тетрис)  3 669

•  TDictionary Custom Sort  5 800

•  Fast Watermark Sources  5 603

•  3D Designer  8 215

•  Sik Screen Capture  5 913

•  Patch Maker  6 388

•  Айболит (remote control)  6 378

•  ListBox Drag & Drop  5 237

•  Доска для игры Реверси  94 551

•  Графические эффекты  6 570

•  Рисование по маске  5 643

•  Перетаскивание изображений  4 759

•  Canvas Drawing  5 135

•  Рисование Луны  4 863

•  Поворот изображения  4 410

•  Рисование стержней  3 116

•  Paint on Shape  2 360

•  Генератор кроссвордов  3 228

•  Головоломка Paletto  2 551

•  Теорема Монжа об окружностях  3 328

•  Пазл Numbrix  2 200

•  Заборы и коммивояжеры  2 849

•  Игра HIP  1 820

•  Игра Go (Го)  1 740

•  Симулятор лифта  2 072

•  Программа укладки плитки  1 798

•  Генератор лабиринта  2 240

•  Проверка числового ввода  1 924

•  HEX View  2 225

•  Физический маятник  1 911

 
скрыть

  Форум  

Delphi FAQ - Часто задаваемые вопросы

| Базы данных | Графика и Игры | Интернет и Сети | Компоненты и Классы | Мультимедиа |
| ОС и Железо | Программа и Интерфейс | Рабочий стол | Синтаксис | Технологии | Файловая система |



Delphi Sources

Перетаскивание элементов управления c рамкой контура



Автор: NEil

...как перетаскивать элементы управления с контурной рамкой по их форме, "приклеенной" к курсору? Решение, найденное вами, работать не будет, поскольку таскаемая рамка не обязательно может находиться в пределах области компонента (а вы отрисовываете ее только на компоненте).

В общих чертах, вы должны рисовать на всей поверхности формы и даже рабочего стола, для чего необходимо сделать растровую КОПИЮ окна или десктопа и рисовать на ней. Вот что нам нужно.

Начните со свеженькой формы. Бросьте на нее компонент 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. Попробуйте это!

Я пытаюсь "потаскать" 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.





Похожие по теме исходники

Перетаскивание изображений




Copyright © 2004-2025 "Delphi Sources" by BrokenByte Software. Delphi World FAQ

Группа ВКонтакте