图像 – 如何在滚动条上创建一个减慢的滚动效果？

Delphi 前端之家
前端之家收集整理的这篇文章主要介绍了图像 – 如何在滚动条上创建一个减慢的滚动效果？，前端之家小编觉得挺不错的，现在分享给大家，也给大家做个参考。
我喜欢在滚动框中平移图像后创建平滑的减慢滚动效果.就像在 maps.google.com中平移地图一样.我不知道它是什么类型,但完全相同的行为：当快速移动地图时,它不会立即停止,但是它开始变慢.

任何想法,组件,链接或样品？

解决方法

想法：

根据您的评论,它应该感觉像谷歌地图,因此拖动图像,图像应该坚持鼠标指针;到目前为止还没有特殊效果.但是在释放鼠标按钮时,图像需要在相同的方向上进一步移动(滚动框需要平移),并以逐渐的宽松速度从鼠标按钮释放时的拖动速度开始.

所以我们需要：

>当鼠标被按下时的拖动处理程序：OnMouseMove将工作,
>鼠标释放时的平移速度：在拖动操作期间,我们将使用定时器跟踪最新速度,
>在鼠标释放后仍然移动图像的东西：我们使用相同的计时器,
>更新GUI的方法：更新图像位置,滚动滚动框并更新滚动条位置.幸运的是,设置滚动框的滚动条的位置将会做到这一点,
>鼠标释放后逐渐降低速度的功能.我选择了一个简单的线性因子,但你可以试验一下.

建立：

>在表单上删除TScrollBox,为OnMouseDown,OnMouseMove和OnMouseUp创建事件处理程序,并将DoubleBuffered属性设置为True(这需要在运行时完成),
>在您的表单上删除TTimer,将其间隔设置为15毫秒(〜67赫兹刷新率),并为OnTimer创建事件处理程序,
>在滚动框上放一个TImage,加载图片,将大小设置为大(例如3200 x 3200),将Stretch设置为True,并将Enabled设置为False,使鼠标事件通过滚动框.

代码(滚动框)：

  1. unit Unit1;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows,SysUtils,Classes,Controls,Forms,JPEG,ExtCtrls,StdCtrls;
  7.  
  8. type
  9.   TForm1 = class(TForm)
  10.     ScrollBox: TScrollBox;
  11.     Image: TImage;
  12.     TrackingTimer: TTimer;
  13.     procedure ScrollBoxMouseDown(Sender: TObject; Button: TMouseButton;
  14.       Shift: TShiftState; X,Y: Integer);
  15.     procedure ScrollBoxMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  16.     procedure ScrollBoxMouseUp(Sender: TObject; Button: TMouseButton;
  17.       Shift: TShiftState; X,Y: Integer);
  18.     procedure TrackingTimerTimer(Sender: TObject);
  19.     procedure FormCreate(Sender: TObject);
  20.   private
  21.     FDragging: Boolean;
  22.     FPrevScrollPos: TPoint;
  23.     FPrevTick: Cardinal;
  24.     FSpeedX: Single;
  25.     FSpeedY: Single;
  26.     FStartPos: TPoint;
  27.     function GetScrollPos: TPoint;
  28.     procedure SetScrollPos(const Value: TPoint);
  29.   public
  30.     property ScrollPos: TPoint read GetScrollPos write SetScrollPos;
  31.   end;
  32.  
  33. implementation
  34.  
  35. {$R *.dfm}
  36.  
  37. procedure TForm1.FormCreate(Sender: TObject);
  38. begin
  39.   ScrollBox.DoubleBuffered := True;
  40. end;
  41.  
  42. function TForm1.GetScrollPos: TPoint;
  43. begin
  44.   with ScrollBox do
  45.     Result := Point(HorzScrollBar.Position,VertScrollBar.Position);
  46. end;
  47.  
  48. procedure TForm1.ScrollBoxMouseDown(Sender: TObject; Button: TMouseButton;
  49.   Shift: TShiftState; X,Y: Integer);
  50. begin
  51.   FDragging := True;
  52.   FPrevTick := GetTickCount;
  53.   FPrevScrollPos := ScrollPos;
  54.   TrackingTimer.Enabled := True;
  55.   FStartPos := Point(ScrollPos.X + X,ScrollPos.Y + Y);
  56.   Screen.Cursor := crHandPoint;
  57. end;
  58.  
  59. procedure TForm1.ScrollBoxMouseMove(Sender: TObject; Shift: TShiftState;
  60.   X,Y: Integer);
  61. begin
  62.   if FDragging then
  63.     ScrollPos := Point(FStartPos.X - X,FStartPos.Y - Y);
  64. end;
  65.  
  66. procedure TForm1.ScrollBoxMouseUp(Sender: TObject; Button: TMouseButton;
  67.   Shift: TShiftState; X,Y: Integer);
  68. begin
  69.   FDragging := False;
  70.   Screen.Cursor := crDefault;
  71. end;
  72.  
  73. procedure TForm1.SetScrollPos(const Value: TPoint);
  74. begin
  75.   ScrollBox.HorzScrollBar.Position := Value.X;
  76.   ScrollBox.VertScrollBar.Position := Value.Y;
  77. end;
  78.  
  79. procedure TForm1.TrackingTimerTimer(Sender: TObject);
  80. var
  81.   Delay: Cardinal;
  82. begin
  83.   Delay := GetTickCount - FPrevTick;
  84.   if FDragging then
  85.   begin
  86.     if Delay = 0 then
  87.       Delay := 1;
  88.     FSpeedX := (ScrollPos.X - FPrevScrollPos.X) / Delay;
  89.     FSpeedY := (ScrollPos.Y - FPrevScrollPos.Y) / Delay;
  90.   end
  91.   else
  92.   begin
  93.     if (Abs(FSpeedX) < 0.005) and (Abs(FSpeedY) < 0.005) then
  94.       TrackingTimer.Enabled := False
  95.     else
  96.     begin
  97.       ScrollPos := Point(FPrevScrollPos.X + Round(Delay * FSpeedX),FPrevScrollPos.Y + Round(Delay * FSpeedY));
  98.       FSpeedX := 0.83 * FSpeedX;
  99.       FSpeedY := 0.83 * FSpeedY;
  100.     end;
  101.   end;
  102.   FPrevScrollPos := ScrollPos;
  103.   FPrevTick := GetTickCount;
  104. end;
  105.  
  106. end.

