Перетаскивание компонентов в окне приложения

Например: перемещение компонентов с помощью мыши по площади формы в среде разработки Delphi.
Нарисовать в графическом редакторе картинку, сохранить ее в файле с расширенем .bmp.

Поместить в форме 4 компонента типа TImage.
При создании формы (событие формы onCreate) приложения разделить созданную картинку на 4 части и поместить каждую в компоненту Image:

var
  Pict: TImage;
  beginPict := TImage.Create(Self);
  Pict.AutoSize :=
    true;
  Pict.Picture.LoadFromFile('Cus5.bmp');
  Image1.Canvas.CopyRect(Image1.ClientRect,
    Pict.Canvas, Rect(0, 0, Pict.Width div 2, Pict.Height div
    2));
  Image2.Canvas.CopyRect(Image2.ClientRect, Pict.Canvas, Rect(Pict.Width
    div 2, 0, Pict.Width, Pict.Height div
    2));
  Image3.Canvas.CopyRect(Image3.ClientRect, Pict.Canvas, Rect(0, Pict.Height
    div 2, Pict.Width div
    2, Pict.Height));
  Image4.Canvas.CopyRect(Image4.ClientRect,
    Pict.Canvas, Rect(Pict.Width div 2, Pict.Height div 2, Pict.Width,
      Pict.Height
    ));
  Pict.Free;
end;

Все методы используют глобальные переменные:

var
  move: boolean; //определяет режим буксировки, она будет устанавливаться
  в True вначале и в False в концеX0, Y0: Integer;
    //запоминание координат курсора мыши

Метод 1:
Буксировка начинается при нажатии левой кнопки мыши на соответствующем компоненте Image. Поэтому начало определяется событием onMouseDown, обработчик котрого имеет вид:

procedure
  TForm1.Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift:
  TShiftState; X, Y: Integer);
beginif Button <> mbLeft then
  exit;
X0 := X;
Y0 := Y;
move := true;
(Sender as
  TControl).BringToFront;
end;

Сначала в этой процедуре проверяется, нажата ли именно левая кнопка мыши, затем запоминаются координаты мыши именно в этот момент. Задается режим буксировки – переменная move := true. Последний оператор выдвигает методом BringToFront компонент, в котором произошло событие, на передний план. Это позволит ему в дальнейшем перемещаться поверх других аналогичных компонентов.
Во время буксировки компонента работает его обработчик события onMouseMove, имеющий вид:

procedure
  TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
  Integer);
beginif move&nbsp;
then with (Sender as TControl)
  doSetBounds(Left + X - X0, Top + Y - Y0, Width, Height)
  end;

Метод SetBounds изменяет координаты левого верхнего угла на величину сдвига курсора мыши (X - X0 для координаты X и Y - Y0 для координаты Y). Тем самым поддерживается постоянное расположение точки курсора в системе координат компонента, т.е. компонент перемещается вслед за курсором. Ширина Width и высота Height компонента остаются неизменными.
По окончании буксировки, когда пользователь отпустит кнопку мыши, наступит событие . Обработчик этого события onMouseUp должен сожержать всего один оператор:

procedure TForm1.Image1MouseUp(Sender: TObject; Button:
  TMouseButton; Shift: TShiftState; X, Y: Integer);
beginmove :=
  false;
end;

Этот оператор указывает указывает приложению на конец буксировки. Тогода при последующих событиях onMouseMove их обработчик перестанет изменять координаты компонента.
Метод 2:
Основной недостаток рассмотренного метода буксировки – некоторое дрожание изображения при перемещении. Устранить его можно, если перемещать не сам компонент, а его контур, при этом сам компонент перемещается только один раз – в момент окончания буксировки, когда требуемое положение уже выбрано. В этом варианта используются методы рисования на канве. Для их применения требуется еще одна глобальная переменная:

var
  rec: Trect;

Переменная rec будетиспользоваться для запоминания положения перемещаемого курсора компонента.
Начинается процесс буксировки,как и ранее, с события onMouseDown:

procedure TForm1.Image4MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
beginif
  Button <> mbLeft then exit;
X0 := X;
&nbsp;
Y0 := Y;
rec := (Sender as
  TControl).BoundsRect;
move := true;
end;
Оператор: rec := (Sender as
  TControl).BoundsRect;

запоминает в переменной rec исходное положение компонента. В процедуре отсутствует также опереатор BringToFront, поскольку сам компонент не будет перемещаться.
При дальнейшем перемещении мыши срабатывает обработчик события onMouseMove:

procedure
  TForm1.Image4MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
  Integer);
beginif not move then
  exit;
Canvas.DrawFocusRect(rec);
with rec dobeginleft := left + X
  - X0;
right := right + X - X0;
&nbsp;
top := top + Y - Y0;
&nbsp;
bottom := bottom +
  Y - Y0;
X0 := X;
Y0 := Y;
end;
Canvas.DrawFocusRect(rec);
end;

В этой процедуре перерисовывается и сдвигается только прямоугольник контура компонента с помощью метода DrawFocusRect. Первое обращение к этому методу стирает прежнее изображение контура, поскольку повторная прорисовка того же изображения по операции ИЛИ(or) стирает нанесенное ранее изображение. Затем изменяются значения, хранимые в переменной rec, и той же функцией DrawFocusRect осуществляется прорисовка сдвинутого прямоугольника. При этом сам компонент остается на месте.
Когда пользователь отпускает кнопку мыши, наступает событие onMouseUp:

procedure
  TForm1.Image4MouseUp(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState;
  X, Y: Integer);
