我喜欢在滚动框中平移图像后创建平滑的缓慢滚动效果。就像在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.
在 MouseClickDown 事件中,将鼠标光标的 X 和 Y 坐标保存在某个全局变量中。
在 MouseMove 事件中计算 DeltaX = SavedX - CurrentX 和 DeltaY = SavedY - CurrentY 值。
然后通过 DeltaX/DeltaY 滚动您的地图/图像/面板作为绝对值尊重您的地图/图像/面板起始位置。
在 MouseClickUp 事件中,使用最后计算的 DeltaX 和 DeltaY 设置地图/图像/面板的新起始位置(基本上将其保留在原处)并重置 SavedX 和 SavedY 值。
您需要检查最大滚动位置、边框以及当鼠标光标移出应用程序时会发生什么......