代码(面板)：

如果您不想使用滚动条,请使用以下代码.该示例使用面板作为容器,但可以是任何窗口控件或表单本身.

  1. unit Unit2;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows,Math;
  7.  
  8. type
  9.   TForm2 = class(TForm)
  10.     Panel: TPanel;
  11.     Image: TImage;
  12.     TrackingTimer: TTimer;
  13.     procedure PanelMouseDown(Sender: TObject; Button: TMouseButton;
  14.       Shift: TShiftState; X,Y: Integer);
  15.     procedure PanelMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  16.     procedure PanelMouseUp(Sender: TObject; Button: TMouseButton;
  17.       Shift: TShiftState; X,Y: Integer);
  18.     procedure TrackingTimerTimer(Sender: TObject);
  19.     procedure FormCreate(Sender: TObject);
  20.   private
  21.     FDragging: Boolean;
  22.     FPrevImagePos: TPoint;
  23.     FPrevTick: Cardinal;
  24.     FSpeedX: Single;
  25.     FSpeedY: Single;
  26.     FStartPos: TPoint;
  27.     function GetImagePos: TPoint;
  28.     procedure SetImagePos(Value: TPoint);
  29.   public
  30.     property ImagePos: TPoint read GetImagePos write SetImagePos;
  31.   end;
  32.  
  33. implementation
  34.  
  35. {$R *.dfm}
  36.  
  37. procedure TForm2.FormCreate(Sender: TObject);
  38. begin
  39.   Panel.DoubleBuffered := True;
  40. end;
  41.  
  42. function TForm2.GetImagePos: TPoint;
  43. begin
  44.   Result.X := Image.Left;
  45.   Result.Y := Image.Top;
  46. end;
  47.  
  48. procedure TForm2.PanelMouseDown(Sender: TObject; Button: TMouseButton;
  49.   Shift: TShiftState; X,Y: Integer);
  50. begin
  51.   FDragging := True;
  52.   FPrevTick := GetTickCount;
  53.   FPrevImagePos := ImagePos;
  54.   TrackingTimer.Enabled := True;
  55.   FStartPos := Point(X - Image.Left,Y - Image.Top);
  56.   Screen.Cursor := crHandPoint;
  57. end;
  58.  
  59. procedure TForm2.PanelMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  60. begin
  61.   if FDragging then
  62.     ImagePos := Point(X - FStartPos.X,Y - FStartPos.Y);
  63. end;
  64.  
  65. procedure TForm2.PanelMouseUp(Sender: TObject; Button: TMouseButton;
  66.   Shift: TShiftState; X,Y: Integer);
  67. begin
  68.   FDragging := False;
  69.   Screen.Cursor := crDefault;
  70. end;
  71.  
  72. procedure TForm2.SetImagePos(Value: TPoint);
  73. begin
  74.   Value.X := Max(Panel.ClientWidth - Image.Width,Min(0,Value.X));
  75.   Value.Y := Max(Panel.ClientHeight - Image.Height,Value.Y));
  76.   Image.SetBounds(Value.X,Value.Y,Image.Width,Image.Height);
  77. end;
  78.  
  79. procedure TForm2.TrackingTimerTimer(Sender: TObject);
  80. var
  81.   Delay: Cardinal;
  82. begin
  83.   Delay := GetTickCount - FPrevTick;
  84.   if FDragging then
  85.   begin
  86.     if Delay = 0 then
  87.       Delay := 1;
  88.     FSpeedX := (ImagePos.X - FPrevImagePos.X) / Delay;
  89.     FSpeedY := (ImagePos.Y - FPrevImagePos.Y) / Delay;
  90.   end
  91.   else
  92.   begin
  93.     if (Abs(FSpeedX) < 0.005) and (Abs(FSpeedY) < 0.005) then
  94.       TrackingTimer.Enabled := False
  95.     else
  96.     begin
  97.       ImagePos := Point(FPrevImagePos.X + Round(Delay * FSpeedX),FPrevImagePos.Y + Round(Delay * FSpeedY));
  98.       FSpeedX := 0.83 * FSpeedX;
  99.       FSpeedY := 0.83 * FSpeedY;
  100.     end;
  101.   end;
  102.   FPrevImagePos := ImagePos;
  103.   FPrevTick := GetTickCount;
  104. end;
  105.  
  106. end.