beginCanvas.DrawFocusRect(rec); { if not (ssAlt in
Shift) then} with (Sender as TControl) do
  beginSetBounds(rec.Left + X -
    X0, rec.Top + Y - Y0, Width, Height);
BringToFront;
end;
move :=
false;
end;

Первый ее оператор стирает последнее изображение контура, а второй оператор перемещает компонент в новую позицию. В обработчике события onMouseUp можно предусмотреть условияотказа от перемещения: например, нажатая клавиша Alt (см. оператор в фигурных скобках).
Полный текст приложения:

unit UMove;
interfaceusesWindows, Messages,
SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Menus, ExtCtrls,
ExtDlgs;
typeTForm1 = class(TForm)Image1: TImage;
  Image2:
  TImage;
  Image3: TImage;
  Image4: TImage;
  procedure
    Image1MouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState;
      X,
    Y: Integer);
  procedure Image1MouseMove(Sender: TObject; Shift: TShiftState;
    X, Y: Integer);
  procedure Image1MouseUp(Sender: TObject; Button:
    TMouseButton; Shift: TShiftState; X, Y: Integer);
  procedure
    FormCreate(Sender: TObject);
  procedure Image4MouseDown(Sender: TObject;
    Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
  procedure
    Image4MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
    Integer);
  procedure Image4MouseUp(Sender: TObject; Button:
    TMouseButton; Shift: TShiftState; X, Y: Integer);
private { Private
declarations } public { Public declarations }
end;
varForm1:
TForm1;
implementation{$R *.DFM}var
  move: boolean;
  X0, Y0:
  Integer;
  rec: Trect;

procedure TForm1.Image1MouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
beginif
  Button <> mbLeft then exit;
X0 := X;
Y0 := Y;
move :=
  true;
(Sender as TControl).BringToFront;
end;

procedure
  TForm1.Image1MouseMove(Sender: TObject; Shift: TShiftState; X, Y:
  Integer);
beginif move then with (Sender as TControl)
  doSetBounds(Left + X - X0, Top + Y - Y0, Width,
  Height)
end;

procedure TForm1.Image1MouseUp(Sender: TObject; Button:
  TMouseButton; Shift: TShiftState; X, Y: Integer);
beginmove :=
  false;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Pict: TImage;
  beginPict := TImage.Create(Self);
  Pict.AutoSize :=
    true;
  Pict.Picture.LoadFromFile('Cus5.bmp');
  Image1.Canvas.CopyRect(Image1.ClientRect,
    Pict.Canvas, Rect(0, 0, Pict.Width div 2, Pict.Height div
    2));
  Image2.Canvas.CopyRect(Image2.ClientRect, Pict.Canvas, Rect(Pict.Width
    div 2, 0, Pict.Width, Pict.Height div
    2));
  Image3.Canvas.CopyRect(Image3.ClientRect, Pict.Canvas, Rect(0, Pict.Height
    div 2, Pict.Width div
    2, Pict.Height));
  Image4.Canvas.CopyRect(Image4.ClientRect,
    Pict.Canvas, Rect(Pict.Width div 2, Pict.Height div 2, Pict.Width,
      Pict.Height
    ));
  Pict.Free;
end;

procedure TForm1.Image4MouseDown(Sender:
  TObject; Button: TMouseButton; Shift: TShiftState; X, Y:
  Integer);
beginif Button <> mbLeft then exit;
X0 := X;
Y0 :=
  Y;
rec := (Sender as TControl).BoundsRect;
move :=
  true;
end;

procedure TForm1.Image4MouseMove(Sender: TObject; Shift:
  TShiftState; X, Y: Integer);
beginif not move then
  exit;
Canvas.DrawFocusRect(rec);
with rec dobeginleft := left + X
  - X0;
right := right + X - X0;
top := top + Y - Y0;
bottom :=
  bottom + Y - Y0;
X0 := X;
Y0 :=
  Y;
end;
Canvas.DrawFocusRect(rec);
end;

procedure
  TForm1.Image4MouseUp(Sender: TObject; Button: TMouseButton; Shift:
    TShiftState;
  X, Y: Integer);
beginCanvas.DrawFocusRect(rec);
if not (ssAlt in
  Shift)thenwith(Sender as TControl) do beginSetBounds(rec.Left + X -
  X0, rec.Top + Y - Y0, Width, Height);
BringToFront;
end;
move :=
false;
end;

Недавно добавленные исходники
• DeLiKaTeS Tetris (Тетрис) 133 • TDictionary Custom Sort 3 315 • Fast Watermark Sources 3 065 • 3D Designer 4 824 • Sik Screen Capture 3 319 • Patch Maker 3 533 • Айболит (remote control) 3 635 • ListBox Drag & Drop 2 995 • Доска для игры Реверси 81 551 • Графические эффекты 3 926 • Рисование по маске 3 231 • Перетаскивание изображений 2 612 • Canvas Drawing 2 735 • Рисование Луны 2 560 • Поворот изображения 2 166 • Рисование стержней 2 161 • Paint on Shape 1 564 • Генератор кроссвордов 2 226 • Головоломка Paletto 1 764 • Теорема Монжа об окружностях 2 213 • Пазл Numbrix 1 682 • Заборы и коммивояжеры 2 052 • Игра HIP 1 279 • Игра Go (Го) 1 224 • Симулятор лифта 1 471 • Программа укладки плитки 1 214 • Генератор лабиринта 1 542 • Проверка числового ввода 1 352 • HEX View 1 489 • Физический маятник 1 355

Перетаскивание компонентов в окне приложения

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