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

我喜欢在滚动框中平移图像后创建平滑的减慢滚动效果.就像在 maps.google.com中平移地图一样.我不知道它是什么类型,但完全相同的行为：当快速移动地图时,它不会立即停止,但是它开始变慢.

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

解决方法

想法：

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

所以我们需要：

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

建立：

>在表单上删除TScrollBox,为OnMouseDown,OnMouseMove和OnMouseUp创建事件处理程序,并将DoubleBuffered属性设置为True(这需要在运行时完成),
>在您的表单上删除TTimer,将其间隔设置为15毫秒(〜67赫兹刷新率),并为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,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,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,Graphics,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,FGraphic);
  Painter.Canvas.Draw(FOffset + FGraphic.Width,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.

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

解决方法

猜你在找的Delphi相关文章