代码(用于绘图框)：

当图像的尺寸是无限的(例如地球仪)时,您可以使用油漆盒将图像的端部粘合在一起.

  1. unit Unit3;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows,Graphics,JPEG;
  7.  
  8. type
  9.   TForm3 = class(TForm)
  10.     Painter: TPaintBox;
  11.     Tracker: TTimer;
  12.     procedure FormCreate(Sender: TObject);
  13.     procedure FormDestroy(Sender: TObject);
  14.     procedure PainterMouseDown(Sender: TObject; Button: TMouseButton;
  15.       Shift: TShiftState; X,Y: Integer);
  16.     procedure PainterMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  17.     procedure PainterMouseUp(Sender: TObject; Button: TMouseButton;
  18.       Shift: TShiftState; X,Y: Integer);
  19.     procedure PainterPaint(Sender: TObject);
  20.     procedure TrackerTimer(Sender: TObject);
  21.   private
  22.     FDragging: Boolean;
  23.     FGraphic: TGraphic;
  24.     FOffset: Integer;
  25.     FPrevOffset: Integer;
  26.     FPrevTick: Cardinal;
  27.     FSpeed: Single;
  28.     FStart: Integer;
  29.     procedure SetOffset(Value: Integer);
  30.   public
  31.     property Offset: Integer read FOffset write SetOffset;
  32.   end;
  33.  
  34. implementation
  35.  
  36. {$R *.dfm}
  37.  
  38. procedure TForm3.FormCreate(Sender: TObject);
  39. begin
  40.   DoubleBuffered := True;
  41.   FGraphic := TJPEGImage.Create;
  42.   FGraphic.LoadFromFile('gda_world_map_small.jpg');
  43.   Constraints.MaxWidth := FGraphic.Width + 30;
  44. end;
  45.  
  46. procedure TForm3.FormDestroy(Sender: TObject);
  47. begin
  48.   FGraphic.Free;
  49. end;
  50.  
  51. procedure TForm3.PainterMouseDown(Sender: TObject; Button: TMouseButton;
  52.   Shift: TShiftState; X,Y: Integer);
  53. begin
  54.   FDragging := True;
  55.   FPrevTick := GetTickCount;
  56.   FPrevOffset := Offset;
  57.   Tracker.Enabled := True;
  58.   FStart := X - FOffset;
  59.   Screen.Cursor := crHandPoint;
  60. end;
  61.  
  62. procedure TForm3.PainterMouseMove(Sender: TObject; Shift: TShiftState; X,Y: Integer);
  63. begin
  64.   if FDragging then
  65.     Offset := X - FStart;
  66. end;
  67.  
  68. procedure TForm3.PainterMouseUp(Sender: TObject; Button: TMouseButton;
  69.   Shift: TShiftState; X,Y: Integer);
  70. begin
  71.   FDragging := False;
  72.   Screen.Cursor := crDefault;
  73. end;
  74.  
  75. procedure TForm3.PainterPaint(Sender: TObject);
  76. begin
  77.   Painter.Canvas.Draw(FOffset,FGraphic);
  78.   Painter.Canvas.Draw(FOffset + FGraphic.Width,FGraphic);
  79. end;
  80.  
  81. procedure TForm3.SetOffset(Value: Integer);
  82. begin
  83.   FOffset := Value;
  84.   if FOffset < -FGraphic.Width then
  85.   begin
  86.     Inc(FOffset,FGraphic.Width);
  87.     Dec(FStart,FGraphic.Width);
  88.   end
  89.   else if FOffset > 0 then
  90.   begin
  91.     Dec(FOffset,FGraphic.Width);
  92.     Inc(FStart,FGraphic.Width);
  93.   end;
  94.   Painter.Invalidate;
  95. end;
  96.  
  97. procedure TForm3.TrackerTimer(Sender: TObject);
  98. var
  99.   Delay: Cardinal;
  100. begin
  101.   Delay := GetTickCount - FPrevTick;
  102.   if FDragging then
  103.   begin
  104.     if Delay = 0 then
  105.       Delay := 1;
  106.     FSpeed := (Offset - FPrevOffset) / Delay;
  107.   end
  108.   else
  109.   begin
  110.     if Abs(FSpeed) < 0.005 then
  111.       Tracker.Enabled := False
  112.     else
  113.     begin
  114.       Offset := FPrevOffset + Round(Delay * FSpeed);
  115.       FSpeed := 0.83 * FSpeed;
  116.     end;
  117.   end;
  118.   FPrevOffset := Offset;
  119.   FPrevTick := GetTickCount;
  120. end;
  121.  
  122. end.

