image - por - efectos scroll

¿Cómo crear un efecto de desplazamiento lento en un cuadro de desplazamiento?

Question

Me gusta crear un efecto de desplazamiento de desaceleración suave después de desplazar una imagen en un cuadro de desplazamiento. Al igual que panear el mapa en maps.google.com . No estoy seguro de qué tipo es, pero exactamente el mismo comportamiento: al arrastrar el mapa con un movimiento rápido, no se detiene de inmediato cuando suelta el mouse, pero comienza a disminuir la velocidad.

¿Alguna idea, componentes, enlaces o muestras?

Answer 1

La idea:

Según su comentario, debe sentirse como Google Maps y, por lo tanto, mientras arrastra la imagen, la imagen debe pegarse al puntero del mouse; No se requieren efectos especiales hasta el momento. Pero al soltar el botón del mouse, la imagen debe moverse (el cuadro de desplazamiento debe moverse) más en la misma dirección y con una velocidad cada vez más lenta, comenzando con la velocidad de arrastre en el momento en que se suelta el botón del mouse.

Así que necesitamos:

• un controlador de arrastre para cuando se presiona el mouse: OnMouseMove funcionará,
• la velocidad de giro en el momento en que se suelta el mouse: durante la operación de arrastre, rastrearemos la última velocidad con un temporizador,
• algo que todavía mueve la imagen después del lanzamiento del mouse: usamos el mismo temporizador,
• una forma de actualizar la GUI: actualizando la posición de la imagen, desplazando el cuadro de desplazamiento y actualizando las posiciones de la barra de desplazamiento. Afortunadamente, establecer la posición de las barras de desplazamiento del cuadro de desplazamiento hará todo eso,
• una función para disminuir gradualmente la velocidad después del lanzamiento del ratón. Lo elegí por un factor lineal simple, pero puedes experimentar con eso.

Preparar:

• TScrollBox un TScrollBox en su formulario, cree controladores de eventos para OnMouseDown , OnMouseMove y OnMouseUp y establezca la propiedad DoubleBuffered en True (esto debe hacerse en tiempo de ejecución),
• TTimer un TTimer en su formulario, establezca su intervalo en 15 milisegundos (~ 67 Hz de frecuencia de actualización) y cree un controlador de eventos para OnTimer ,
• TImage un TImage en el cuadro de desplazamiento, cargue una imagen, establezca el tamaño en algo grande (por ejemplo, 3200 x 3200), establezca Stretch en True y establezca Enabled en False para que los eventos del mouse pasen al cuadro de desplazamiento.

Código (para el cuadro de desplazamiento):

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.

Código (para panel):

Y en caso de que no desee las barras de desplazamiento, utilice el siguiente código. El ejemplo usa un panel como contenedor, pero eso podría ser cualquier control de ventana o el formulario en sí.

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.

Código (para la caja de pintura):

Y cuando las dimensiones de la imagen son ilimitadas (por ejemplo, un globo terráqueo), puede usar un cuadro de pintura para pegar los extremos de la imagen.

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.

Answer 2

En el evento MouseClickDown, guarde las coordenadas X e Y del cursor del mouse en alguna variable global.

En el evento MouseMove, calcule los valores DeltaX = SavedX - CurrentX y DeltaY = SavedY - CurrentY.
Luego desplace su mapa / imagen / panel con DeltaX / DeltaY como un valor absoluto con respecto a la posición inicial de su mapa / imagen / panel.

En el evento MouseClickUp, use los últimos DeltaX y DeltaY calculados para establecer la nueva posición de inicio de su mapa / imagen / panel (esencialmente dejándolo donde está) y reinicie los valores SavedX y SavedY.

Deberá verificar la posición máxima de desplazamiento, el borde, para ver qué sucede cuando el cursor del mouse se sale de la aplicación ...