Содержание материала

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

 

 

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

 

Code:

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;

 

 

Добавить комментарий

Не использовать не нормативную лексику.

Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.

ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!


Защитный код
Обновить