猜你在找的Delphi相关文章

ffmpeg 部分api delphi 版
ffmpeg 是一套强大的开源的多媒体库 一般都是用 c/c++ 调用， 抽空研究了一下该库...
寄存器备忘
32位CPU所含有的寄存器有：4个数据寄存器(EAX、EBX、ECX和EDX)2个变址和指针寄存器(ESI和E...
键位码
指令整理
1 mov dst, src dst是目的操作数，src是源操作数，指令实现的功能是：将源操作数送到目的操...
delphi中ShellExecute使用详解
有三个API函数可以运行可执行文件WinExec、ShellExecute和CreateProcess。 1.CreateProces...
delphi控件安装与删除
附带通用控件安装方法： ---------- 基本安装 1、对于单个控件，Componet-->install co...
Delphi 怎样 把TParams 或 record写到流里面
type   TRec=Record     msg:string;     pic:TMemoryStream; end; procedure TForm2...
一个用delphi写的整合汇编与api的简单的窗口程序
program Project1; { Types and Structures Definition } type   WNDCLASSEX = packed re...
用Delphi模拟键盘输入
   在Windows大行其道的今天，windows界面程序受到广大用户的欢迎。对这些程序的操作不...
Delphi 中的 procedure of object
delphi中经常见到以下两种定义 Type TMouseProc = procedure (X,Y:integer); TMouse...
PHPJavaJava SEPythonC#C&C++RubyVBasp.NetGoPerlnettyDjangoDelphiJsp.NET CoreSpringFlaskSpringbootSpringMVCLuaLaravelMybatisAspGroovyThinkPHPYiiswoole
文件时间pythonm相等性PHP Warning时间问题问题解决pcntl_signal采样点wav模块动态文本调用频率限制对外暴露多个访问请求更新数据表模型结构type()方法比较速度手写体sobel算子保存模型Image类nn.Conv2dpytorch1.0kaggleDCGAN交并比range()用法打印模型反卷积卷积