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.

scroller

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.
Advertisements
  1. June 1, 2016 at 10:01 pm

    This looks interesting but I’m affraid it cannot be easily used, it references TW3Range, TW3DispatchHandle, TW3DOMEvent which are not yet available in official RTL (and probably won’t be for 3 to 6 months).
    It would help to rewrite it to official SMS 2.2 RTL.

    • Jon Lennart Aasenden
      June 2, 2016 at 8:50 am

      The event stuff is in the event-folder on github. The method used by TW3Dispatch are setTimeout etc.. TW3DispatchHandle = type THandle.
      The value is in the procedures, not the simple stuff. TW3Range is a simple class that defined the range between two numbers, it has quick static test functions like Within(), BeforeStart etc..

  2. June 5, 2016 at 1:26 pm

    Jon, I’ve created a demo using this component
    PREVIEW: http://rawgit.com/smartpascal/smartms/master/games/iSroll_SMS/www/index.html

    but we have an issue “how to calculate the scroll height” when loading remote data, f.i.
    I needed to display images received from a JSON file. I’ll use a template to render the remote data. When images are loaded in the browser, we need to inform the correct scroll height on DOM ready, the client (browser) still don’t know the image height, there are a couple images loading, so the scroll can probably fail in some time. An workaround would be set 150ms timeout and inform a big static height=8200px.

    Handle.ReadyExecute(procedure()
    begin
    w3_SetTimeout(procedure()
    begin
    FBox.Content.height := 8200;
    // FBox.Content.ScrollInfo.ScrollHeight; –> does not work, can calculate wrong scroll height
    end, 150);

    end);

    • Jon Lennart Aasenden
      June 10, 2016 at 11:24 pm

      You would need to have a load-form that displays while resources are loading. The browser will cache up the images.
      Then load the image into a TW3Image control, get the pixel width/height and then adjust the content accordingly?

  3. June 7, 2016 at 5:17 pm

    BTW, with adaptation done by warleyalex (see http://forums.smartmobilestudio.com/index.php?/topic/4105-vscroll-sms-component/), component works in official RTL, and works on desktop and Safari tablet (iPad) but it doesn’t work on windows 10 tablets in Edge/IE, do you know of a solution for it?

  1. No trackbacks yet.

Leave a Reply

Please log in using one of these methods to post your comment:

WordPress.com Logo

You are commenting using your WordPress.com account. Log Out / Change )

Twitter picture

You are commenting using your Twitter account. Log Out / Change )

Facebook photo

You are commenting using your Facebook account. Log Out / Change )

Google+ photo

You are commenting using your Google+ account. Log Out / Change )

Connecting to %s

%d bloggers like this: