我想在滚动框中平移图像后创建一个平滑的减速滚动效果,就像在maps.google.com地图上平移一样。我不确定它是什么类型,但行为完全相同:当您快速移动地图并释放鼠标时,它不会立即停止,而是开始减速。
有任何想法、组件、链接或示例吗?
根据您的评论,应该感觉像谷歌地图,因此在拖动图像时,图像应该固定在鼠标指针上;到目前为止不需要特殊效果。但是在释放鼠标按钮时,图像需要朝着相同方向并以逐渐减速的速度移动(滚动框需要平移),其起始速度为释放鼠标按钮时的拖动速度。
因此,我们需要以下内容:
OnMouseMove
将起作用,TScrollBox
,为OnMouseDown
、OnMouseMove
和OnMouseUp
创建事件处理程序,并将DoubleBuffered
属性设置为True
(这需要在运行时完成),TTimer
,将其间隔设置为15毫秒(约67 Hz刷新率),并为OnTimer
创建一个事件处理程序,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.