Перетаскивание картинки мышью

Delphi , Синтаксис , Drag and Drop

Автор: Пётр Соболь

type
  TMouseState = (msNormal, msDragging);

var
  FMouseState: TMouseState;
  OldPos, NewPos: TPoint;
  MaxShift: TPoint;
  bar: integer;
  i: integer;

implementation

procedure TForm1.Image1MouseDown(Sender: TObject; Button:
  TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
  with Image1 do
  begin
    MaxShift.X := Parent.Width - Width;
    MaxShift.Y := Parent.Height - Height;
  end;

  if (MaxShift.X > 0) and (MaxShift.Y > 0) then
    Exit;

  if MaxShift.X > 0 then
    MaxShift.X := 0;
  if MaxShift.Y > 0 then
    MaxShift.Y := 0;

  FMouseState := msDragging;
  OldPos := Point(X, Y);
end;

// обработка переноса
procedure TForm1.Image1MouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Integer);
begin
  if FMouseState = msDragging then
    with (Sender as TImage) do
    begin
      NewPos := Point(X - OldPos.X, Y - OldPos.Y);
      if Left + NewPos.X > 0 then
        NewPos.X := -Left;
      if Left + NewPos.X < MaxShift.X then
        NewPos.X := MaxShift.X - Left;
      if Top + NewPos.Y > 0 then
        NewPos.Y := -Top;
      if Top + NewPos.Y < MaxShift.Y then
        NewPos.Y := MaxShift.Y - Top;
      Parent.ScrollBy(NewPos.X, NewPos.Y);
    end;
end;

//возвращение исходных значений
procedure TForm1.Image1MouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
  FMouseState := msNormal;
  Screen.Cursor := crDefault;
  with Sender as TImage do
    Label1.Caption := Format('(%d , %d)', [-Left, -Top]); // отображение координат
end;

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

Вот разбивка функций каждого процедуры:

1. Image1MouseDown: Процедура вызывается, когда пользователь кликнул на изображение левой кнопкой мыши. Она устанавливает переменную FMouseState в значение msDragging, что указывает, что пользовательcurrently dragging the image. Она также рассчитывает максимальное значение сдвига для изображения (т.е., максимальное расстояние от верхнего левого угла родительского контрола) и хранит его в переменной MaxShift.
2. Image1MouseMove: Процедура вызывается, когда пользователь перемещает мышь, держа левую кнопку мыши нажатой. Если FMouseState равно msDragging, она рассчитывает новое положение изображения (учитывая максимальное значение сдвига) и прокручивает родительский контрол на соответствующее количество пикселей с помощью Parent.ScrollBy. Это обеспечивает, что изображение остается в видимой области.
3. Image1MouseUp: Процедура вызывается, когда пользователь отпускает левую кнопку мыши. Она устанавливает FMouseState обратно в значение msNormal, сбрасывает курсор в его стандартную форму и обновляет метку (Label1) с текущими координатами изображения (т.е., его смещением от верхнего левого угла родительского контрола).

Код также включает в себя некоторые ошибки обработки: если максимальное значение сдвига больше 0, она устанавливает соответствующий компонент в положение 0. Это предотвращает изображение от перемещения за пределы видимой области.

Вот несколько предложений по улучшению кода:

• Вместо использования Sender as TImage в каждой процедуре рассмотрите передачу контрола изображения в виде параметра, чтобы сделать код более гибким и повторно используемым.
• Вы можете добавить некоторые визуальные отображения, изменяя форму курсора при перетаскивании (например, crSizeAll) или отображая теневой эффект вокруг изображения.
• Рассмотрите добавление проверок границ для положения изображения, чтобы предотвратить его перемещение за пределы родительского контрола.

В целом, это хорошо написанный код, который реализует основные функции. С некоторыми дополнительными функциями и улучшениями он может стать еще более пользовательским и функциональным.

В статье описывается пример реализации функции перетаскивания изображения мышкой в Delphi с помощью обработчиков событий MouseDown,MouseMove и MouseUp.

Комментарии и вопросы

Получайте свежие новости и обновления по Object Pascal, Delphi и Lazarus прямо в свой смартфон. Подпишитесь на наш Telegram-канал delphi_kansoftware и будьте в курсе последних тенденций в разработке под Linux, Windows, Android и iOS

:: Главная :: Drag and Drop ::