Перетаскивание картинки мышью
Автор: Пётр Соболь
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; |
- << Назад
- Вперёд
Просьба писать ваши замечания, наблюдения и все остальное,
что поможет улучшить предоставляемую информацию на этом сайте.
ВСЕ КОММЕНТАРИИ МОДЕРИРУЮТСЯ ВРУЧНУЮ, ТАК ЧТО СПАМИТЬ БЕСПОЛЕЗНО!