Ответ 1
Идея:
В соответствии с вашим комментарием он должен выглядеть как Карты Google и, таким образом, при перетаскивании изображения изображение должно придерживаться указателя мыши; никаких специальных эффектов пока не требуется. Но при отпускании кнопки мыши изображение должно перемещаться (окно прокрутки необходимо скопировать) далее в том же направлении и с постепенным ускорением, начиная с скорости перетаскивания в момент отпускания кнопки мыши.
Итак, нам нужно:
- обработчик перетаскивания при нажатии мыши:
OnMouseMove
будет работать, - скорость панорамирования в момент отпускания мыши: во время операции перетаскивания мы будем отслеживать последнюю скорость с помощью таймера,
- то, что по-прежнему перемещает изображение после выключения мыши: мы используем один и тот же таймер,
- способ обновления графического интерфейса: обновление положения изображения, прокрутка окна прокрутки и обновление позиций полосы прокрутки. К счастью, установка положения полос прокрутки в окне прокрутки сделает все это,
- функция постепенного уменьшения скорости после выключения мыши. Я выбрал простой линейный коэффициент, но вы можете поэкспериментировать с этим.
Настройка:
- Отбросьте a
TScrollBox
в своей форме, создайте обработчики событий дляOnMouseDown
,OnMouseMove
иOnMouseUp
и установите для свойстваDoubleBuffered
значениеTrue
(это должно быть выполнено во время выполнения), - Отбросьте a
TTimer
в своей форме, установите его интервал в 15 миллисекунд (частота обновления ~ 67 Гц) и создайте обработчик событий дляOnTimer
, - Отбросьте a
TImage
в поле прокрутки, загрузите изображение, установите размер на что-то большое (например, 3200 x 3200), установитеStretch
наTrue
и установитеEnabled
наFalse
, чтобы мыши в окно прокрутки.
Код (для окна прокрутки):
unit Unit1;
interface
uses
Windows, SysUtils, Classes, Controls, Forms, JPEG, ExtCtrls, StdCtrls;
type
TForm1 = class(TForm)
ScrollBox: TScrollBox;
Image: TImage;
TrackingTimer: TTimer;
procedure ScrollBoxMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ScrollBoxMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure ScrollBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TrackingTimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FDragging: Boolean;
FPrevScrollPos: TPoint;
FPrevTick: Cardinal;
FSpeedX: Single;
FSpeedY: Single;
FStartPos: TPoint;
function GetScrollPos: TPoint;
procedure SetScrollPos(const Value: TPoint);
public
property ScrollPos: TPoint read GetScrollPos write SetScrollPos;
end;
implementation
{$R *.dfm}
procedure TForm1.FormCreate(Sender: TObject);
begin
ScrollBox.DoubleBuffered := True;
end;
function TForm1.GetScrollPos: TPoint;
begin
with ScrollBox do
Result := Point(HorzScrollBar.Position, VertScrollBar.Position);
end;
procedure TForm1.ScrollBoxMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := True;
FPrevTick := GetTickCount;
FPrevScrollPos := ScrollPos;
TrackingTimer.Enabled := True;
FStartPos := Point(ScrollPos.X + X, ScrollPos.Y + Y);
Screen.Cursor := crHandPoint;
end;
procedure TForm1.ScrollBoxMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if FDragging then
ScrollPos := Point(FStartPos.X - X, FStartPos.Y - Y);
end;
procedure TForm1.ScrollBoxMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := False;
Screen.Cursor := crDefault;
end;
procedure TForm1.SetScrollPos(const Value: TPoint);
begin
ScrollBox.HorzScrollBar.Position := Value.X;
ScrollBox.VertScrollBar.Position := Value.Y;
end;
procedure TForm1.TrackingTimerTimer(Sender: TObject);
var
Delay: Cardinal;
begin
Delay := GetTickCount - FPrevTick;
if FDragging then
begin
if Delay = 0 then
Delay := 1;
FSpeedX := (ScrollPos.X - FPrevScrollPos.X) / Delay;
FSpeedY := (ScrollPos.Y - FPrevScrollPos.Y) / Delay;
end
else
begin
if (Abs(FSpeedX) < 0.005) and (Abs(FSpeedY) < 0.005) then
TrackingTimer.Enabled := False
else
begin
ScrollPos := Point(FPrevScrollPos.X + Round(Delay * FSpeedX),
FPrevScrollPos.Y + Round(Delay * FSpeedY));
FSpeedX := 0.83 * FSpeedX;
FSpeedY := 0.83 * FSpeedY;
end;
end;
FPrevScrollPos := ScrollPos;
FPrevTick := GetTickCount;
end;
end.
Код (для панели):
И если вам не нужны полосы прокрутки, используйте следующий код. В примере используется панель в качестве контейнера, но это может быть любой оконный элемент управления или сама форма.
unit Unit2;
interface
uses
Windows, SysUtils, Classes, Controls, Forms, JPEG, ExtCtrls, Math;
type
TForm2 = class(TForm)
Panel: TPanel;
Image: TImage;
TrackingTimer: TTimer;
procedure PanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PanelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PanelMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure TrackingTimerTimer(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
FDragging: Boolean;
FPrevImagePos: TPoint;
FPrevTick: Cardinal;
FSpeedX: Single;
FSpeedY: Single;
FStartPos: TPoint;
function GetImagePos: TPoint;
procedure SetImagePos(Value: TPoint);
public
property ImagePos: TPoint read GetImagePos write SetImagePos;
end;
implementation
{$R *.dfm}
procedure TForm2.FormCreate(Sender: TObject);
begin
Panel.DoubleBuffered := True;
end;
function TForm2.GetImagePos: TPoint;
begin
Result.X := Image.Left;
Result.Y := Image.Top;
end;
procedure TForm2.PanelMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := True;
FPrevTick := GetTickCount;
FPrevImagePos := ImagePos;
TrackingTimer.Enabled := True;
FStartPos := Point(X - Image.Left, Y - Image.Top);
Screen.Cursor := crHandPoint;
end;
procedure TForm2.PanelMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FDragging then
ImagePos := Point(X - FStartPos.X, Y - FStartPos.Y);
end;
procedure TForm2.PanelMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := False;
Screen.Cursor := crDefault;
end;
procedure TForm2.SetImagePos(Value: TPoint);
begin
Value.X := Max(Panel.ClientWidth - Image.Width, Min(0, Value.X));
Value.Y := Max(Panel.ClientHeight - Image.Height, Min(0, Value.Y));
Image.SetBounds(Value.X, Value.Y, Image.Width, Image.Height);
end;
procedure TForm2.TrackingTimerTimer(Sender: TObject);
var
Delay: Cardinal;
begin
Delay := GetTickCount - FPrevTick;
if FDragging then
begin
if Delay = 0 then
Delay := 1;
FSpeedX := (ImagePos.X - FPrevImagePos.X) / Delay;
FSpeedY := (ImagePos.Y - FPrevImagePos.Y) / Delay;
end
else
begin
if (Abs(FSpeedX) < 0.005) and (Abs(FSpeedY) < 0.005) then
TrackingTimer.Enabled := False
else
begin
ImagePos := Point(FPrevImagePos.X + Round(Delay * FSpeedX),
FPrevImagePos.Y + Round(Delay * FSpeedY));
FSpeedX := 0.83 * FSpeedX;
FSpeedY := 0.83 * FSpeedY;
end;
end;
FPrevImagePos := ImagePos;
FPrevTick := GetTickCount;
end;
end.
Код (для поля для печати):
И когда размеры изображения безграничны (например, глобус), вы можете использовать красящую коробку для склеивания изображения вместе.
unit Unit3;
interface
uses
Windows, SysUtils, Classes, Graphics, Controls, Forms, ExtCtrls, JPEG;
type
TForm3 = class(TForm)
Painter: TPaintBox;
Tracker: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure PainterMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PainterMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
procedure PainterMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure PainterPaint(Sender: TObject);
procedure TrackerTimer(Sender: TObject);
private
FDragging: Boolean;
FGraphic: TGraphic;
FOffset: Integer;
FPrevOffset: Integer;
FPrevTick: Cardinal;
FSpeed: Single;
FStart: Integer;
procedure SetOffset(Value: Integer);
public
property Offset: Integer read FOffset write SetOffset;
end;
implementation
{$R *.dfm}
procedure TForm3.FormCreate(Sender: TObject);
begin
DoubleBuffered := True;
FGraphic := TJPEGImage.Create;
FGraphic.LoadFromFile('gda_world_map_small.jpg');
Constraints.MaxWidth := FGraphic.Width + 30;
end;
procedure TForm3.FormDestroy(Sender: TObject);
begin
FGraphic.Free;
end;
procedure TForm3.PainterMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := True;
FPrevTick := GetTickCount;
FPrevOffset := Offset;
Tracker.Enabled := True;
FStart := X - FOffset;
Screen.Cursor := crHandPoint;
end;
procedure TForm3.PainterMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
if FDragging then
Offset := X - FStart;
end;
procedure TForm3.PainterMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
FDragging := False;
Screen.Cursor := crDefault;
end;
procedure TForm3.PainterPaint(Sender: TObject);
begin
Painter.Canvas.Draw(FOffset, 0, FGraphic);
Painter.Canvas.Draw(FOffset + FGraphic.Width, 0, FGraphic);
end;
procedure TForm3.SetOffset(Value: Integer);
begin
FOffset := Value;
if FOffset < -FGraphic.Width then
begin
Inc(FOffset, FGraphic.Width);
Dec(FStart, FGraphic.Width);
end
else if FOffset > 0 then
begin
Dec(FOffset, FGraphic.Width);
Inc(FStart, FGraphic.Width);
end;
Painter.Invalidate;
end;
procedure TForm3.TrackerTimer(Sender: TObject);
var
Delay: Cardinal;
begin
Delay := GetTickCount - FPrevTick;
if FDragging then
begin
if Delay = 0 then
Delay := 1;
FSpeed := (Offset - FPrevOffset) / Delay;
end
else
begin
if Abs(FSpeed) < 0.005 then
Tracker.Enabled := False
else
begin
Offset := FPrevOffset + Round(Delay * FSpeed);
FSpeed := 0.83 * FSpeed;
end;
end;
FPrevOffset := Offset;
FPrevTick := GetTickCount;
end;
end.