Momentum Scrolling

Momentum scrolling is something we havent had as an option in the VJL directly. We excluded it initially because there were excellent JavaScript libraries especially for this (like iScroll), but in retrospect I guess it wouldnt hurt to have it in the VJL written in object pascal.

Here is a little something I slapped together the other day. Im going to make both TListbox and the ordinary content containers have an option for this.

Oooo.. sexy sexy scroller thingy!

 

Note: This supports both mouse and touch, and if you are confused about the event objects then head over to Github and snag a copy of that there. Just remove the references to units you dont have and include eventobjs.pas in your uses clause!

The call to SetInitialTransformationStyles() should be replaced with (this makes the browser mark the element for GPU, which is very fast):

    FContent.Handle.style[BrowserAPI.Prefix('transformStyle')] := 'preserve-3d';
    FContent.Handle.style[BrowserAPI.Prefix('Perspective')] := 800;
    FContent.Handle.style[BrowserAPI.Prefix('transformOrigin')] := '50% 50%';
    FContent.Handle.style[BrowserAPI.Prefix('Transform')] := 'translateZ(0px)';

Oh and it fades out the indicator after a scroll session, quite nice if I say so myself 🙂

Enjoy!

unit Form1;

interface

uses
  System.types, System.Colors,
  System.Events, System.Time, System.Widget, System.Objects,

  W3C.Date, W3C.DOM,

  SmartCL.Effects,

  SmartCL.Events, SmartCL.MouseCapture, SmartCL.System, SmartCL.Graphics,
  SmartCL.Components, SmartCL.Forms,  SmartCL.Fonts, SmartCL.Borders,
  SmartCL.Application, SmartCL.Controls.Listbox, SmartCL.Controls.Panel,
  SmartCL.Controls.CheckBox, SmartCL.Controls.Button;

type

  TScrollContent = class(TW3CustomControl)
  end;

  TW3ScrollIndicator = class(TW3CustomControl)
  end;

  TW3VScrollControl = class(TW3CustomControl)
  private
    FYOffset: integer;
    FContent: TScrollContent;
    FVRange:  TW3Range;
    FHRange:  TW3Range;
    FPressed: boolean;
    FStartY:  integer;

    FTarget: integer;
    FAmplitude: double;
    FTimestamp: integer;
    FVelocity: double;
    FFrame: double;
    FTicker: TW3DispatchHandle;
    FFader: TW3DispatchHandle;
    FTimeConstant: double;

    FMouseDownEvent: TW3DOMEvent;
    FMouseUpEvent: TW3DOMEvent;
    FMouseMoveEvent: TW3DOMEvent;
    FTouchDownEvent: TW3DOMEvent;
    FTouchMoveEvent: TW3DOMEvent;
    FTouchEndsEvent: TW3DOMEvent;

    FIndicator: TW3ScrollIndicator;
    function  GetYPosition(const E: variant): integer;
    procedure MoveBegins(sender: TObject; EventObj: JEvent);
    procedure MoveEnds(sender: TObject; EventObj: JEvent);
    procedure MoveUpdate(sender: TObject; EventObj: JEvent);
    procedure HandleContentSizeChanged(sender: TObject);
  protected
    procedure Track;virtual;
    procedure AutoScroll;virtual;

    procedure ScrollBegins;virtual;
    procedure ScrollEnds;virtual;

    procedure Resize;override;
    procedure InitializeObject; override;
    procedure FinalizeObject; override;
    procedure ObjectReady;override;
    procedure ScrollY(const NewTop: integer);
  public
    Property  Content:TScrollContent read FContent;
  end;

  TForm1 = class(TW3Form)
    procedure W3Button1Click(Sender: TObject);
  private
    {$I "Form1:intf"}
    FBox: TW3VScrollControl;
  protected
    procedure InitializeForm; override;
    procedure InitializeObject; override;
    procedure Resize; override;
  end;

implementation

//###################################################################
// TW3VScrollControl
//###################################################################

