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