Перетаскивание картинки мышью
Автор: Пётр Соболь
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;
|