procedure TW3VScrollControl.InitializeObject;
begin
  inherited;
  FPressed:=false;
  FYOffset := 0;
  FStartY := 0;

  FTimeConstant := 325;

  Background.fromColor(clWhite);
  FContent := TScrollContent.Create(self);
  FIndicator:=TW3ScrollIndicator.Create(self);
  FIndicator.width:=8;
  FIndicator.height:=32;
  FIndicator.StyleClass:='TW3ScrollContentIndicator';
  FIndicator.Transparent := true;

  FMouseDownEvent := TW3DOMEvent.Create(self);
  FMouseDownEvent.Attach("mousedown");
  FMouseDownEvent.OnEvent := @MoveBegins;

  FMouseMoveEvent := TW3DOMEvent.Create(self);
  FMouseMoveEvent.Attach("mousemove");
  FMouseMoveEvent.OnEvent := @MoveUpdate;

  FMouseUpEvent := TW3DOMEvent.Create(self);
  FMouseUpEvent.Attach("mouseup");
  FMouseUpEvent.OnEvent := @MoveEnds;

  FTouchDownEvent := TW3DOMEvent.Create(self);
  FTouchDownEvent.Attach("touchstart");
  FTouchDownEvent.OnEvent:= @MoveBegins;

  FTouchMoveEvent := TW3DOMEvent.Create(self);
  FTouchMoveEvent.Attach("touchmove");
  FTouchMoveEvent.OnEvent := @MoveUpdate;

  FTouchEndsEvent := TW3DOMEvent.Create(self);
  FTouchEndsEvent.Attach("touchend");
  FTouchEndsEvent.OnEvent := @MoveEnds;

  FContent.Handle.ReadyExecute(
  procedure ()
  begin
    (* Mark content for GPU acceleration *)
    FContent.SetInitialTransformationStyles;
  end);
end;

procedure TW3VScrollControl.ObjectReady;
begin
  inherited;
  FContent.OnReSize := HandleContentSizeChanged;
  FIndicator.left:=ClientWidth-FIndicator.width;
  FIndicator.bringToFront;
  FIndicator.Visible:=false;
  resize;
end;

procedure TW3VScrollControl.FinalizeObject;
begin
  FContent.free;
  inherited;
end;

procedure TW3VScrollControl.HandleContentSizeChanged(sender: TObject);
begin
  if not (csDestroying in ComponentState) then
  begin
    FVRange := TW3Range.Create(0, FContent.Height - ClientHeight);
    FHRange := TW3Range.Create(0, FContent.Width - ClientWidth);
  end;
end;

procedure TW3VScrollControl.Resize;
var
  LClient:  TRect;
begin
  inherited;
  if (csReady in ComponentState) then
  begin
    LClient := ClientRect;
    FVRange := TW3Range.Create(0, FContent.Height - LClient.Height);
    FHRange := TW3Range.Create(0, FContent.Width - LClient.Width);
    FContent.SetBounds(0,FContent.top,LClient.Width,FContent.height);
    FIndicator.MoveTo(ClientWidth-FIndicator.Width,FIndicator.top);
  end;
end;

procedure TW3VScrollControl.ScrollY(const NewTop: integer);
var
  LGPU: string;
  LIndicatorTarget: integer;

  function GetRelativePos:double;
  begin
    result := (ClientHeight - FIndicator.Height) / (FContent.Height - ClientHeight);
  end;

begin
  if not (csDestroying in ComponentState) then
  begin
    if (csReady in ComponentState) then
    begin
      (* Use GPU scrolling to position the content *)
      FYOffset := FVRange.ClipTo(NewTop);
      LGPU := "translate3d(0px,";
      LGPU += FloatToStr(-FYOffset) + "px, 0px)";
      FContent.Handle.style[BrowserAPI.Prefix("Transform")] := LGPU;

      (* Use GPU scrolling to position the indicator *)
      LIndicatorTarget := FYOffset * GetRelativePos;
      FIndicator.left := clientwidth - FIndicator.width;
      LGPU :="translateY(" + TInteger.ToPxStr(LIndicatorTarget) + ")";
      FIndicator.Handle.style[BrowserAPI.Prefix("Transform")]:= LGPU;
    end;
  end;
end;

procedure TW3VScrollControl.Track;
var
  LNow: integer;
  Elapsed: integer;
  Delta: double;
  V: double;
begin
  LNow := TW3Dispatch.JsNow.now();
  Elapsed := LNow - FTimestamp;
  FTimestamp := TW3Dispatch.JsNow.now();
  Delta := FYOffset - FFrame;
  FFrame := FYOffset;
  v := 1000 * Delta / (1 + Elapsed);
  FVelocity := 0.8 * v + 0.2 * FVelocity;
end;

procedure TW3VScrollControl.ScrollBegins;
begin
  TW3Dispatch.ClearInterval(FFader);
  if not (csDestroying in ComponentState) then
  begin
    FIndicator.Visible := true;
    FIndicator.AlphaBlend := true;
    FIndicator.Opacity := 255;
  end;
end;

procedure TW3VScrollControl.ScrollEnds;
begin
  TW3Dispatch.ClearInterval(FFader);
  if not (csDestroying in ComponentState) then
  begin
    FFader:=TW3Dispatch.SetInterval(procedure ()
      begin
        FIndicator.AlphaBlend := true;
        FIndicator.Opacity := FIndicator.Opacity - 10;
        if FIndicator.Opacity=0 then
        begin
          TW3Dispatch.ClearInterval(FFader);
        end;
      end,
      50);
  end;
