如何在滚动框上创建缓慢的滚动效果？

Posted 2023-03-06

技术标签:

【中文标题】如何在滚动框上创建缓慢的滚动效果？【英文标题】：How to create a slowing scroll effect on a scrollbox? 【发布时间】：2012-03-16 21:13:39 【问题描述】：

我喜欢在滚动框中平移图像后创建平滑缓慢的滚动效果。就像在maps.google.com 中平移地图一样。我不确定它是什么类型，但行为完全相同：当快速拖动地图时，释放鼠标时它不会立即停止，而是开始减速。

有任何想法、组件、链接或示例吗？

【问题讨论】：

据我所知，周围没有这样的东西，很可能你必须想出你的实现。我找到了 AnimateEasing 类，但我不知道如何使用它。 【参考方案1】：

想法：

根据您的评论，它应该感觉像 Google 地图，因此在拖动图像时，图像应该粘在鼠标指针上；到目前为止不需要特殊效果。但是在释放鼠标按钮时，图像需要以相同的方向进一步移动（滚动框需要平移），并以逐渐缓和的速度，从释放鼠标按钮时的拖动速度开始。

所以我们需要：

按下鼠标时的拖动处理程序：OnMouseMove 将起作用，释放鼠标时的平移速度：在拖动操作过程中，我们会用计时器跟踪最新的速度，释放鼠标后图像仍会移动：我们使用相同的计时器，一种更新GUI的方法：更新图像位置、滚动滚动框和更新滚动条位置。幸运的是，设置滚动框的滚动条的位置就可以了，释放鼠标后逐渐降低速度的功能。我选择了一个简单的线性因子，但您可以尝试一下。

设置：

在您的表单上放置一个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.

【讨论】：

出色的工作！请注意，如果您将图像拖得太慢（没有掉落），它会晃动（但是，如果您放下它，它可以正常工作）。 @TLama 没问题。我倾向于将其归因于图像太大（或计算机太慢；））。您是否尝试过不使用双缓冲？ @NGLN，我试过大尺寸和中等尺寸的图像。关于性能，我可以保持双缓冲关闭，它甚至不会闪烁，但如果我慢慢拖动图像，它会摇晃。我不明白，我会怀疑OnMouseMove 以及FStartPos 和当前位置之间的差异，但即使你远离FStartPos，它也会保持不变。 Here's整个项目（D2009编译，在Windows 7上测试）如果你想看看。 @NGLN，我现在看到了，谢谢！赏金将在几个小时内到达，因为它是应得的 ;-) @TLama 哇，太慷慨了！谢谢！【参考方案2】：

在 MouseClickDown 事件中，将鼠标光标的 X 和 Y 坐标保存在某个全局变量中。

在 MouseMove 事件中计算 DeltaX = SavedX - CurrentX 和 DeltaY = SavedY - CurrentY 值。然后将您的地图/图像/面板滚动 DeltaX/DeltaY 作为绝对值尊重您的地图/图像/面板起始位置。

在 MouseClickUp 事件中，使用上次计算的 DeltaX 和 DeltaY 设置地图/图像/面板的新起始位置（基本上将其保留在原处）并重置 SavedX 和 SavedY 值。

您需要检查最大滚动位置、边框以及当鼠标光标移出应用程序时会发生什么......

【讨论】：

以上是关于如何在滚动框上创建缓慢的滚动效果？的主要内容，如果未能解决你的问题，请参考以下文章

使用滚动按钮创建视差效果

使用CSS和JavaScript创建基本的视差滚动效果

如何在HTML中实现图片的滚动效果

java如何在文本框上加滚动条？

使用jquery animate创建平滑滚动效果

试图创建一个集合视图在滚动时滑过另一个集合视图的效果