20

スクロールボックスで画像をパンした後、スムーズなスロースクロール効果を作成するのが好きです。マップをmaps.google.comでパンするのと同じです。タイプはわかりませんが、まったく同じ動作です。マップを高速でドラッグすると、マウスを離してもすぐには停止しませんが、速度が低下し始めます。

アイデア、コンポーネント、リンク、サンプルはありますか？

4

2 に答える 2

27

アイデア：

コメントによると、Google マップのように感じられるはずなので、画像をドラッグしている間、画像はマウス ポインターにくっつくはずです。これまでのところ、特殊効果は必要ありません。ただし、マウス ボタンを離すと、イメージはさらに同じ方向に移動する必要があり (スクロール ボックスをパンする必要があります)、マウス ボタンが離された瞬間のドラッグ速度から始めて、徐々に速度を落とします。

したがって、次のものが必要です。

  • マウスが押されたときのドラッグ ハンドラー:OnMouseMove動作します。
  • マウスが離された瞬間のパン速度: ドラッグ操作中は、タイマーで最新の速度を追跡します。
  • マウスを離した後も画像を移動するもの: 同じタイマーを使用します。
  • GUI を更新する方法: 画像の位置を更新し、スクロール ボックスをスクロールし、スクロール バーの位置を更新します。幸いなことに、スクロール ボックスのスクロール バーの位置を設定することで、これらすべてを行うことができます。
  • マウスを離してから徐々に速度を落とす機能。私は単純な線形係数を選択しましたが、それを試すことができます。

設定：

  • フォームに をドロップし、 のTScrollBoxイベント ハンドラーを作成しOnMouseDown、プロパティを にOnMouseMove設定OnMouseUpします(これは実行時に行う必要があります)。DoubleBufferedTrue
  • フォームに をドロップし、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.
于 2012-02-29T16:35:21.300 に答える
0

MouseClickDown イベントで、マウス カーソルの X 座標と Y 座標をグローバル変数に保存します。

MouseMove イベントで、DeltaX = SavedX - CurrentX および DeltaY = SavedY - CurrentY の値を計算します。
次に、マップ/画像/パネルの開始位置に対する絶対値として、マップ/画像/パネルを DeltaX/DeltaY でスクロールします。

MouseClickUp イベントでは、最後に計算された DeltaX と DeltaY を使用して、マップ/画像/パネルの新しい開始位置を設定し (基本的にはそのままにしておきます)、SavedX と SavedY の値をリセットします。

マウスカーソルがアプリケーションの外に出たときに何が起こるかについて、最大スクロール位置、境界線を確認する必要があります....

于 2012-02-28T19:43:27.700 に答える