end;

procedure TW3VScrollControl.AutoScroll;
var
  Elapsed: integer;
  Delta: double;
begin
  if FAmplitude<>0 then
  begin
    Elapsed := TW3Dispatch.JsNow.now() - FTimestamp;
    Delta := -FAmplitude * Exp(-Elapsed / FTimeConstant);
  end;

  (* Scrolled passed end-of-document ? *)
  if (FYOffset >= (FContent.Height - ClientHeight)) then
  begin
    TW3Dispatch.ClearInterval(FTicker);
    FTicker := unassigned;
    ScrollY(FContent.Height-ClientHeight);
    ScrollEnds;
    exit;
  end;

  (* Scrolling breaches beginning of document? *)
  if (FYOffset < 0) then   begin     TW3Dispatch.ClearInterval(FTicker);     FTicker := unassigned;     ScrollY(0);     ScrollEnds;     exit;   end;   if (delta > 5) or (delta < -5) then   begin     ScrollY(FTarget + Delta);     W3_RequestAnimationFrame(AutoScroll);   end else   begin     ScrollY(FTarget);     ScrollEnds;   end; end; function TW3VScrollControl.GetYPosition(const e: variant): integer; begin   if ( (e.targetTouches) and (e.targetTouches.length >0)) then
  result := e.targetTouches[0].clientY else
  result := e.clientY;
end;

procedure TW3VScrollControl.MoveBegins(sender: TObject; EventObj: JEvent);
begin
  FPressed := true;
  FStartY := GetYPosition(EventObj);
  FVelocity := 0;
  FAmplitude := 0;
  FFrame := FYOffset;
  FTimestamp := TW3Dispatch.JsNow.now();
  TW3Dispatch.ClearInterval(FTicker);
  FTicker := TW3Dispatch.SetInterval(Track,100);
  EventObj.preventDefault();
  EventObj.stopPropagation();
end;

procedure TW3VScrollControl.MoveUpdate(sender: TObject; EventObj: JEvent);
var
  y, delta: integer;
begin
  if FPressed then
  begin
    y := GetYPosition(eventObj);
    delta := (FStartY - Y);
    if (Delta>2) or (Delta < -2) then     begin       FStartY := Y;       ScrollY(FYOffset + Delta);     end;   end;   EventObj.preventDefault();   EventObj.stopPropagation(); end; procedure TW3VScrollControl.MoveEnds(sender: TObject; EventObj: JEvent); begin   FPressed := false;   TW3Dispatch.ClearInterval(FTicker);   if (FVelocity > 10) or (FVelocity < -10) then
  begin
    FAmplitude := 0.8 * FVelocity;
    FTarget := round(FYOffset + FAmplitude);
    FTimeStamp := TW3Dispatch.JsNow.Now();

    ScrollBegins;
    w3_requestAnimationFrame(autoscroll);
  end;
  EventObj.preventDefault();
  EventObj.stopPropagation();
end;

{ TForm1 }

procedure TForm1.W3Button1Click(Sender: TObject);
begin
  self.FBox.Content.height:=1000;
end;

procedure TForm1.InitializeForm;
begin
  inherited;

  // this is a good place to initialize components
  FBox := TW3VScrollControl.Create(self);
  FBox.SetBounds(10,10,300,300);

  //

  var LText :="
<table cellpadding=|0px| style=|border-collapse: collapse| width=|100%|>";
  for var x:=1 to 400 do
  begin
    if ((x div 2) * 2) = x then
    LText += "
<tr padding=|0px| style=|border: 0px solid black; background:#ECECEC|>" else
    LText += "
<tr style=|border: 0px solid black; background:#FFFFFF|>";
    LText += "
<td padding=|0px| height=|32px| style=|border-bottom: 1px solid #ddd|>" + x.toString + "</td>
";
    LText += "
<td style=|border-bottom: 1px solid #ddd|>List item #" + x.toString + "</td>
";
    LText += "</tr>
";
  end;
  LText +="</table>
";
  LText := StrReplace(LText,'|','''');

  FBox.Content.innerHTML := LText;
  FBox.Content.width:=1000;
  FBox.Content.height := FBox.Content.ScrollInfo.ScrollHeight;

end;

procedure TForm1.InitializeObject;
begin
  inherited;
  {$I "Form1:impl"}
end;

procedure TForm1.Resize;
begin
  inherited;
  if (csReady in ComponentState) then
  begin
    //FBox.setBounds(10,10,clientwidth div 2, clientHeight div 2);
  end;
end;

initialization
begin
  Forms.RegisterForm({$I %FILE%}, TForm1);
end;

end.