Tweening with Smart Mobile Studio, Part 3

This is the third installment on my tween implementation for Smart Mobile Studio. Check out the first article here, and the second article here.

If you have followed this blog and read the two previous installments, you should have a good idea what tweening is, why it’s awesome and “must have” for any serious HTML5 developer. But let’s do a quick re-cap of where we are:

In the first article i did a verbatim conversion of SimpleTween.js, which is a popular and well written javascript library. It’s small, fast, compact and lacks the bling more advanced libraries bring. This gave us the edge since it’s easier to build on a small and clean core.

Once started, CSS animations cannot be stopped or aborted.
They have to run their course

In the second article I setup a GitHub account for Smart Mobile Studio code. I also re-wrote the entire tween system. Instead of having one class representing a single tween (which is overkill considering the data), I established a multi-tween system. A system where you can define as many tween elements as you like, each with different properties and animationtypes, and update them all within a single class.

I also introduced automatic updates, so you dont manually have to call getValue() to update and synchronize the tween to it’s timeline. In fact i have added two methods. First there is a normal TTimer update that executes on interval. Secondly there is a requestAnimationFrame() callback loop, which synchronizes the update with how the browser redraws the display. On a decent PC running Chrome or Safari (both WebKit engines) you can get 120 Fps. It all depends on what the tween elements are supposed to update and what you draw.

Right, so let’s move on with this article.

Software Tweening vs. Hardware Tweening

What is a tween? Well, a tween is just a matter of transforming a value into another value. Forcing the transformation to occur within a given timeframe, applying a mathematical formula to make the transformation smooth and non static.

If you are wondering why we need tweens, think about it this way: Let’s say you want to move a picture of a spaceship across the screen. Or perhaps you want a side menu to slide into view in a serious bussiness application. How will you achieve this?

WC3 RFC documentation gives little clue, but I suspect the
animations are translated into CUDA bytecodes and fed to the GPU

You are probably thinking: oh i can just use a timer, then increment the left position of the spaceship or menu, then keep on going until it reaches the destination co-ordinates.

You are right, you could do it that way. But does it look good? What about the time it takes for your fancy sidemenu or spaceship to scroll into view like that? Will it look good on an older PC? Can you trust it to complete in 1 second or 500 milliseconds? And wont it be utterly booring to just have something move in a single, monotone pace from A to B?

Tweens bring several aspects to the table and helps us improve presentation

• Establishes a timeline
• Can be manually updated
• Mathematically calculates next step
• Skips frames to respect the timeline
• Mathematical easing ensures smooth accelleration
• Formula-based increments are visually pleasing to the eye

One of the most important aspects are no doubt the first two. Being able to define a timeline that the entire animation should execute within is so valuable. It really means everything when writing complex, responsive user interfaces. Because with a timeline you can trust, you can chain transformations together. If you have a tween running that is set to execute for 2 seconds, then you know and can trust that it will be finished in exactly 2 seconds. This means you can now (although you dont write it like this) do silly stuff like this, and you can trust that it works:

Starttween1;
W3_Callback( StartTween2, 1000);
W3_Callback( StartTween3, 2000);
W3_Callback( StartTween4, 3000);

The above would execute all at once, but the W3_CallBack() methods ensure that each call is made step by step. This will create the impression that one long animation is taking place. Why? Because tween2 will start after 1 second (when tween1 is finished), tween3 after 2 seconds and tween4 after 3 seconds. Each of these has a timeline of 1 second, and when you can trust that timeline you have more freedom to build complex scenes without worrying about speed.

But the most valuable point for us is that we can manually update the tweens. One of the hardest things to program under HTML5 are without a shadow of a doubt CSS3 transformations. Tweening is built into all browsers these days, it’s really a fantastic system and makes full use of hardware accelleration to produce flicker free, ultra smooth graphical operations.

The problem is that these GPU based CSS transformations are notoriously difficult to get right. Smart Mobile Studio has a system unlike any other, giving you full control of CSS in crystal clear classes that makes writing complex CSS animations a walk in the park. But CSS transformations suffer a monumental downside in that, once started, CSS animations cannot be stopped or aborted. They have to run their course and can only be released when it’s all done. Why? Well the WC3 RFC documentation gives little clue, but I suspect the animations are translated into CUDA bytecodes and fed to the GPU.

Using software tweens to produce effects

Since the previous article I put in a couple of hours late last night and created the foundation classes for “tween based effects”. You may be wondering how changing a single (or multiple) floating point values following a formula is going to produce something useful, but wait and see.

The effect foundation classes serves several functions:

• Abstract you from the underlying mechanisms
• Each effect class is spesific
• Each effect class expose spesific properties
• Simplify setup and teardown of tweens and/or other dependencies
• Allow direct CSS style and element attribute mapping

The first 4 points are self explanatory i think. I mean, you dont want an effect class with a ton of properties that should be left alone; you want an effect class that exposes just the properties relevant to that effect, and nothing more. You also want to make the effect classes “core agnostic”, meaning that you as a user should not need to know if the class uses CSS or Tweening to achieve its goal.

The really interesting part is the style and attribute mapping. Do you remember how I added a Id property to the tween elements? So each tween can be addressed by name and not just by index or an object reference? Well there is a reason for that.

By default the Id property is just a string, a string that must be unique and just distinguishes one tween from another. This is helpful when you have say, 20 transformations executing at the same time – and you dont want (or cant) keep track of their indexes or object references.

Like this:

var
LItem: TTweenElement;

// Get the tween-element by name
LItem := FTween["first"];

// Finished yet?
if not LItem.Expired then
begin
  //Do something with the tween data
end;

But what if you instead of using the Id for names, use it to identify a CSS style property instead?

See where I’m going with this? Effects naturally applies values to CSS styles. It can be position, color, size, scale, opacity or whatever — but ultimately the values a tween generates end up being applied to a CSS style. In the model i posted yesterday that had to be done manually. You had to grab the value in the OnUpdated event and manually set the “left” property to make something move.

Well, with property and attribute mapping, this can all be done automatically for you.

Property binding

To bind a tween to a CSS property or HTML element’s attributes is not new. In fact, thats what most high-end libraries offer. Libraries like JQuery, Framework 7, Tween.js and pretty much all of them allow you to do this.

In the new model binding is handled by a class called TPropertyBinding. This binding takes over the OnUpdated event of TTweenElement, grabs the value and applies it whatever style or attribute you are binding to. Neat? Yeah i think so. TWidgetEffect, which is the effect class you want to use for property binding, exposes a nice Bind() method.

  TPropertyBindingtype = (pbStyle,pbAttribute);

  TPropertyBinding = class(TObject)
  protected
    procedure   HandleElementUpdated(item:TTweenElement);
  public
    property    Effect:TCustomControlEffect;
    Property    Tween:TTweenElement;
    property    BindingType:TPropertyBindingtype;
    Constructor Create(aEffect:TCustomControlEffect;
                aTween:TTweenElement;
                aBindingtype:TPropertyBindingtype);
  end;

  TWidgetEffect = class(TCustomControlEffect)
  private
    FBindings:  Array of TPropertyBinding;
  public
    procedure DoSetupTween;override;
    function Bind(PropertyName:String;&Type:TPropertyBindingtype):TPropertyBinding;
  end;

So let’s demonstrate with a clean cut example. Let’s say you have a side-menu, a panel, on the left side of the screen. You dont want this to be visible all the time so it remains hidden until the user clicks a glyph. When the user clicks the glyph, the menu slides in from the left. So what would it take to create an effect class that does this? Not much!

type
  TMoveEffect = Class(TWidgetEffect)
  public
    procedure DoSetupTween;override;
  end;

procedure TMoveEffect.DoSetupTween;
begin
  // Bind to the "obj.style.left" property
  var Binding := Bind('left',pbStyle);

  // Get the tween object from the binding
  var Tween := Binding.Tween;

  // Setup the tween object properly
  Tween.AnimationType := ttQuartInOut;
  Tween.Behavior:=tbSingle;
  Tween.StartValue :=-200; // start off the left edge of the screen
  Tween.Duration := 400;  // last for 400 ms
  Tween.Distance := 200;  // move 200 pixels to the right
end;

In a real effect your would expose the tween options as properties, here i just hard-coded them. It’s just an example. To use the effect and apply it to our side-menu, you would call it like this:

var effect := TMoveEffect.Create(MenuPanel);
effect.execute( procedure ()
  begin
    effect.free;
  end);

See how cool this is? We simply create the effect, pass the target control as a parameter in the constructor, execute it – passing the OnFinish callback as a parameter, and thats it. When the transformation is done it calls the OnFinished event, and there we release the instance.

Binding types

If you know your way around Smart Mobile Studio, you are probably thinking “But wait a minute, CSS styles are not all floating point values, and even if they were -things like opacity is formated differently and goes from 0.0 to 1.0”. Some CSS styles are even string based and requires a completely different representation. Like say, when you want to apply a tween on a color. A floating point number of 700.56 is not going to do much for you.

The next step is naturally to introduce different types of binding classes. Right now we have a single generic binding class that just takes the tween value and applies it to a named style. That will work on properties like Left, Top, Width and Height; but we need bindings that translates the values into correct data.

So, new-years eve not withstanding, I will add more binding types which target spesific types of CSS properties in the weeks to come. I dont know when i have enough time to finish this, but hopefully I get to squeeze in an hour or two here and there.

Updates

Get the code on GitHub

You will find the updated units on GitHub, so head over to: https://github.com/quartexNOR/smartpascal to grab the latest. For those that cannot use Github right now, here is the latest source:

unit system.animation.effects;

interface

uses
  SmartCL.System, SmartCL.Graphics, SmartCL.Components, SmartCL.Forms,
  SmartCL.Fonts, SmartCL.Borders, SmartCL.Application,
  System.Types,
  System.Colors,
  system.animation.tween;

type

  TCustomEffect = class(Tobject)
  protected
    procedure DoExecute;virtual;abstract;
    procedure DoCancel;virtual;abstract;
    procedure DoPause;virtual;abstract;
    procedure DoResume;virtual;abstract;
    function  DoGetActive:Boolean;virtual;abstract;
  public
    Property  OnEffectStarted:TNotifyEvent;
    Property  OnEffectDone:TNotifyEvent;
    Property  OnEffectPaused:TNotifyEvent;
    property  OnEffectCanceled:TNotifyEvent;

    Property  Active:Boolean read DoGetActive;
    procedure Execute(OnReady:TNotifyEvent);virtual;
    procedure Cancel;virtual;
    procedure Pause;virtual;
    procedure Resume;virtual;
  end;

  TCustomTweenEffect = class(TCustomEffect)
  private
    FTween:     TW3Tween;
  protected
    procedure   DoExecute;override;
    procedure   DoCancel;override;
    procedure   DoPause;override;
    procedure   DoResume;override;
    function    DoGetActive:Boolean;override;
  protected
    procedure   DoSetupTween;virtual;
    procedure   DoTearDownTween;virtual;
  protected
    procedure   HandleTweenDone(sender:TObject);virtual;
    procedure   HandleTweenStart(sender:TObject);virtual;
    procedure   HandleTweenUpdated(Sender:TObject);virtual;
    property    Core:TW3Tween read Ftween;
  public
    Property    Busy:Boolean read ( FTween.active );

    procedure   Execute(OnReady:TNotifyEvent);override;
    procedure   Cancel;override;
    procedure   Pause;override;
    procedure   Resume;override;

    Constructor Create;virtual;
    Destructor  Destroy;Override;
  end;

  TCustomControlEffect = class(TCustomTweenEffect)
  private
    FControl:   TW3MovableControl;
  public
    Property    Control:TW3MovableControl read FControl;
    Constructor Create(aControl: TW3MovableControl);overload;virtual;
  end;

  TMoveXEffect = class(TCustomControlEffect)
  protected
    procedure   DoSetupTween;override;
    procedure   DoTearDownTween;override;
  public
    Property    Duration:float;
    Property    FromX: Integer;
    Property    Distance:Integer;
  end;

  TMoveYEffect = class(TCustomControlEffect)
  protected
    procedure   DoSetupTween;override;
    procedure   DoTearDownTween;override;
  public
    Property    Duration:float;
    Property    FromY: Integer;
    Property    Distance:Integer;
  end;

  TPropertyBindingtype = (pbStyle,pbAttribute);

  TPropertyBinding = class(TObject)
  protected
    procedure   HandleElementUpdated(item:TTweenElement);
  public
    property    Effect:TCustomControlEffect;
    Property    Tween:TTweenElement;
    property    BindingType:TPropertyBindingtype;
    Constructor Create(aEffect:TCustomControlEffect;
                aTween:TTweenElement;
                aBindingtype:TPropertyBindingtype);
  end;

  TWidgetEffect = class(TCustomControlEffect)
  private
    FBindings:  Array of TPropertyBinding;
  public
    procedure DoSetupTween;override;
    function Bind(PropertyName:String;&Type:TPropertyBindingtype):TPropertyBinding;
  end;

implementation

procedure TWidgetEffect.DoSetupTween;
begin
  var Binding := Bind('left',TPropertyBindingtype.pbAttribute);
end;

function TWidgetEffect.Bind(PropertyName:String;&Type:TPropertyBindingtype):TPropertyBinding;
var
  Ltween: TTweenElement;
begin
  Ltween := Core.Add(PropertyName);
  result := TpropertyBinding.Create(self, Ltween, &Type);
end;

//#############################################################################
// TPropertyBinding
//#############################################################################

Constructor TPropertyBinding.Create(aEffect:TCustomControlEffect;
            aTween:TTweenElement;
            aBindingtype:TPropertyBindingtype);
begin
  inherited Create;
  Effect := aEffect;
  Tween := aTween;
  Bindingtype := aBindingType;
  Tween.OnUpdated := HandleElementUpdated;
end;

procedure TPropertyBinding.HandleElementUpdated(item:TTweenElement);
begin
  case Bindingtype of
  pbStyle:      w3_setStyle(Effect.Control.Handle,item.id,item.value);
  pbAttribute:  w3_SetAttrib(Effect.Control.Handle,item.id,item.value);
  end;
end;

//#############################################################################
// TMoveXEffect
//#############################################################################

procedure TMoveYEffect.DoSetupTween;
var
  LObj: TTweenElement;
begin
  Core.OnUpdated := NIL;

  LObj := Core.Add("ypos");
  LObj.StartValue := FromY;
  LObj.Distance := Distance ;
  LObj.Duration := Duration;
  LObj.AnimationType := ttQuadInOut;
  LObj.Behavior := tbSingle;
  LObj.OnUpdated := procedure (item:TTweenElement)
    begin
      Control.Top := round ( Item.Value );
    end;
end;

procedure TMoveYEffect.DoTearDownTween;
begin
  Core.Delete("ypos");
end;

//#############################################################################
// TMoveXEffect
//#############################################################################

procedure TMoveXEffect.DoSetupTween;
var
  LObj: TTweenElement;
begin
  Core.OnUpdated := NIL;

  LObj := Core.Add("xpos");
  LObj.StartValue := FromX;
  LObj.Distance := Distance ;
  LObj.Duration := Duration;
  LObj.AnimationType := ttQuadInOut;
  LObj.Behavior := tbSingle;
  LObj.OnUpdated := procedure (item:TTweenElement)
    begin
      Control.Left := round ( Item.Value );
    end;
end;

procedure TMoveXEffect.DoTearDownTween;
begin
  Core.Delete("xpos");
end;

//#############################################################################
// TCustomControlEffect
//#############################################################################

Constructor TCustomControlEffect.Create(aControl: TW3MovableControl);
begin
  inherited Create;
  FControl := AControl;
end;

//#############################################################################
// TCustomTweenEffect
//#############################################################################

Constructor TCustomTweenEffect.Create;
begin
  inherited Create;
  FTween:=TW3Tween.Create;
  FTween.OnFinished := HandleTweenDone;
  FTween.OnStarted := HandleTweenStart;
  FTween.OnUpdated := HandleTweenUpdated;
  Ftween.SyncRefresh := true;
end;

Destructor TCustomTweenEffect.Destroy;
begin
  Ftween.free;
  inherited;
end;

procedure TCustomTweenEffect.DoTearDownTween;
begin
end;

procedure TCustomTweenEffect.DoSetupTween;
begin
end;

procedure TCustomTweenEffect.HandleTweenStart(sender:TObject);
begin
  if assigned(OnEffectStarted) then
  OnEffectStarted(self);
end;

procedure TCustomTweenEffect.HandleTweenDone(sender:TObject);
begin
  // Tear down objects created if required
  DoTearDownTween;

  if assigned(OnEffectDone) then
  OnEffectDone(self);
end;

procedure TCustomTweenEffect.HandleTweenUpdated(Sender:TObject);
begin
end;

procedure TCustomTweenEffect.Execute(OnReady:TNotifyEvent);
begin
  // Keep onReady callback?
  if assigned(OnReady) then
  OnEffectDone := OnReady;

  DoExecute;
end;

procedure TCustomTweenEffect.DoExecute;
begin
  DoSetupTween;
  FTween.Execute;
end;

procedure TCustomTweenEffect.DoCancel;
begin
  FTween.Cancel;
end;

procedure TCustomTweenEffect.DoPause;
begin
  FTween.Pause;
end;

procedure TCustomTweenEffect.DoResume;
begin
  FTween.Resume;
end;

function TCustomTweenEffect.DoGetActive:Boolean;
begin
  result := FTween.Active;
end;

procedure TCustomTweenEffect.Cancel;
begin
  FTween.Cancel;
end;

procedure TCustomTweenEffect.Pause;
begin
  FTween.Pause;
end;

procedure TCustomTweenEffect.Resume;
begin
  FTween.Resume;
end;

//#############################################################################
// TCustomEffect
//#############################################################################

procedure TCustomEffect.Execute(OnReady:TNotifyEvent);
begin
  if DoGetActive then
  Cancel;

  DoExecute;
end;

procedure TCustomEffect.Pause;
begin
  DoPause;
end;

procedure TCustomEffect.Cancel;
begin
  DoCancel;
end;

procedure TCustomEffect.Resume;
begin
  DoResume;
end;

end.

And the tweening library:

unit system.animation.tween;

interface

uses
  System.Types,
  SmartCL.Time,
  SmartCL.System;

type

  TW3TweenAnimationType = (
    ttlinear,
    ttQuadIn,
    ttQuadOut,
    ttQuadInOut,
    ttCubeIn,
    ttCubeOut,
    ttCubeInOut,
    ttQuartIn,
    ttQuartOut,
    ttQuartInOut
    );

  TTweenBehavior = (
    tbSingle,         // Execute once and then stops
    tbRepeat,         // Repeats the tween sequence
    tbOscillate      // Executes between A and B in oscillating manner
    );

  TTweenData    = class;
  TTweenElement = class;
  TW3TweenEase  = class;
  TW3Tween      = class;

  TW3TweenEase = class
  public
    class function  Linear(t,b,c,d:float):float;
    class function  QuadIn(t, b, c, d:float):float;
    class function  QuadOut(t, b, c, d:float):float;
    class function  QuadInOut(t, b, c, d:float):float;
    class function  CubeIn(t, b, c, d:float):float;
    class function  CubeOut(t, b, c, d:float):float;
    class function  CubeInOut(t, b, c, d:float):float;
    class function  QuartIn(t, b, c, d:float):float;
    class function  QuartOut(t, b, c, d:float):float;
    class function  QuartInOut(t, b, c, d:float):float;
  end;

  TW3TweenItemUpdatedEvent = procedure (Item:TTweenElement);
  TW3TweenUpdatedEvent = procedure (Sender:TObject);
  TW3TweenStartedEvent = procedure (sender:TObject);
  TW3TweenFinishedEvent = procedure (sender:TObject);
  TW3TweenFinishedPartialEvent = procedure (sender:TObject);

  TTweenState = (tsIdle,tsRunning,tsPaused,tsDone);

  TTweenData = class
  public
    Property    Id: String;
    Property    StartTime: TDateTime;
    Property    StartValue: Float;
    Property    Distance: Float;
    Property    Duration: Float;
    Property    AnimationType: TW3TweenAnimationType;
    Property    Behavior: TTweenBehavior;

    function    Expired: Boolean;virtual;
    Procedure   Reset;virtual;
  end;

  TTweenElement = class(TTweenData)
  public
    Property    State:TTweenState;
    Property    Value:Float;

    Property    OnFinished:TNotifyEvent;
    Property    OnUpdated:TW3TweenItemUpdatedEvent;

    procedure   Update(const aValue:Float);virtual;

    Procedure   Reset;override;
    Constructor Create;virtual;
  end;

  TW3Tween = class
  private
    FTimer:     TW3Timer;
    FValues:    Array of TTweenElement;
    FActive:    Boolean;
    FPartial:   Boolean;
    FInterval:  Integer;
  protected
    Procedure   HandleSyncUpdate;virtual;
    procedure   HandleUpdateTimer(Sender:TObject);virtual;
    function    Update(const Item:TTweenElement):Float;virtual;
  public

    function    ObjectOf(const Id:String):TTweenElement;
    function    IndexOf(Id:String):Integer;

    Property    Active:Boolean read ( FActive );
    Property    Item[const index:Integer]:TTweenElement read (FValues[index]);
    property    Tween[const Id:String]:TTweenElement read ObjectOf;default;
    property    Count:Integer read ( FValues.Length );
    Property    Interval:Integer read FInterval write ( TInteger.EnsureRange(Value,1,10000) );

    Property    SyncRefresh:Boolean;
    Property    IgnoreOscillate:Boolean;

    function    Add(Id:String):TTweenElement;overload;

    Function    Add(Id:String;const aStartValue,aDistance,aDuration:float;
                const aAnimationType:TW3TweenAnimationType;
                const aBehavior:TTweenBehavior):TTweenElement;overload;

    Procedure   Delete(index:Integer);overload;
    procedure   Delete(Id:String);overload;
    procedure   Delete(const TweenIds:Array of String);overload;

    procedure   Clear;overload;

    procedure   Execute(Finished:TProcedureRef);overload;
    procedure   Execute;overload;
    procedure   Execute(const TweenObjects:Array of TTweenElement);overload;

    Procedure   Pause(const Index:Integer);overload;
    procedure   Pause(const Tween:TTweenElement);overload;
    procedure   Pause(const Objs:Array of TTweenElement);overload;
    procedure   Pause(const Ids:Array of String);overload;
    procedure   Pause;overload;

    Procedure   Resume(const index:Integer);overload;
    procedure   Resume(const Tween:TTweenElement);overload;
    procedure   Resume(const Objs:Array of TTweenElement);overload;
    procedure   Resume(const Ids:Array of String);overload;
    procedure   Resume;overload;

    procedure   Cancel;overload;

    Constructor Create;virtual;
    Destructor  Destroy;Override;

  published
    Property    OnPartialFinished:TW3TweenFinishedPartialEvent;
    Property    OnUpdated:TW3TweenUpdatedEvent;
    Property    OnFinished:TW3TweenFinishedEvent;
    Property    OnStarted:TW3TweenStartedEvent;
  end;

function GetTimeCode:float;
function Round100(const Value:float):float;

implementation

Function GetTimeCode:float;
begin
  asm
    @result = Date.now();
  end;
end;

function Round100(const Value:float):float;
begin
  result := Round( Value * 100) / 100;
end;

//############################################################################
// TW3Tween
//############################################################################

Constructor TW3Tween.Create;
begin
  inherited Create;
  FTimer := TW3Timer.Create;
  Interval := 10;
  IgnoreOscillate := true;
end;

Destructor  TW3Tween.Destroy;
begin
  Cancel;
  Clear;
  FTimer.free;
  inherited;
end;

procedure TW3Tween.Clear;
begin
  While FValues.length>0 do
  begin
    FValues[FValues.length-1].free;
    Fvalues.Delete(FValues.length-1,1);
  end;
end;

function TW3Tween.Update(const Item:TTweenElement):Float;
var
  LTotal: float;

  function PerformX(t, b, c, d:float):float;
  begin
    result := 0.0;
    case Item.AnimationType of
    ttlinear:     result := TW3TweenEase.Linear(t,b,c,d);
    ttQuadIn:     result := TW3TweenEase.QuadIn(t,b,c,d);
    ttQuadOut:    result := TW3TweenEase.QuadOut(t,b,c,d);
    ttQuadInOut:  result := TW3TweenEase.QuadInOut(t,b,c,d);
    ttCubeIn:     result := TW3TweenEase.CubeIn(t,b,c,d);
    ttCubeOut:    result := TW3TweenEase.CubeOut(t,b,c,d);
    ttCubeInOut:  result := TW3TweenEase.CubeInOut(t,b,c,d);
    ttQuartIn:    result := TW3TweenEase.QuartIn(t,b,c,d);
    ttQuartOut:   result := TW3TweenEase.QuartOut(t,b,c,d);
    ttQuartInOut: result := TW3TweenEase.QuartInOut(t,b,c,d);
    end;
  end;

begin
  if not Item.Expired then
  begin
    LTotal := PerformX(GetTimeCode-Item.StartTime,
                      Item.StartValue,
                      Item.Distance,
                      Item.Duration);
  end else
  if Item.behavior = tbSingle then
  begin
    LTotal := Item.StartValue + Item.Distance;
  end else
  if Item.behavior = tbRepeat then
  begin
    Item.StartTime := GetTimeCode;
    LTotal := PerformX(GetTimeCode-Item.StartTime,
                      Item.StartValue,
                      Item.Distance,
                      Item.Duration);
  end else
  if Item.behavior = tbOscillate then
  begin
    Item.StartValue := Item.StartValue + Item.Distance;
    Item.Distance := -Item.Distance;
    Item.StartTime := GetTimeCode;
    LTotal := PerformX(GetTimeCode-Item.StartTime,
                      Item.StartValue,
                      Item.Distance,
                      Item.Duration);
    Item.State := tsDone;
  end;

  result := Round100(LTotal);
end;

procedure TW3Tween.HandleUpdateTimer(Sender:TObject);
var
  LItem:  TTweenElement;
  LCount: Integer;
  LDone:  Integer;
begin
  (* Tween objects cleared while active? *)
  if FValues.Length<1 then
  begin
    Cancel;
    exit;
  end;

  LCount := 0;
  LDone  := 0;
  for LItem in FValues do
  begin
    (* The start time-code is set in the first update *)
    if LItem.State=tsIdle then
    begin
      LItem.StartTime := GetTimeCode;
      LItem.State := tsRunning;
    end;

    // Animation paused? Continue with next
    if LItem.State = tsPaused then
    continue;

    // Expired? Keep track of it
    if LItem.Expired then
    begin
      if IgnoreOscillate then
      begin
        //if (LItem.Behavior <> tbOscillate) then
        if (LItem.Behavior = tbSingle) then
        inc(LCount) else
        inc(LDone);
      end else
      inc(LCount);
    end;

    // Update the element with the new value
    LItem.Update(Update(LItem));

    // finished on this run?
    if LItem.Expired then
    begin
      if not Litem.State = tsDone then
      begin
        LItem.State := tsDone;
        if assigned(LItem.OnFinished) then
        LItem.OnFinished(LItem);
      end;
    end;

  end;

  if assigned(OnUpdated) then
  OnUpdated(Self);

  if LCount = (FValues.Length - LDone) then
  begin
    if IgnoreOscillate then
    begin
      if not FPartial then
      begin
        FPartial := True; // make sure this happens only once!
        if assigned(OnPartialFinished) then
        OnPartialFinished(self);
      end;
    end;
  end;

  (* If all tweens have expired, stop the animation *)
  If LCount = FValues.Length then
  begin
    //Writeln('Stopping at ' + LCount.toString + ' tweens done');
    Cancel;
  end;
end;

Procedure TW3Tween.HandleSyncUpdate;
begin
  HandleUpdateTimer(NIL);
  if Active then
  W3_RequestAnimationFrame(HandleSyncUpdate);
end;

procedure TW3Tween.Execute(Const TweenObjects:Array of TTweenElement);
var
  LItem:  TTweenElement;
  LId:    String;
begin
  if not Active then
  begin
    if TweenObjects.length<0 then begin for LItem in TweenObjects do begin LId := LItem.Id.Trim; if LId.length>0 then
        begin

          if self.IndexOf(LId)<0 then FValues.add(LItem) else Raise EW3Exception.CreateFmt ('Execute failed, a tween-object with id [%s] already exists in collection error',[LId]); end else Raise EW3Exception.Create ('Execute failed, could not inject tween object, element missing qualified id error'); end; end; Execute; end else raise exception.Create('Tween already executing error'); end; procedure TW3Tween.Execute(Finished:TProcedureRef); begin self.OnFinished := procedure (sender:Tobject) begin if assigned(Finished) then Finished; end; Execute; end; procedure TW3Tween.Execute; begin if not Active then begin FPartial := false; case SyncRefresh of true: begin // Initiate loop in 100ms W3_Callback( procedure () begin W3_RequestAnimationFrame( HandleSyncUpdate ); end, 100); end; false: begin FTimer.OnTime := HandleUpdateTimer; FTimer.Delay := Interval; FTimer.Enabled := true; end; end; FActive := True; if assigned(OnStarted) then OnStarted(self); end else raise exception.Create('Tween already executing error'); end; procedure TW3Tween.Delete(const TweenIds:Array of String); var Lid: String; LObj: TTweenElement; LIndex: Integer; begin if tweenIds.length>0 then
  begin
    // Only remove tweens defined in Parameter list
    for LId in Tweenids do
    begin
      LObj := ObjectOf(Lid);
      if LObj<>NIL then
      begin
        LIndex := FValues.IndexOf(LObj);
        FValues.delete(LIndex,1);
        LObj.free;
      end;
    end;
  end;
end;

Procedure TW3Tween.Resume(const index:Integer);
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if (Index>=0) and (Index<FValues.Count) then
    begin
      LObj := FValues[index];
      if LObj.State=tsPaused then
      begin
        FValues[index].StartTime := GetTimeCode;
        FValues[Index].State := tsRunning;
      end;
    end;
  end;
end;

procedure TW3Tween.Resume(const Tween:TTweenElement);
begin
  if Active then
  Begin
    if Tween<>NIL then
    Begin
      if FValues.IndexOf(Tween)>=0 then
      begin
        if Tween.state=tsPaused then
        begin
          Tween.StartTime := GetTimeCode;
          Tween.State := tsPaused;
        end;
      end;
    end;
  end;
end;

procedure TW3Tween.Resume(const Objs:Array of TTweenElement);
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if Objs.length>0 then
    Begin
      for LObj in Objs do
      begin
        if LObj<>NIl then
        Resume(LObj);
      end;
    end;
  end;
end;

procedure TW3Tween.Resume(const Ids:Array of String);
var
  LId:  String;
begin
  if Active then
  begin
    for LId in Ids do
    begin
      Resume(ObjectOf(Lid));
    end;
  end;
end;

procedure TW3Tween.Resume;
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if FValues.length>0 then
    Begin
      for LObj in FValues do
      begin
        if LObj<>NIl then
        Resume(LObj);
      end;
    end;
  end;
end;

Procedure TW3Tween.Pause(const Index:Integer);
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if (Index>=0) and (Index<FValues.Count) then
    begin
      LObj := FValues[index];
      if LObj.State=tsRunning then
      FValues[Index].State := tsPaused;
    end;
  end;
end;

procedure TW3Tween.Pause(const Tween:TTweenElement);
begin
  if Active then
  Begin
    if Tween<>NIL then
    Begin
      if FValues.IndexOf(Tween)>=0 then
      begin
        if Tween.state=tsRunning then
        Tween.State := tsPaused;
      end;
    end;
  end;
end;

procedure TW3Tween.Pause(const Objs:Array of TTweenElement);
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if Objs.length>0 then
    Begin
      for LObj in Objs do
      begin
        if LObj<>NIl then
        Pause(LObj);
      end;
    end;
  end;
end;

procedure TW3Tween.Pause(const Ids:Array of String);
var
  LId:  String;
begin
  if Active then
  begin
    for LId in Ids do
    begin
      Pause(ObjectOf(Lid));
    end;
  end;
end;

procedure TW3Tween.Pause;
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if FValues.length>0 then
    Begin
      for LObj in FValues do
      begin
        Pause(LObj);
      end;
    end;
  end;
end;

procedure TW3Tween.Cancel;
begin
  if Active then
  begin
    try
      FTimer.enabled := false;
      FTimer.OnTime := NIL;
    finally
      FActive := false;

      if assigned(OnFinished) then
      OnFinished(self);
    end;
  end;
end;

Procedure TW3Tween.Delete(index:Integer);
var
  LObj: TTweenElement;
begin
  LObj:=FValues[index];
  FValues.Delete(Index,1);
  LObj.free;
end;

procedure TW3Tween.Delete(Id:String);
begin
  Delete(FValues.indexOf(ObjectOf(Id)));
end;

function TW3Tween.Add(Id:String):TTweenElement;
begin
  Id := id.trim.lowercase;
  if id.length>0 then
  begin
    if IndexOf(Id)<0 then begin result := TTweenElement.Create; result.Id := Id; FValues.add(result); end else raise EW3Exception.CreateFmt ('A tween-object with id [%s] already exists in collection error',[Id]); end else raise EW3Exception.Create('Invalid tween-object id [empty] error'); end; Function TW3Tween.Add(Id:String;const aStartValue,aDistance,aDuration:float; const aAnimationType:TW3TweenAnimationType; const aBehavior:TTweenBehavior):TTweenElement; begin Id := id.trim.lowercase; if id.length>0 then
  begin
    if IndexOf(Id)<0 then begin result := TTweenElement.Create; result.StartValue := aStartValue; result.Distance := aDistance; result.Duration := aDuration; result.AnimationType := aAnimationtype; result.Behavior := aBehavior; result.StartTime := GetTimeCode; result.Id := Id; FValues.add(result); end else raise EW3Exception.CreateFmt ('A tween-object with id [%s] already exists in collection error',[Id]); end else raise EW3Exception.Create('Invalid tween-object id [empty] error'); end; function TW3Tween.IndexOf(Id:String):Integer; var x: Integer; begin result := -1; id := Id.trim.lowercase; if id.length>0 then
  begin
    for x:=0 to FValues.Count-1 do
    begin
      if Id.EqualsText(FValues[x].Id) then
      begin
        result := x;
        break;
      end;
    end;
  end;
end;

function TW3Tween.ObjectOf(const Id:String):TTweenElement;
var
  LIndex: Integer;
begin
  LIndex := IndexOf(Id);
  if LIndex>=0 then
  result := FValues[LIndex] else
  result := NIL;
end;

//############################################################################
// TTweenData
//############################################################################

function TTweenData.Expired: Boolean;
begin
  result := StartTime + Duration < GetTimeCode;
end;

Procedure TTweenData.Reset;
begin
  StartTime := 0;
  StartValue := 0;
  Distance := 0;
  Duration := 0;
  Animationtype := ttlinear;
  Behavior := tbSingle;
end;

//############################################################################
// TTweenElement
//############################################################################

Constructor TTweenElement.Create;
begin
  inherited Create;
  State := tsIdle;
end;

Procedure TTweenElement.Reset;
begin
  inherited Reset;
  State := tsIdle;
end;

procedure TTweenElement.Update(const aValue:Float);
begin
  Value := aValue;
  if assigned(OnUpdated) then
  OnUpdated(self);
end;

//#############################################################################
//  TW3TweenEase
//#############################################################################
{$HINTS OFF}
class function TW3TweenEase.QuartIn(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return @c * @t * @t * @t * @t + @b;
  end;
end;

class function TW3TweenEase.QuartOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    @t--;
    return -@c * (@t * @t * @t * @t - 1) + @b;
  end;
end;

class function TW3TweenEase.QuartInOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d/2;
    if (@t < 1) {
        return @c / 2 * @t * @t * @t * @t + @b;
    }
    @t -= 2;
    return -@c / 2 * (@t * @t * @t * @t - 2) + @b;
  end;
end;

class function TW3TweenEase.CubeInOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d/2;
    if (@t < 1) {
      return @c / 2 * @t * @t * @t + @b;
    }
    @t -= 2;
    return @c/2 * (@t * @t * @t + 2) + @b;
  end;
end;

class function TW3TweenEase.CubeOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    @t--;
    return @c * (@t * @t * @t + 1) + @b;
  end;
end;

class function TW3TweenEase.CubeIn(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return @c * @t * @t * @t + @b;
  end;
end;

class function TW3TweenEase.QuadInOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d/2;
    if (@t < 1) {
      return @c / 2 * @t * @t * @t + @b;
    }
    @t -= 2;
    @result = @c/2*(@t * @t * @t + 2) + @b;
  end;
end;

class function TW3TweenEase.QuadOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return -@c * @t * (@t - 2) + @b;
  end;
end;

class function TW3TweenEase.QuadIn(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return @c * @t * @t + @b;
  end;
end;

class function TW3TweenEase.Linear(t,b,c,d:float):float;
begin
  asm
   @result = @c * @t / @d + @b;
  end;
end;
{$HINTS ON}
end.

50% of Moscow Embarcadero staff fired

A former Embarcadero employee informed us today that roughly 50% of the Moscow staff has been fired.

Embarcadero downsized?

While I have yet to see a formal announcement on this, the source is trustworthy (long-term Delphi user I know quite well).

This is a bold move by the new owners of Delphi, Idera. Although what this move means for Delphi is yet to be seen. I believe most of the development for Delphi and C++ builder takes place both in in the US, and St. Petersburg in Russia.

Update: I have been informed that only sales and marketing has been affected by this mass termination. Research and development remains intact. As such it may be harmless as Idera no doubt have their own sales and marketing division to begin with..

Either way, sad to see Embarcadero’s organization being downsized, considering how hard they have been working to establish themselves and the Delphi market share since the aquisition of Borland technology some 7 years ago.

Cover your bases?

This may be a good time to investigate possible alternative technologies. While I doubt the above will have any true impact on Delphi as a product, i never ignore a sign of possible flux in the marketplace. I believe in covering my bases and broadening my skill-set. Never put all your eggs in one basket as they say:

Freepascal has recently catched up with Delphi in terms of generics, so FPC can now compile pretty much everything you throw at it. Lazarus can take some getting used to, but it works on Linux, OS X, Windows and a whole host of lesser known alternative operative systems (like Aros), Raspberry PI and a ton of Embedded platforms.

Smart Mobile Studio is a good alternative for mobile development and NodeJS server software. It targets HTML5 and allows you to mix and match between native and javascript. The compiler itself generates JavaScript from Object Pascal. Smart Mobile can connect to DataSnap, Remobjects and Mormoth RPC services, SOAP, REST and Websocket servers.

Remobjects Oxygene has been a long standing alternative to Delphi. Their compilers run on the .NET platform and can use both Visual Studio and Mono compilers to generate platform independent products.

Smart Mobile libs on GitHub

I’ve been running this blog for a few years now, and being a hard-core SVN user I have been forced to just publish code in the article itself. Well, I decided it was time to change all this, so I’ve setup a spanking new Github repository just to make things easier.

So point your Github desktop at: https://github.com/quartexNOR/smartpascal for Smart Mobile Studio units and code.

If you browse my repositories you will find several libraries, so feel free to browse around. ByteRage and PixelRage should be of special interest to coders looking for things your normal streams and bitmaps just cant deliver 🙂

Tweening, an update

I got plenty of cool feedback on the tweening unit, so that is the first unit to be uploaded to GIT. And as you probably understand, after work today i sat down and expanded the original class. Monumentally so.

The new tweening system is not limited to a single value, in fact, you can tween as many values as you want from the same object.

You also have plenty of events, both per tween element and for all active tweens as a group. This is handy if you have an animation which affects multiple objects, but should be considered “a single animation” or “sequence”.

You can also pause a single tween element, a list of elements or all elements. You can likewise resume with the same level of detail.

Better timing

The new TTween class provides two ways of updating your tween-elements. The first is a normal timer object (TTimer) which update on interval. This is best suited for non-critical UI animations.

The second is more suitable for games and multimedia, and runs the tweens within a synchronized animation frame loop (requestAnimationFrame API). When using this your updates are performed in sync with the redraw cycle of the browser.

Better behavior

A tween now has 3 modes of execution, these are:

• tbSingle
• tbRepeat
• tbOscillate

The last option executes your tween, then executes it backwards, and then continues like this in an oscillating fashion (hence the name). This sort of behavior means that an animation may never actually end (!)

To solve this I introduced a new property called “IgnoreOscillate”. If this property is set to false, the TTween object will stop when all tweens have been executed as expected. The oscillating behavior of some Tween elements will simply be ignored.

If you set the property to True, TTween will never exit the animation loop – but will instead issue the new OnPartialFinished event. This event tells you that all tweens are done, but that some tween elements are still running in oscillating mode (read: so it’s safe to call cancel() to stop everything).

Individual events

Since tween data is now isolated in separate objects, each tween have personal events (so to speak). The TTweenElement class exposes OnFinished and OnUpdated events.

TTween also issues a OnUpdated event after all TTweenElements have been updated. So depending on the type of animation you are executing, you have the freedom to chose both individual notification and “global” notification.

The source

For those that dont have access to GIT right now, here are the changes

unit system.animation.tween;

interface

uses 
  System.Types,
  SmartCL.Time,
  SmartCL.System;

type

  TW3TweenAnimationType = (
    ttlinear,
    ttQuadIn,
    ttQuadOut,
    ttQuadInOut,
    ttCubeIn,
    ttCubeOut,
    ttCubeInOut,
    ttQuartIn,
    ttQuartOut,
    ttQuartInOut
    );

  TTweenBehavior = (
    tbSingle,         // Execute once and then stops
    tbRepeat,         // Repeats the tween sequence
    tbOscillate      // Executes between A and B in oscillating manner
    );

  TTweenData    = class;
  TTweenElement = class;
  TW3TweenEase  = class;
  TW3Tween      = class;

  TW3TweenEase = class
  public
    class function  Linear(t,b,c,d:float):float;
    class function  QuadIn(t, b, c, d:float):float;
    class function  QuadOut(t, b, c, d:float):float;
    class function  QuadInOut(t, b, c, d:float):float;
    class function  CubeIn(t, b, c, d:float):float;
    class function  CubeOut(t, b, c, d:float):float;
    class function  CubeInOut(t, b, c, d:float):float;
    class function  QuartIn(t, b, c, d:float):float;
    class function  QuartOut(t, b, c, d:float):float;
    class function  QuartInOut(t, b, c, d:float):float;
  end;

  TW3TweenItemUpdatedEvent = procedure (Sender:TObject;Item:TTweenElement);
  TW3TweenUpdatedEvent = procedure (Sender:TObject);
  TW3TweenStartedEvent = procedure (sender:TObject);
  TW3TweenFinishedEvent = procedure (sender:TObject);
  TW3TweenFinishedPartialEvent = procedure (sender:TObject);

  TTweenState = (tsIdle,tsRunning,tsPaused,tsDone);

  TTweenData = class
  public
    Property    Id: String;
    Property    StartTime: TDateTime;
    Property    StartValue: Float;
    Property    Distance: Float;
    Property    Duration: Float;
    Property    AnimationType: TW3TweenAnimationType;
    Property    Behavior: TTweenBehavior;

    function    Expired: Boolean;virtual;
    Procedure   Reset;virtual;
  end;

  TTweenElement = class(TTweenData)
  public
    Property    State:TTweenState;
    Property    Value:Float;

    Property    OnFinished:TNotifyEvent;
    Property    OnUpdated:TW3TweenItemUpdatedEvent;

    Procedure   Reset;override;
    Constructor Create;virtual;
  end;

  TW3Tween = class
  private
    FTimer:     TW3Timer;
    FValues:    Array of TTweenElement;
    FActive:    Boolean;
    FPartial:   Boolean;
    FInterval:  Integer;
  protected
    Procedure   HandleSyncUpdate;virtual;
    procedure   HandleUpdateTimer(Sender:TObject);virtual;
    function    Update(const Item:TTweenElement):Float;virtual;
  public

    function    ObjectOf(const Id:String):TTweenElement;
    function    IndexOf(Id:String):Integer;

    Property    Active:Boolean read ( FActive );
    Property    Item[const index:Integer]:TTweenElement read (FValues[index]);
    property    Tween[const Id:String]:TTweenElement read ObjectOf;
    property    Count:Integer read ( FValues.Length );
    Property    Interval:Integer read FInterval write ( TInteger.EnsureRange(Value,1,10000) );

    Property    SyncRefresh:Boolean;
    Property    IgnoreOscillate:Boolean;

    function    Add(Id:String):TTweenElement;overload;

    Function    Add(Id:String;const aStartValue,aDistance,aDuration:float;
                const aAnimationType:TW3TweenAnimationType;
                const aBehavior:TTweenBehavior):TTweenElement;overload;

    Procedure   Delete(index:Integer);overload;
    procedure   Delete(Id:String);overload;
    procedure   Delete(const TweenIds:Array of String);overload;

    procedure   Clear;overload;

    procedure   Execute;overload;
    procedure   Execute(const TweenObjects:Array of TTweenElement);overload;

    Procedure   Pause(const Index:Integer);overload;
    procedure   Pause(const Tween:TTweenElement);overload;
    procedure   Pause(const Objs:Array of TTweenElement);overload;
    procedure   Pause(const Ids:Array of String);overload;
    procedure   Pause;overload;

    Procedure   Resume(const index:Integer);overload;
    procedure   Resume(const Tween:TTweenElement);overload;
    procedure   Resume(const Objs:Array of TTweenElement);overload;
    procedure   Resume(const Ids:Array of String);overload;
    procedure   Resume;overload;

    procedure   Cancel;overload;

    Constructor Create;virtual;
    Destructor  Destroy;Override;

  published
    Property    OnPartialFinished:TW3TweenFinishedPartialEvent;
    Property    OnUpdated:TW3TweenUpdatedEvent;
    Property    OnFinished:TW3TweenFinishedEvent;
    Property    OnStarted:TW3TweenStartedEvent;
  end;


function GetTimeCode:float;
function Round100(const Value:float):float;

implementation

Function GetTimeCode:float;
begin
  asm
    @result = Date.now();
  end;
end;

function Round100(const Value:float):float;
begin
  result := Round( Value * 100) / 100;
end;

//############################################################################
// TW3Tween
//############################################################################

Constructor TW3Tween.Create;
begin
  inherited Create;
  FTimer := TW3Timer.Create;
  Interval := 10;
  IgnoreOscillate := true;
end;

Destructor  TW3Tween.Destroy;
begin
  Cancel;
  Clear;
  FTimer.free;
  inherited;
end;

procedure TW3Tween.Clear;
begin
  While FValues.length>0 do
  begin
    FValues[FValues.length-1].free;
    Fvalues.Delete(FValues.length-1,1);
  end;
end;

function TW3Tween.Update(const Item:TTweenElement):Float;
var
  LTotal: float;

  function PerformX(t, b, c, d:float):float;
  begin
    result := 0.0;
    case Item.AnimationType of
    ttlinear:     result := TW3TweenEase.Linear(t,b,c,d);
    ttQuadIn:     result := TW3TweenEase.QuadIn(t,b,c,d);
    ttQuadOut:    result := TW3TweenEase.QuadOut(t,b,c,d);
    ttQuadInOut:  result := TW3TweenEase.QuadInOut(t,b,c,d);
    ttCubeIn:     result := TW3TweenEase.CubeIn(t,b,c,d);
    ttCubeOut:    result := TW3TweenEase.CubeOut(t,b,c,d);
    ttCubeInOut:  result := TW3TweenEase.CubeInOut(t,b,c,d);
    ttQuartIn:    result := TW3TweenEase.QuartIn(t,b,c,d);
    ttQuartOut:   result := TW3TweenEase.QuartOut(t,b,c,d);
    ttQuartInOut: result := TW3TweenEase.QuartInOut(t,b,c,d);
    end;
  end;

begin
  if not Item.Expired then
  begin
    LTotal := PerformX(GetTimeCode-Item.StartTime,
                      Item.StartValue,
                      Item.Distance,
                      Item.Duration);
  end else
  if Item.behavior = tbSingle then
  begin
    LTotal := Item.StartValue + Item.Distance;
  end else
  if Item.behavior = tbRepeat then
  begin
    Item.StartTime := GetTimeCode;
    LTotal := PerformX(GetTimeCode-Item.StartTime,
                      Item.StartValue,
                      Item.Distance,
                      Item.Duration);
  end else
  if Item.behavior = tbOscillate then
  begin
    Item.StartValue := Item.StartValue + Item.Distance;
    Item.Distance := -Item.Distance;
    Item.StartTime := GetTimeCode;
    LTotal := PerformX(GetTimeCode-Item.StartTime,
                      Item.StartValue,
                      Item.Distance,
                      Item.Duration);
    Item.State := tsDone;
  end;

  result := Round100(LTotal);
end;

procedure TW3Tween.HandleUpdateTimer(Sender:TObject);
var
  LItem:  TTweenElement;
  LCount: Integer;
  LDone:  Integer;
begin
  (* Tween objects cleared while active? *)
  if FValues.Length<1 then
  begin
    Cancel;
    exit;
  end;

  LCount := 0;
  LDone  := 0;
  for LItem in FValues do
  begin
    (* The start time-code is set in the first update *)
    if LItem.State=tsIdle then
    begin
      LItem.StartTime := GetTimeCode;
      LItem.State := tsRunning;
    end;

    // Animation paused? Continue with next
    if LItem.State = tsPaused then
    continue;

    // Expired? Keep track of it
    if LItem.Expired then
    begin
      if IgnoreOscillate then
      begin
        if (LItem.Behavior <> tbOscillate) then
        inc(LCount) else
        inc(LDone);
      end else
      inc(LCount);
    end;

    LItem.Value := Update(LItem);

    // Fire "per item" event
    if assigned(LItem.OnUpdated) then
    LItem.OnUpdated(self,LItem);

    // finished on this run?
    if LItem.Expired then
    begin
      if not Litem.State = tsDone then
      begin
        LItem.State := tsDone;
        if assigned(LItem.OnFinished) then
        LItem.OnFinished(LItem);
      end;
    end;

  end;

  if assigned(OnUpdated) then
  OnUpdated(Self);

  if LCount = (FValues.Length - LDone) then
  begin
    if IgnoreOscillate then
    begin
      if not FPartial then
      begin
        FPartial := True; // make sure this happens only once!
        if assigned(OnPartialFinished) then
        OnPartialFinished(self);
      end;
    end;
  end;

  (* If all tweens have expired, stop the animation *)
  If LCount = FValues.Length then
  begin
    //Writeln('Stopping at ' + LCount.toString + ' tweens done');
    Cancel;
  end;
end;

Procedure TW3Tween.HandleSyncUpdate;
begin
  HandleUpdateTimer(NIL);
  if Active then
  W3_RequestAnimationFrame(HandleSyncUpdate);
end;

procedure TW3Tween.Execute(Const TweenObjects:Array of TTweenElement);
var
  LItem:  TTweenElement;
  LId:    String;
begin
  if not Active then
  begin
    if TweenObjects.length<0 then
    begin
      for LItem in TweenObjects do
      begin
        LId := LItem.Id.Trim;
        if LId.length>0 then
        begin

          if self.IndexOf(LId)<0 then
          FValues.add(LItem) else
          Raise EW3Exception.CreateFmt
          ('Execute failed, a tween-object with id [%s] already exists in collection error',[LId]);
        end else
        Raise EW3Exception.Create
        ('Execute failed, could not inject tween object, element missing qualified id error');
      end;
    end;

    Execute;

  end else
  raise exception.Create('Tween already executing error');
end;

procedure TW3Tween.Execute;
begin
  if not Active then
  begin

    FPartial := false;

    case SyncRefresh of
    true:
      begin
        // Initiate loop in 100ms
        W3_Callback( procedure ()
          begin
            W3_RequestAnimationFrame( HandleSyncUpdate );
          end, 100);
      end;
    false:
      begin
        FTimer.OnTime := HandleUpdateTimer;
        FTimer.Delay := Interval;
        FTimer.Enabled := true;
      end;
    end;

    FActive := True;
    if assigned(OnStarted) then
    OnStarted(self);

  end else
  raise exception.Create('Tween already executing error');
end;

procedure TW3Tween.Delete(const TweenIds:Array of String);
var
  Lid:  String;
  LObj: TTweenElement;
  LIndex: Integer;
begin
  if tweenIds.length>0 then
  begin
    // Only remove tweens defined in Parameter list
    for LId in Tweenids do
    begin
      LObj := ObjectOf(Lid);
      if LObj<>NIL then
      begin
        LIndex := FValues.IndexOf(LObj);
        FValues.delete(LIndex,1);
        LObj.free;
      end;
    end;
  end;
end;

Procedure TW3Tween.Resume(const index:Integer);
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if (Index>=0) and (Index<FValues.Count) then
    begin
      LObj := FValues[index];
      if LObj.State=tsPaused then
      begin
        FValues[index].StartTime := GetTimeCode;
        FValues[Index].State := tsRunning;
      end;
    end;
  end;
end;

procedure TW3Tween.Resume(const Tween:TTweenElement);
begin
  if Active then
  Begin
    if Tween<>NIL then
    Begin
      if FValues.IndexOf(Tween)>=0 then
      begin
        if Tween.state=tsPaused then
        begin
          Tween.StartTime := GetTimeCode;
          Tween.State := tsPaused;
        end;
      end;
    end;
  end;
end;

procedure TW3Tween.Resume(const Objs:Array of TTweenElement);
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if Objs.length>0 then
    Begin
      for LObj in Objs do
      begin
        if LObj<>NIl then
        Resume(LObj);
      end;
    end;
  end;
end;

procedure TW3Tween.Resume(const Ids:Array of String);
var
  LId:  String;
begin
  if Active then
  begin
    for LId in Ids do
    begin
      Resume(ObjectOf(Lid));
    end;
  end;
end;

procedure TW3Tween.Resume;
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if FValues.length>0 then
    Begin
      for LObj in FValues do
      begin
        if LObj<>NIl then
        Resume(LObj);
      end;
    end;
  end;
end;

Procedure TW3Tween.Pause(const Index:Integer);
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if (Index>=0) and (Index<FValues.Count) then
    begin
      LObj := FValues[index];
      if LObj.State=tsRunning then
      FValues[Index].State := tsPaused;
    end;
  end;
end;

procedure TW3Tween.Pause(const Tween:TTweenElement);
begin
  if Active then
  Begin
    if Tween<>NIL then
    Begin
      if FValues.IndexOf(Tween)>=0 then
      begin
        if Tween.state=tsRunning then
        Tween.State := tsPaused;
      end;
    end;
  end;
end;

procedure TW3Tween.Pause(const Objs:Array of TTweenElement);
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if Objs.length>0 then
    Begin
      for LObj in Objs do
      begin
        if LObj<>NIl then
        Pause(LObj);
      end;
    end;
  end;
end;

procedure TW3Tween.Pause(const Ids:Array of String);
var
  LId:  String;
begin
  if Active then
  begin
    for LId in Ids do
    begin
      Pause(ObjectOf(Lid));
    end;
  end;
end;

procedure TW3Tween.Pause;
var
  LObj: TTweenElement;
begin
  if Active then
  begin
    if FValues.length>0 then
    Begin
      for LObj in FValues do
      begin
        Pause(LObj);
      end;
    end;
  end;
end;

procedure TW3Tween.Cancel;
begin
  if Active then
  begin
    try
      FTimer.enabled := false;
      FTimer.OnTime := NIL;
    finally
      FActive := false;

      if assigned(OnFinished) then
      OnFinished(self);
    end;
  end;
end;

Procedure TW3Tween.Delete(index:Integer);
var
  LObj: TTweenElement;
begin
  LObj:=FValues[index];
  FValues.Delete(Index,1);
  LObj.free;
end;

procedure TW3Tween.Delete(Id:String);
begin
  Delete(FValues.indexOf(ObjectOf(Id)));
end;

function TW3Tween.Add(Id:String):TTweenElement;
begin
  Id := id.trim.lowercase;
  if id.length>0 then
  begin
    if IndexOf(Id)<0 then
    begin
      result := TTweenElement.Create;
      result.Id := Id;
      FValues.add(result);
    end else
    raise EW3Exception.CreateFmt
    ('A tween-object with id [%s] already exists in collection error',[Id]);
  end else
  raise EW3Exception.Create('Invalid tween-object id [empty] error');
end;

Function TW3Tween.Add(Id:String;const aStartValue,aDistance,aDuration:float;
          const aAnimationType:TW3TweenAnimationType;
          const aBehavior:TTweenBehavior):TTweenElement;
begin
  Id := id.trim.lowercase;
  if id.length>0 then
  begin
    if IndexOf(Id)<0 then
    begin
      result := TTweenElement.Create;
      result.StartValue := aStartValue;
      result.Distance := aDistance;
      result.Duration := aDuration;
      result.AnimationType := aAnimationtype;
      result.Behavior := aBehavior;
      result.StartTime := GetTimeCode;
      result.Id := Id;
      FValues.add(result);
    end else
    raise EW3Exception.CreateFmt
    ('A tween-object with id [%s] already exists in collection error',[Id]);
  end else
  raise EW3Exception.Create('Invalid tween-object id [empty] error');
end;

function TW3Tween.IndexOf(Id:String):Integer;
var
  x:  Integer;
begin
  result := -1;
  id := Id.trim.lowercase;
  if id.length>0 then
  begin
    for x:=0 to FValues.Count-1 do
    begin
      if Id.EqualsText(FValues[x].Id) then
      begin
        result := x;
        break;
      end;
    end;
  end;
end;

function TW3Tween.ObjectOf(const Id:String):TTweenElement;
var
  LIndex: Integer;
begin
  LIndex := IndexOf(Id);
  if LIndex>=0 then
  result := FValues[LIndex] else
  result := NIL;
end;

//############################################################################
// TTweenData
//############################################################################

function TTweenData.Expired: Boolean;
begin
  result := StartTime + Duration < GetTimeCode;
end;

Procedure TTweenData.Reset;
begin
  StartTime := 0;
  StartValue := 0;
  Distance := 0;
  Duration := 0;
  Animationtype := ttlinear;
  Behavior := tbSingle;
end;

//############################################################################
// TTweenElement
//############################################################################

Constructor TTweenElement.Create;
begin
  inherited Create;
  State := tsIdle;
end;

Procedure TTweenElement.Reset;
begin
  inherited Reset;
  State := tsIdle;
end;


//#############################################################################
//  TW3TweenEase
//#############################################################################

class function TW3TweenEase.QuartIn(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return @c * @t * @t * @t * @t + @b;
  end;
end;

class function TW3TweenEase.QuartOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    @t--;
    return -@c * (@t * @t * @t * @t - 1) + @b;
  end;
end;

class function TW3TweenEase.QuartInOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d/2;
    if (@t < 1) {
        return @c / 2 * @t * @t * @t * @t + @b;
    }
    @t -= 2;
    return -@c / 2 * (@t * @t * @t * @t - 2) + @b;
  end;
end;

class function TW3TweenEase.CubeInOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d/2;
    if (@t < 1) {
      return @c / 2 * @t * @t * @t + @b;
    }
    @t -= 2;
    return @c/2 * (@t * @t * @t + 2) + @b;
  end;
end;

class function TW3TweenEase.CubeOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    @t--;
    return @c * (@t * @t * @t + 1) + @b;
  end;
end;

class function TW3TweenEase.CubeIn(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return @c * @t * @t * @t + @b;
  end;
end;

class function TW3TweenEase.QuadInOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d/2;
    if (@t < 1) {
      return @c / 2 * @t * @t * @t + @b;
    }
    @t -= 2;
    @result = @c/2*(@t * @t * @t + 2) + @b;
  end;
end;

class function TW3TweenEase.QuadOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return -@c * @t * (@t - 2) + @b;
  end;
end;

class function TW3TweenEase.QuadIn(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return @c * @t * @t + @b;
  end;
end;

class function TW3TweenEase.Linear(t,b,c,d:float):float;
begin
  asm
   @result = @c * @t / @d + @b;
  end;
end;



end.

Tweening made simple

Smart Mobile Studio has a pretty good RTL. It’s small yet covers some of the more advanced topics available under HTML5. It’s compact yet delivers more features than every other framework on the market. But what it doesnt do is make your life easier when it comes to smooth transitions and movements.

Well, thats both true and false actually. We shipped classes for executing CSS animations and transitions all the way back in version 1.0, and we recently followed up with even more animations and easier access (ridicules easy) via the SmartCL.Effects.pas unit. Just include that in your project and all your TW3CustomControl based widgets gain X number of “fx” methods.So adding effects to your custom controls is now so easy – you will be considered a slob if you dont use them.

But all that aside, there is still a lack of the fine-grain control you expect to find. I mean, the JVL has depth and substance, no doubt there — but you still cant stop a GPU based animation. Silly as it may sound.

Tweening is about moving from A to B during a timeline

This is actually not a shortcoming of our RTL or code. We have implemented both start and stop mechanisms according to HTML5/CSS RFC specification. It’s just that no modern browser has bothered to implement the stop() method, because ordinary JS developers dont use these effects like we do. We have classes, inheritance and all the other goodies which means we approach problems differently.

Tween your heart out

Like mentioned, CSS animations has the benefit of being GPU powered. Meaning that it uses the custom-graphics-chipset of your phone or computer to move things around. Which is really neat and powerful. The downside is that these GPU animations cant really be stopped once you start them. They have to play out before you regain control of the animated HTML element. And to make matters worse, you can only execute one effect at a time on any visual element.

But why do we use them? Well, they are pretty and makes tweening easier. To “tween” simply means to move between two values over a stretch of time, applying some effect to start and end-points. Like all things in programming you provide meaning to the value by using it for something. All tweening does is to move between A and B using a special formula.

To make stuff move around, like say, navigating between two forms in typical iOS fashion, you would manipulate the “left” property of the two forms being moved between. One should move out of view and the other into view. It’s actually quite simple once you get the hang of it.

The other kids are doing it

For a while now I have watched other libraries and frameworks use more and more CPU based tweens. It feels like cheating since I take great pride in having sculpted so much of the RTL by hand, solving problems step by step and thinking it all through. But the sad fact is that fiddling with hardware and GPU control is getting old. The CPU in the latest generation of mobile phones is en-par with PC’s only a couple of years back. More than capable of smoothly moving forms and buttons around.

It looks super slick, but it’s just fancy Tweens + CSS3

Needless to say, I have ported over a famous tweening library to Smart Pascal. This gives us access to a whole host of interesting stuff. Not just movement and being able to stop effects and so on, but also the ability to move between colors, objects, a timeline and much, much more. So I will be replacing as many of the GPU effects in the RTL with Tweens.

Example, moving a button

Right. A quick example but an important one. We are going to move a button smoothly from A to B, applying a quad-filter that eases the animation in and out. This just means that it moves slower to begin with, then accellerates, and then slows down towards the end. Just like iPhone controls do. So let’s look at the code.

procedure TForm1.UpdateAnim;
begin
  var value := FTween.GetValue;
  writeln(Value);
  w3_RequestAnimationFrame( procedure ()
  begin
    w3button3.left := Round(value);
  end);
  if not FTween.Expired then
  w3_callback( UpdateAnim, 10);
end;

procedure TForm1.W3Button4Click(Sender: TObject);
begin
  FTween := TW3Tween.Create(
    w3button3.left, // startvalue
    200,            // advance
    400,          // duration
    ttQuadInOut,'');
  w3_callback( UpdateAnim, 10);
end;

Now, start by looking at the second procedure (w3Button4Click). Here we create a tweening object, and then we start an update loop which will continue in the background until the tween has expired (finish).

The first parameter is the starting value. Since we will be moving a button smoothly from A to B, I just use the X position of the control here.

Second parameter is the distance or “how much should the original number advance”. If you want to move the button 200 pixels to the right, then 200 is the value you use here.

The third parameter is the duration of the tween, or how long it should take to finish the animation. This is the number of milliseconds it should take to transform the original value, into the target value. The larger the number, the slower the animation executes.

The fourth parameter is the ease-filter. We have several filters available. You will have to try them all out to find one you like. So far I have added support for the following ease filters (more will be added soon):

• ttLinear
• ttQuadIn
• ttQuadOut
• ttQuadInOut
• ttCubeIn
• ttCubeOut
• ttCubeInOut
• ttQuartIn
• ttQuartOut
• ttQuartInOut

The fifth parameter controls looping and execution mode. This is presently defined as a string because I will add more options to it, but havent gotten around to it yet. So far the options are:

• [empty]     – No loop
• “repeat”    – Keep on repeating the animation
• “reverse”  – Execute in a toggle between start and stop value

Note: The final option, reverse, is special. It will execute your animation from A to B, but then execute the animation back, from B to A. This option loops.

Updating the tween object

With the tween object created all you have to do is to call the GetValue() method. It’s really nothing more to it than that. It will calculate the position according to where you are on the time-line and return the present position.

If you want to stop the tween, then simply stop calling GetValue().

So what are you waiting for! Go out there and write a super nice animated toolbar!

unit system.animation.tween;

interface

uses
  System.Types,
  SmartCL.System;

type

  TW3TweenAnimationType = (
    ttlinear,
    ttQuadIn,
    ttQuadOut,
    ttQuadInOut,
    ttCubeIn,
    ttCubeOut,
    ttCubeInOut,
    ttQuartIn,
    ttQuartOut,
    ttQuartInOut
    );

  TW3TweenEase = class
  public
    class function  Linear(t,b,c,d:float):float;
    class function  QuadIn(t, b, c, d:float):float;
    class function  QuadOut(t, b, c, d:float):float;
    class function  QuadInOut(t, b, c, d:float):float;
    class function  CubeIn(t, b, c, d:float):float;
    class function  CubeOut(t, b, c, d:float):float;
    class function  CubeInOut(t, b, c, d:float):float;
    class function  QuartIn(t, b, c, d:float):float;
    class function  QuartOut(t, b, c, d:float):float;
    class function  QuartInOut(t, b, c, d:float):float;
  end;

  TW3Tween = class
  private
    FStartTime:     TDateTime;
    FStartValue:    float;
    FDistance:      float;
    FDuration:      float;
    FAnimationtype: TW3TweenAnimationType;
    FLoop:          string;
  protected
    class function  RoundTk(num:float):float;
    class function  TimeCode:float;
    function    DoTween(t, b, c, d:float):float;
  public
    function    Expired:Boolean;
    function    GetValue:float;
    function    GetStartTime:TDateTime;
    constructor Create(aStartValue,aDistance,aDuration:float;
                aAnimationType:TW3TweenAnimationType;aLoop:String);virtual;
  end;

implementation

//############################################################################
// TW3Tween
//############################################################################

constructor TW3Tween.Create(aStartValue,aDistance,aDuration:float;
            aAnimationType:TW3TweenAnimationType;aLoop:string);
begin
  inherited Create;
  FStartTime := TimeCode;
  FStartValue := aStartValue;
  FDistance:= aDistance;
  FDuration := aDuration;
  FAnimationtype := aAnimationtype;
  FLoop := aLoop;
end;

class function TW3Tween.TimeCode:float;
begin
  asm
    @result = Date.now();
  end;
end;

function TW3Tween.DoTween(t, b, c, d:float):float;
begin
  result := 0.0;
  case FAnimationtype of
  ttlinear:     result := TW3TweenEase.Linear(t,b,c,d);
  ttQuadIn:     result := TW3TweenEase.QuadIn(t,b,c,d);
  ttQuadOut:    result := TW3TweenEase.QuadOut(t,b,c,d);
  ttQuadInOut:  result := TW3TweenEase.QuadInOut(t,b,c,d);
  ttCubeIn:     result := TW3TweenEase.CubeIn(t,b,c,d);
  ttCubeOut:    result := TW3TweenEase.CubeOut(t,b,c,d);
  ttCubeInOut:  result := TW3TweenEase.CubeInOut(t,b,c,d);
  ttQuartIn:    result := TW3TweenEase.QuartIn(t,b,c,d);
  ttQuartOut:   result := TW3TweenEase.QuartOut(t,b,c,d);
  ttQuartInOut: result := TW3TweenEase.QuartInOut(t,b,c,d);
  end;
end;

function TW3Tween.GetValue:float;
var
  LTotal: float;
begin

  if not Expired then
  begin
    LTotal := DoTween(TimeCode-FStartTime,FStartValue,FDistance,FDuration);
  end else
  if FLoop='' then
  begin
    LTotal := FStartValue + FDistance;
  end else
  if FLoop = 'repeat' then
  begin
    FStartTime := TimeCode;
    LTotal := DoTween(TimeCode-FStartTime,FStartValue,FDistance,FDuration);
  end else
  if FLoop = 'reverse' then
  begin
    FStartValue := FStartValue + FDistance;
    FDistance := -FDistance;
    FStartTime := TimeCode;
    LTotal := DoTween(TimeCode-FStartTime,FStartValue,FDistance,FDuration)
  end;

  result := RoundTk(LTotal);
end;

function TW3Tween.Expired:Boolean;
begin
  result := FStartTime + FDuration < TimeCode;
end;

function TW3Tween.GetStartTime:TDateTime;
begin
  result := Now - FStartTime - FDuration + TimeCode;
end;

class function TW3Tween.RoundTk(num:float):float;
begin
  result := Round( Num * 100) / 100;
end;

//#############################################################################
//  TW3TweenEase
//#############################################################################

class function TW3TweenEase.QuartIn(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return @c * @t * @t * @t * @t + @b;
  end;
end;

class function TW3TweenEase.QuartOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    @t--;
    return -@c * (@t * @t * @t * @t - 1) + @b;
  end;
end;

class function TW3TweenEase.QuartInOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d/2;
    if (@t < 1) {
        return @c / 2 * @t * @t * @t * @t + @b;
    }
    @t -= 2;
    return -@c / 2 * (@t * @t * @t * @t - 2) + @b;
  end;
end;

class function TW3TweenEase.CubeInOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d/2;
    if (@t < 1) {
      return @c / 2 * @t * @t * @t + @b;
    }
    @t -= 2;
    return @c/2 * (@t * @t * @t + 2) + @b;
  end;
end;

class function TW3TweenEase.CubeOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    @t--;
    return @c * (@t * @t * @t + 1) + @b;
  end;
end;

class function TW3TweenEase.CubeIn(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return @c * @t * @t * @t + @b;
  end;
end;

class function TW3TweenEase.QuadInOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d/2;
    if (@t < 1) {
      return @c / 2 * @t * @t * @t + @b;
    }
    @t -= 2;
    @result = @c/2*(@t * @t * @t + 2) + @b;
  end;
end;

class function TW3TweenEase.QuadOut(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return -@c * @t * (@t - 2) + @b;
  end;
end;

class function TW3TweenEase.QuadIn(t, b, c, d:float):float;
begin
  asm
    @t /= @d;
    return @c * @t * @t + @b;
  end;
end;

class function TW3TweenEase.Linear(t,b,c,d:float):float;
begin
  asm
   @result = @c * @t / @d + @b;
  end;
end;

end.

Edge sense controller, Smart style

Yesterday I posted a short low-down on how to use TW3Dataset in your Smart Mobile Studio applications; I also included the source code for a CSS powered, heavy duty DB grid I’m working on.

Today I’m going to extract on one of the concepts I use in that DB grid, isolate it as a separate class and explain what you can do with it.

Edge sense

Being able to sense when the mouse-pointer is near the edge of a control (any edge) is very useful, especially when dealing with presentation of columns and rows you want to make re-sizable. It can however be a bit tricky to master.

Below you will find the working source-code for a completely separate controller class which adds edge-sense functionality. I have written it as a controller and not a part of TW3Customcontrol (or inheriting from any other visual component) to make sure it can be used more generally. As it stands now it will happily attach itself to any TW3MovableControl based visual component, create its own event handlers and update the mouse-pointer automatically.

Why controller?

Well, imagine you are creating a DB grid header component. Naturally you want your users to be able to resize the columns as they see fit. Well, this can be achieved in two ways. The first is that you implement edge-sensing directly into the column components themselves. But that means a lot of extra work. You would have to derive your column from a baseclass, hook mouse events and well, basically implement exactly what you get for free below.

The second option, which I have used here, is to have a separate “sense” object which keeps track of everything without interfering with any events or behavior. This means a bit more code to achieve but once you have isolated it as a class, you can apply it to nearly all visual controls.

A few words about abstraction

When writing your own custom components, always derive your own class-names even though you dont alter behavior. This should always be respected. First of all because of styling (css styles wont collide, and you can now safely style every aspect of your control) but also because of clarity.

So if your grid-header is made up of labels (which makes sense, considering a header with columns display, well, text) dont just use TW3Label. Derive your own class from TW3label and use that, like this:

type

TDBHeaderItem = class(TW3Label)
end;

TW3HeaderControl = class(TW3CustomControl)
protected
  procedure InitializeObject;Override;
end;

procedure TW3HeaderControl.InitializeObject;
begin
  inherited;
  var first := TDBHeaderItem.Create(self);
  var second := TDBHeaderItem.Create(self);
  ..
  handle.ReadyExecute( procedure ()
    begin
      Resize;
    end);
end;

In the above code, if we had just created a series of TW3Label’s, there would be no way of styling the columns without ruining the style for *ALL* TW3Label elements in your entire application. By simply deriving your own class and using that, you can now safely a style in the stylesheet which affects just your header-item(s).

The edge sense controller

Here is the code. To use it, simply give it the visual component you want to have sense-control in the constructor, and that’s basically it. You must expand the class yourself to add size/move functionality but that should be easy (and self explanatory):

type

  TEdgeRegions    = (scLeft,scTop,scRight,scBottom,scNone);
  TEdgeSenseEdges = set of TEdgeRegions;

  TEdgeSenseController = class(TW3OwnedObject)
  const
    CN_LEFT   = 0;
    CN_TOP    = 1;
    CN_RIGHT  = 2;
    CN_BOTTOM = 3;
  private
    FEdgeSize:Integer;
    FEdges:   TEdgeSenseEdges;
    FRects:   Array[0..3] of TRect;
    FEdgeId:  Integer;
    FBound:   Boolean;

    procedure CBMouseMove(eventObj : JMouseEvent);
    procedure CBMouseEnter(eventObj : JMouseEvent);
    procedure CBMouseExit(eventObj : JMouseEvent);

    procedure SetEdgeSize(const Value:Integer);
    Procedure SetSenseEdges(const Value:TEdgeSenseEdges);
    function  GetActiveEdge:TEdgeRegions;

    procedure CheckCorners(const x,y:Integer);
    function  GetActiveEdgeOffset(x,y:Integer):TPoint;

  protected
    procedure MouseMove(shiftState:TShiftState;x,y:Integer);
    procedure MouseEnter(shiftState:TShiftState;x,y:Integer);
    procedure MouseExit(shiftState:TShiftState;x,y:Integer);
  public

    procedure BindToControl;
    procedure UnBindFromControl;
    procedure UpdateCursor;

    procedure   Update;

    Constructor Create(AOwner:TW3MovableControl);reintroduce;
    Destructor  Destroy;Override;

    property  EdgeSize:Integer read FEdgeSize write SetEdgeSize;
    Property  ActiveEdge:TEdgeRegions read getActiveEdge;
    Property  SenseEdges:TEdgeSenseEdges read FEdges write SetSenseEdges;
  end;

Constructor TEdgeSenseController.Create(AOwner:TW3MovableControl);
begin
  inherited Create(AOwner);
  FEdges:=[scLeft,scTop,scRight,scBottom];
  FEdgeSize:=10;
  BindToControl;
end;

Destructor TEdgeSenseController.Destroy;
begin
  UnBindFromControl;
  inherited;
end;

procedure TEdgeSenseController.Update;
Begin
  if FBound then
  begin
    var LOwner := TW3MovableControl(Owner);
    FRects[0]:=TRect.CreateSized(0,EdgeSize,EdgeSize,LOwner.ClientHeight-EdgeSize);
    FRects[1]:=TRect.CreateSized(0,0,LOwner.ClientWidth,EdgeSize);
    FRects[2]:=TRect.CreateSized(LOwner.ClientWidth-EdgeSize,EdgeSize,LOwner.Clientwidth,LOwner.ClientHeight-EdgeSize);
    FRects[3]:=TRect.CreateSized(0,LOwner.ClientHeight-EdgeSize,LOwner.ClientWidth,EdgeSize);
  end else
  begin
    FRects[0]:=TRect.NullRect;
    FRects[1]:=TRect.NullRect;
    FRects[2]:=TRect.NullRect;
    FRects[3]:=TRect.NullRect;
  end;
end;

procedure TEdgeSenseController.UpdateCursor;
var
  mCursor:  string;
  LOwner: TW3MovableControl;

  procedure doDefault;
  begin
    if mCursor<>'default' then
    w3_setStyle(LOwner.Handle,'cursor','default');
  end;

begin
  LOwner := TW3MovableControl(Owner);

  mCursor:=w3_getStyleAsStr(LOwner.Handle,'cursor').LowerCase;

  case FEdgeId of
    CN_LEFT:
      Begin
        if (scLeft in FEdges) then
        begin
          if mCursor<>'col-resize' then
          w3_setStyle(LOwner.Handle,'cursor','col-resize');
        end else
        doDefault;
      end;
    CN_RIGHT:
      Begin
        if (scRight in FEdges) then
        begin
          if mCursor<>'col-resize' then
          w3_setStyle(LOwner.Handle,'cursor','col-resize');
        end else
        doDefault;
      end;
    CN_TOP:
      begin
        if (scTop in FEdges) then
        begin
          if mCursor<>'row-resize' then
          w3_setStyle(LOwner.Handle,'cursor','row-resize');
        end else
        doDefault;
      end;
    CN_BOTTOM:
      begin
        if (scBottom in FEdges) then
        begin
          if mCursor<>'row-resize' then
          w3_setStyle(LOwner.Handle,'cursor','row-resize');
        end else
        doDefault;
      end;
    else
    doDefault;
  end;
end;

procedure TEdgeSenseController.CheckCorners(const x,y:Integer);
var
  mItem:TRect;
  mIndex: Integer;
begin
  FEdgeId:=-1;
  for mItem in FRects do
  begin
    if mItem.ContainsPos(x,y) then
    begin
      FEdgeId:=mIndex;
      break;
    end;
    inc(mIndex);
  end;
end;

function TEdgeSenseController.GetActiveEdgeOffset(x,y:Integer):TPoint;
begin
  if FEdgeId>=0 then
  result:=TPoint.Create
    ( x - FRects[FEdgeId].Left,
      y - FRects[FEdgeId].Top
    );
end;

function TEdgeSenseController.getActiveEdge:TEdgeRegions;
begin
  if (FEdgeId>=0) and (FEdgeId<=3) then
  result:=TEdgeRegions(FEdgeid) else
  result:=scNone;
end;

Procedure TEdgeSenseController.SetSenseEdges(const Value:TEdgeSenseEdges);
begin
  if (scLeft in Value) then Include(FEdges,scLeft) else Exclude(FEdges,scLeft);
  if (scTop in Value) then include(FEdges,scTop) else Exclude(FEdges,scTop);
  if (scRight in Value) then Include(FEdges,scRight) else
  Exclude(FEdges,scRight);
  if (scBottom in Value) then include(FEdges,scBottom) else
  Exclude(FEdges,scBottom);
end;

procedure TEdgeSenseController.SetEdgeSize(const Value:Integer);
begin
  FEdgeSize := TInteger.EnsureRange(Value,4,32);
end;

procedure TEdgeSenseController.BindToControl;
begin
  if not FBound then
  begin
    var LOwner := TW3MovableControl(Owner);
    LOwner.handle.addEventListener('mousemove',@CBMouseMove,true);
    LOwner.handle.addEventListener('mouseover',@CBMouseMove,true);
    LOwner.handle.addEventListener('mouseout',@CBMouseMove,true);
    FBound := True;
  end;
end;

procedure TEdgeSenseController.UnBindFromControl;
begin
  if FBound then
  begin
    var LOwner := TW3MovableControl(Owner);
    LOwner.handle.removeEventListener('mousemove',@CBMouseMove,true);
    LOwner.handle.removeEventListener('mouseover',@CBMouseMove,true);
    LOwner.handle.removeEventListener('mouseout',@CBMouseMove,true);
    FBound := false;
  end;
end;

procedure TEdgeSenseController.MouseMove(shiftState:TShiftState;x,y:Integer);
begin
  if FBound then
  begin
    Update;
    CheckCorners(x,y);
    UpdateCursor;
  end;
end;

procedure TEdgeSenseController.MouseEnter(shiftState:TShiftState;x,y:Integer);
begin
  if FBound then
  begin
    Update;
    CheckCorners(x,y);
    UpdateCursor;
  end;
end;

procedure TEdgeSenseController.MouseExit(shiftState:TShiftState;x,y:Integer);
begin
  if FBound then
  begin
    Update;
    CheckCorners(x,y);
    UpdateCursor;
  end;
end;

procedure TEdgeSenseController.CBMouseMove(eventObj : JMouseEvent);
begin
  var LOwner := TW3MovableControl(Owner);
  var sr := LOwner.ScreenRect;
  var shiftState := TShiftState.Current;
  shiftState.MouseEvent := eventObj;
  MouseMove(shiftState, eventObj.clientX - sr.Left, eventObj.clientY - sr.Top);
end;

procedure TEdgeSenseController.CBMouseEnter(eventObj : JMouseEvent);
begin
  var LOwner := TW3MovableControl(Owner);
  var sr := LOwner.ScreenRect;
  var shiftState := TShiftState.Current;
  shiftState.MouseEvent := eventObj;
  MouseEnter(shiftState, eventObj.clientX - sr.Left, eventObj.clientY - sr.Top);
end;

procedure TEdgeSenseController.CBMouseExit(eventObj : JMouseEvent);
begin
  var LOwner := TW3MovableControl(Owner);
  var sr := LOwner.ScreenRect;
  var shiftState := TShiftState.Current;
  shiftState.MouseEvent := eventObj;
  MouseExit(shiftState, eventObj.clientX - sr.Left, eventObj.clientY - sr.Top);
end;

TW3Dataset, Smart Data and what you can do

In my previous post, I have requested some input from users about what they would like in the future of SMS. The question of the hour being what features or architecture would you guys like to have regarding databases and data-bound controls?

In this short post I want to write some words about what is already in Smart Mobile Studio and what you can do right now. I have also added the source code for a CSS3 powered DB grid (98% finished) that you can play with. So plenty of things in the pipeline for Smart Mobile Studio. Right, let’s get cracking and have a look at whats on the menu!

TW3Dataset

TClientDataset, not a lightweight

Delphi has one component which is completely and utterly unappreciated; and that is TClientDataset. This really is a fantastic piece of code (really, hear me out). First, it was written to be completely datatype agnostic and stores raw values as variants. That in itself is a monumental achievement considering that Delphi’s variants are binary compatible with Microsoft COM variants (read: sluggish, slow, and a proverbial assault on the CPU stack). Secondly, it makes use of variant-arrays to pack columns into a portable, single variant record. The author should be given a medal for not commiting suicide while creating that component. And this is just scratching the surface of TClientDataset, it really is awesome once you get the hang of it. It can act as a stand-alone, in memory only, table. It can act as a intermediate local data cache, keeping track of record changes, tagging, reverts and everything under the sun – before pushing it to a master data provider. So you can locally work with a database on the other side of the world, caching up changes and then push the whole changeset in one go.

TClientDataset is so confusing and had so much potential that Cary Jensen sat down and wrote a full 350 page book on the subject. A lot of Delphi and FreePascal developers just laugh when they hear someone mention TClientDataset, but that component is a gem if you know how to use it properly.

What about Smart?

Smart Mobile Studio ships with wrappers for WebSQL only. IndexDB will be included in the next update, but I seriously advice against using it unless you are going to package your final product with PhoneGap. Both WebSQL and IndexDB represents an onslaught of callback events, to the point of being useless in anything but JavaScript.

Only experienced and advanced Smart developers will be able to master these beasts. I have done my best to simplify their use, but I must admit I hardly ever use these myself. WebSQL is “OK” to use when you package your app with Phonegap; that takes away the 5Mb limitation and extends the procedure execution time — but other than that, all my large apps use TW3Dataset for storage.

Right. Let’s sum up what Smart Mobile Studio has to offer right now when it comes to databases and data transportation:

WebSQL

WebSQL is a small and compact SQL database. Most browsers include SQLite and simply expose that through JavaScript. In Smart Mobile Studio WebSQL is encapsulated as classes and actions in the unit SmartCL.DbSQL.pas. While WebSQL is by far the best HTML5 database, please note that it’s been marked as deprecated (meaning: it will be phased out and removed in the future). Also, it has a limitation of 5-10 megabytes per database. WebSQL is excellent if you use PhoneGap to package your final product (and you know your way around JavaScript to begin with). Phonegap removes the storage limitation and also extends the JSVM execution limitation (a procedure call must return within 2 seconds), allowing you to operate with large and complex queries.

DataSnap

Datasnap is a Delphi technology for exposing databases and RPC (remote procedure call) services to the world. Datasnap clients can call datasnap servers to obtain data, invoke methods and so on. Datasnap is an excellent way of re-using your Delphi back-end services with HTML5 or mobile applications. Smart Mobile Studio supports DataSnap out of the box, so if your company has existing datasnap databases available, your Smart applications can connect and make use of them.

It must however be mentioned that third party solutions like Mormoth offer much better performance and stability than Datasnap. Mormoth also supports Smart Mobile Studio.

Remobjects SDK

While not really a DB framework, Smart Mobile Studio can connect and invoke RO services. This opens up for some very exciting possibilities, and pushing data over an RPC framework is not hard to do. It’s also a great way to re-cycle existing RO based native services with your HTML5 or mobile applications. Smart Mobile Studio can import RO service libraries and generate Smart Pascal client interfaces for you.

TW3Dataset

This is a single table database engine written in Smart Pascal itself. It has no support for SQL or filtering (as of writing) but also no limitation on size. File storage under JSVM is however limited to the same 5-10 megabyte restriction as WebSQL, but the limitations mentioned are removed by PhoneGap. Since PhoneGap is what you want to use in getting your product onto AppStore, Google Play or Android Marketplace, the storage limitation has no real impact.

Working with TW3Dataset

Tw3Dataset was designed to be Smart Mobile Studio’s version of TClientDataset for Delphi (read: inspired but less complex) and it will no doubt grow as we establish our DB framework in 2016. You can use it to keep track of local data changes, but you have to reserve a field for that information yourself. TW3Dataset is simply a small, in memory, to the point dataset which is perfect for applications that doesnt generate huge amounts of data. It should also remain as small and compact as possible because it acts as a building-block for more complex components.

Why is this useful? Well consider this as an example: Developer Express, a great company offering a wide variety of components, sell components that mimic and implement Microsoft Outlook. You have the calendar, the day planner, the vertical scrolling menu system, the freestyle note editing; DevEx have more or less reverse engineered the visual components that make up Microsoft Outlook. The downside? Well, with such a complex, inter-connected component set, the information it generates and depends on is equally complex! So DevEx allows you to store the data directly to an existing database. They also provide a drop-in solution, in-memory tables that are created and maintained by the components for you. This is a perfect situation where a TW3Dataset would be handy to use. Rather than exposing a ton of storage events, so many that it overwhelms the developer — the components can deal with all of that and just give you a handy way of loading and saving that data.

This is the idea behind TW3Dataset. It was designed not to be complex, support SQL or any advanced features. It should be simple so people can use it to create large and complex components that can export and import data in a uniform way.

Creating a table

Before we create a table, we first have to define what the table looks like. This is done by populating the field-definitions property. TW3Dataset supports generated fields, so you can have both AutoInc and GUID fields which are generated automatically. When you have populated the field-definistions, we simply call CreateDataset() to establish the table.

var
LDataset: TW3Dataset;

LDataset.FieldDefs.Add('id',ftAutoInc);
LDataset.fieldDefs.Add('firstname',ftString);
LDataset.fieldDefs.Add('lastname',ftString);
LDataset.fieldDefs.add('text',ftString);

LDataset.CreateDataset;

Adding records

Adding records to the dataset is straight forward and more or less identical to how you would do it under Delphi. You have both append and insert operations. Let’s use Append for this example:

var
x: Integer;
LDataset: TW3Dataset;

LDataset.FieldDefs.Add('id',ftAutoInc);
LDataset.fieldDefs.Add('firstname',ftString);
LDataset.fieldDefs.Add('lastname',ftString);
LDataset.fieldDefs.add('text',ftString);
LDataset.CreateDataset;

for x:=1 to 10 do
begin
  LDataset.Append;
  LDataset.Fields.FieldByName('firstname').AsString := 'John';
  LDataset.Fields.FieldByName('firstname').AsString := 'Doe';
  LDataset.Fields.FieldByName('text').AsString:='This is #' + x.toString;
  LDataset.Post;
end;

As you can see from the code above, calling the Append() method sets the dataset in insert mode. This means it allocates the memory needed to hold the record, generates the automatic values (ID autoinc in this case) and allows access to the fields object. If you try to alter values without being in Insert or Edit mode, an exception is raised. This is standard for most languages so nothing new here. The Post() method commits the record buffer to the table, storing it in memory.

Navigating the data

Navigation is done via First, Last, Next, Back methods. You can also check for eof-of-file and beginning-of-file via traditional BOF and EOF properties. So let’s traverse the dataset we just created and dump the output to the console!

var
x: Integer;
LDataset: TW3Dataset;

LDataset.FieldDefs.Add('id',ftAutoInc);
LDataset.fieldDefs.Add('firstname',ftString);
LDataset.fieldDefs.Add('lastname',ftString);
LDataset.fieldDefs.add('text',ftString);
LDataset.CreateDataset;

for x:=1 to 10 do
begin
  LDataset.Append;
  LDataset.Fields.FieldByName('firstname').AsString := 'John';
  LDataset.Fields.FieldByName('firstname').AsString := 'Doe';
  LDataset.Fields.FieldByName('text').AsString:='This is #' + x.toString;
  LDataset.Post;
end;

LDataset.first;
while not lDataset.EOF do
begin
  var id  := LDataset.fields.fieldbyname('id').asString;
  var txt := LDataset.fields.fieldbyname('text').asString;
  writeln(id + ' ' + txt);
  LDataset.Next;
end;

And here is the output in the console:

The output is as expected in the console

Loading and saving

TW3Dataset allows you to save your data to a normal string or a stream. You may remember that in our last update we added TStream support as well as the possebility to allocate and work with raw memory? Well, TW3Dataset makes storage very simple. Since it exports ordinary JSON in text format, you can also use TW3Dataset as an intermediate format. It’s small enough (depending on the number of records) to be pushed to a server, and also a convenient format for retrieving X number of records from a server.

For storing datasets locally, in the browser or on your phone, just use TLocalStorage and stuff the data there. Just be aware of the limitation your browser impose on you when not running under PhoneGap (max 5-10 megabyte, the limit toggles between these depending on browser type and build number).

function    SaveToString:String;
Procedure   LoadFromString(Const aText:String);

Procedure   SaveToStream(const Stream:TStream);virtual;
Procedure   LoadFromStream(const Stream:TStream);virtual;

Grids

This has been somewhat missing in Smart Mobile Studio. Like mentioned in my previous article, we are still working on a “final” framework for databases under Smart, and a grid cannot really be created before you have some data it can bind to. But, I have actually a grid that may be of interest. It’s actually been lying around my PC since june 2015. I’m going to publish the source for this on Github later, and you can use that until we finalize the DB framework.

It makes full use of HTML5 hardware scrolling, effects and more. It’s also heavily adaptable, so you can use CSS3 animations on rows – or transform rows into something else (like clicking a row and having the row transform into an editor). It’s pretty neat! But I still need to clean it up a bit. And there is a handfull of features that must be added to the RTL before it can be used by everyone. Here is a picture of it. It doesnt capture the CSS3 animations or the animated column-dragging, but its pretty neat 🙂

A MS-Phone Skinned grid and header control

If you want to play around with the source, here you go:

unit smartCL.dbgrid;

interface

uses 
  System.Types,
  system.types.convert,
  System.colors,
  SmartCL.system,
  SmartCL.Components,
  SmartCL.Controls.Label,
  SmartCL.Fonts,
  SmartCL.Borders,
  SmartCL.Controls.ScrollBar;

type

  TEdgeSenseControl = partial class(TW3Label);
  TGridRowContainer = partial class(TW3CustomControl);
  TCustomGrid       = partial class(TW3CustomControl);


  TEdgeRegions    = (scLeft,scTop,scRight,scBottom,scNone);
  TEdgeSenseEdges = set of TEdgeRegions;

  (*  TEdgeSenseControl:
      This control checks its own edges and changes mouse cursor
      accordingly. The edges to check is defined by the SenseEdges
      pascal SET. Use setSenseEdges() to define what edges to
      check for.

      The active edge (hovered by the mouse-pointer) is reflected
      in ActiveEdge

      To get the X/Y offset of the pointer inside an edge zone,
      call getActiveEdgeOffset()

      Edge sensebility can be disabled and enabled with
      DisableSense() and EnableSense(). *)
  TEdgeSenseControl = partial Class(TW3Label)
  const
    CNT_LEFT    = 0;
    CNT_TOP     = 1;
    CNT_RIGHT   = 2;
    CNT_BOTTOM  = 3;
    CNT_SIZE    = 10;
  private
    FEdges:   TEdgeSenseEdges;
    FRects:   Array[0..3] of TRect;
    FEdgeId:  Integer;
    FSense:   Boolean;
    procedure CheckCorners(const x,y:Integer);
    procedure UpdateCursor;
  protected
    procedure DisableSense;
    procedure EnableSense;
    function  getActiveEdge:TEdgeRegions;
    function  getActiveEdgeOffset(x,y:Integer):TPoint;
  protected
    Property  ActiveEdge:TEdgeRegions read getActiveEdge;
    Property  SenseEdges:TEdgeSenseEdges read FEdges;
    Procedure setSenseEdges(const Value:TEdgeSenseEdges);virtual;
    procedure MouseMove(shiftState:TShiftState;x,y:Integer);override;
    procedure MouseEnter(shiftState:TShiftState;x,y:Integer);override;
    procedure MouseExit(shiftState:TShiftState;x,y:Integer);override;
    procedure Resize;override;
  protected
    procedure InitializeObject;Override;
  end;

  (*  TGridHeaderColumn:
      This control inherits from TEdgeSenseControl, but adds actual
      size functionality. All column-header controls can be sized
      horizontally only.
      Where the ancestor control adds sensitivity to mouse-hovering
      over the edges, this control responds to mouse-press
      while over an edge (start size operation), and will
      adjust itself according to the user's movements *)
  TGridHeaderColumn = Class(TEdgeSenseControl)
  private
    FSizing:    Boolean;
    FMoving:    Boolean;
    FStartX:    Integer;
    FStartY:    Integer;
    FNowX:      Integer;
    FBaseWidth: Integer;
    function    getGrid:TCustomGrid;
  protected
    procedure   MouseDown(button:TMouseButton;
                shiftState:TShiftState;x,y:Integer);override;
    procedure   MouseUp(button:TMouseButton;
                shiftState:TShiftState;x,y:Integer);override;
    procedure   MouseMove(shiftState:TShiftState;x,y:Integer);override;
    procedure   InitializeObject;Override;
  public
  end;

  IGridHeader = interface
    procedure ColumnReSizeBegins(const column:TGridHeaderColumn);
    procedure ColumnReSizeEnds(const column:TGridHeaderColumn);
    procedure ColumnMoveBegins(Const column:TGridHeaderColumn);
    procedure ColumnMoveEnds(const column:TGridHeaderColumn);
    procedure ColumnSized(const column:TGridHeaderColumn);
    Procedure ColumnMoved(const Column:TGridHeaderColumn);
  end;

  TGridHeaderEvent                  = procedure (Sender:TObject;
                                      Column:TGridHeaderColumn);
  TGridHeaderColumnAddEvent         = TGridHeaderEvent;
  TGridHeaderColumnSizedEvent       = procedure (sender:TObject;
                                      Column:TGridHeaderColumn;
                                      OldSize:TPoint);
  TGridHeaderColumnMovedEvent       = TGridHeaderEvent;
  TGridHeaderColumnMoveBeginsEvent  = TGridHeaderEvent;
  TGridHeaderColumnMoveEndsEvent    = TGridHeaderEvent;
  TGridHeaderColumnSizeBeginsEvent  = TGridHeaderEvent;
  TGridHeaderColumnSizeEndsEvent    = TGridHeaderEvent;

  (*  TGridHeader:
      This is the container control for TGridHeaderColumn instances.
      It implements a simple interface for updating during a
      resize of a column.
      It also modifies TW3Component->RegisterChild to only allow
      TGridHeaderColumn instances to register. If you try to create
      other types of controls with TGridHeader as parent, it will
      result in an exception *)
  TGridHeader = Class(TW3CustomControl,IGridHeader)
  private
    FOldSize: Tpoint;
    FItems:   Array of TGridHeaderColumn;
    FOnAdded: TGridHeaderColumnAddEvent;
    FOnSized: TGridHeaderColumnSizedEvent;
    FOnMoved: TGridHeaderColumnMovedEvent;
    FOnMoveBegins:TGridHeaderColumnMoveBeginsEvent;
    FOnMoveEnds:TGridHeaderColumnMoveEndsEvent;
    FOnSizeBegins:TGridHeaderColumnSizeBeginsEvent;
    FOnSizeEnds:TGridHeaderColumnSizeEndsEvent;
  protected
    procedure ChildAdded(aChild: TW3Component);override;
    procedure ChildRemoved(aChild: TW3Component);override;
    procedure RegisterChild(aChild: TW3Component);override;
  protected
    procedure ColumnSized(const column:TGridHeaderColumn);
    procedure ColumnReSizeBegins(const column:TGridHeaderColumn);
    procedure ColumnReSizeEnds(const column:TGridHeaderColumn);
    procedure ColumnMoveBegins(Const column:TGridHeaderColumn);
    procedure ColumnMoveEnds(const column:TGridHeaderColumn);
    Procedure ColumnMoved(const Column:TGridHeaderColumn);
    procedure Resize;Override;
    Procedure StyleTagObject;override;
  public
    property  Identifier:Integer;

    Property  Columns[index:Integer]:TGridHeaderColumn
              read ( FItems[index] );
    Property  Count:Integer read ( FItems.length );
    function  Add:TGridHeaderColumn;overload;
    function  Add(Caption:String):TGridHeaderColumn;overload;
    Procedure Adjust;
    procedure Clear;

    procedure UpdateIdentifier;

    procedure FinalizeObject;Override;
  published
    Property  OnColumnAdded:TGridHeaderColumnAddEvent
              read FOnAdded write FOnAdded;
    Property  OnColumnSized:TGridHeaderColumnSizedEvent
              read FOnSized write FOnSized;
    Property  OnColumnMoved:TGridHeaderColumnMovedEvent
              read FOnMoved write FOnMoved;

    Property  OnMoveOperationBegins:TGridHeaderColumnMoveBeginsEvent
              read FOnMoveBegins write FOnMoveBegins;

    Property  OnMoveOperationEnds:TGridHeaderColumnMoveEndsEvent
              read FOnMoveEnds write FOnMoveEnds;

    Property  OnSizeOperationBegins:TGridHeaderColumnSizeBeginsEvent
              read FOnSizeBegins write FOnSizeBegins;

    Property  OnSizeOperationEnds:TGridHeaderColumnSizeEndsEvent
              read FOnSizeEnds write FOnSizeEnds;
  end;

  TGridVerticalScrollbar = Class(TW3VerticalScrollbar)
  end;

  TGridDataItem   = class(TW3CustomControl)
  public
    Property  ColumnItem:TGridHeaderColumn;
  end;

  (* This class represents a single column in a row.
     It is created as a child of TW3GridDataRow. *)
  TGridDataColumn = Class(TGridDataItem)
  protected
    procedure   InitializeObject;Override;
  end;

  (* This class represents the left-most edit cursor *)
  TGridEditorColumn = Class(TGridDataItem)
  end;

  IGridDataRow = Interface
    Procedure   Populate;
  end;

  TW3GridDataRow  = Class(TGridDataItem,IGridDataRow)
  private
    FSelected:  Boolean;
    FEditCol:   TGridEditorColumn;
    Procedure   Populate;
  protected
    function    getGrid:TCustomGrid;
    procedure   setSelected(Const Value:Boolean);
    procedure   Resize;Override;
    procedure   InitializeObject;Override;
    procedure   FinalizeObject;Override;
  protected
    procedure   MouseDown(button:TMouseButton;
                shiftState:TShiftState;x,y:Integer);override;
  public
    Property  Parent:TGridRowContainer read (TGridRowContainer(inherited Parent));

    Property    Index:Integer;
    Property    Identifier:Integer;
    Property    Column[index:Integer]:TGridDataColumn
                read ( TGridDataColumn(getChildObject(index)) );
    Property    Count:Integer read ( getChildCount );
    Property    Selected:Boolean read FSelected write setSelected;

    procedure   UpdateIdentifier;
    procedure   Update;

  end;

  TGridRowInfo = Record
    DOM:    TW3GridDataRow;
  end;

  (*  TGridRowContainer
      =================
      This is a container control which is created as a direct child
      element on the grid. All rows are created inside this container, and
      when scrolling occurs - it's actually this container which we target
      for scrolling *)
  TGridRowContainer = Class(TW3CustomControl)
  public
    Property  Parent:TCustomGrid read (TCustomGrid(inherited Parent));

    Property  Count:Integer read ( inherited getChildCount );
    Property  Rows[index:Integer]:TW3GridDataRow read
              ( TW3GridDataRow( inherited getChildObject(index) ) );default;
  end;

  TGridOptions = class(TW3OwnedObject)
  private
    FScrollDelay: Integer;
  protected
    procedure setScrollDelay(Value:Integer);virtual;
  public
    Property  Owner:TCustomGrid read (TCustomGrid(inherited Owner));
    Property  AllowSelect:Boolean;
    property  AllowColSize:Boolean;
    Property  AllowColMove:Boolean;
    Property  RowSelect:Boolean;
    Property  ShowEditCol:Boolean;
    Property  ScrollDelay:Integer read FScrollDelay write setScrollDelay;
  end;

  IGridStyler = Interface
    procedure StyleRow(Const Index:Integer;
              Const Row:TW3GridDataRow);
    procedure StyleColumn(const Index:Integer;
              const Col:TGridDataColumn);
    procedure StyleClientArea(const control:TGridRowContainer);
    procedure StyleNonClientArea(const control:TCustomGrid);
    Procedure RowSelected(const Index:Integer;
              const Row:TW3GridDataRow);
    procedure RowUnselected(const Row:TW3GridDataRow);
    procedure ColumnSelected(const index:Integer;
              const Column:TGridDataColumn);
    procedure ColumnUnSelected(Column:TGridDataColumn);
  end;

  TGridStyler = Class(TObject,IGridStyler)
  protected
    procedure StyleRow(Const Index:Integer;
              Const Row:TW3GridDataRow);virtual;

    procedure StyleColumn(const Index:Integer;
              const Col:TGridDataColumn);virtual;

    procedure StyleClientArea(const control:TGridRowContainer);virtual;

    procedure StyleNonClientArea(const control:TCustomGrid);virtual;

    Procedure RowSelected(const Index:Integer;
              const Row:TW3GridDataRow);virtual;

    procedure RowUnselected(const Row:TW3GridDataRow);virtual;

    procedure ColumnSelected(const index:Integer;
              const Column:TGridDataColumn);virtual;

    procedure ColumnUnSelected(Column:TGridDataColumn);virtual;
  end;

  TGridTools = Class(TW3CustomControl)
  end;

  TCustomGrid = Class(TW3CustomControl)
  const
    CNT_CREATE_DELAY  = 100;
  private
    FRowInfo: Array of TGridRowInfo;  // LUT for items
    FExInfo:  Array of Integer;       // LUT for items with custom height
    FStack:   Array of Integer;
    FHeader:  TGridHeader;
    FRowSize: Integer = 24;
    FContainer: TGridRowContainer;
    FTools:   TGridTools;
    FVScroll: TGridVerticalScrollbar;
    FOptions: TGridOptions;
    procedure HandleScroll(Sender:TObject);
    procedure ProcessStack;
  protected

    procedure HandleHeaderColumnMoved
              (Sender:TObject;Column:TGridHeaderColumn);virtual;
    procedure HandleHeaderColumnSized(Sender:TObject;Column:TGridHeaderColumn;
              OldSize:TPoint);virtual;
  protected
    function  getPageSize:Integer;
    procedure setGeneralRowHeight(const Value:Integer);virtual;
    function  getContentHeight:Integer;
    function  getTopItemIndex:Integer;
    function  getOffsetForItem(Const RowIndex:Integer):Integer;

    Procedure Render;
  protected
    procedure Resize;override;
    procedure InitializeObject;override;
    procedure FinalizeObject;Override;
  public
    Property  Options:TGridOptions read FOptions;
    Property  RowHeight:Integer read FRowSize write setGeneralRowHeight;
    Property  Header:TGridHeader read FHeader;

    procedure ShowTools;

    function  IndexOfRow(Const Row:TW3GridDataRow):Integer;

    function  Add(const Index:Integer):TW3GridDataRow;
    procedure Allocate(Rows:Integer);
    procedure Clear;
  end;


implementation

uses  system.memory,
      system.streams,
      system.dateutils,
      system.types.convert;

//############################################################################
// TGridStyler
//############################################################################


procedure TGridStyler.StyleRow(Const Index:Integer;
          Const Row:TW3GridDataRow);
begin
  case index mod 2 of
  0:  Row.background.fromColor(clRed);
  1:  row.background.fromColor(clWhite);
  end;
end;

procedure TGridStyler.StyleColumn(const Index:Integer;
          const Col:TGridDataColumn);
begin
end;

procedure TGridStyler.StyleClientArea(const control:TGridRowContainer);
begin
end;

procedure TGridStyler.StyleNonClientArea(const control:TCustomGrid);
begin
end;

Procedure TGridStyler.RowSelected(const Index:Integer;
          const Row:TW3GridDataRow);
begin
end;

procedure TGridStyler.RowUnselected(const Row:TW3GridDataRow);
begin
end;

procedure TGridStyler.ColumnSelected(const index:Integer;
          const Column:TGridDataColumn);
begin
end;

procedure TGridStyler.ColumnUnSelected(Column:TGridDataColumn);
begin
end;
//############################################################################
// TW3GridDataRow
//############################################################################

procedure TGridDataColumn.InitializeObject;
begin
  inherited;
  self.Font.Size:=12;
  self.Font.Color:=clWhite;
end;

//############################################################################
// TW3GridDataRow
//############################################################################

procedure TW3GridDataRow.InitializeObject;
begin
  inherited;
  (Handle)['onmousedown'] := @CBMouseDown;
end;

procedure TW3GridDataRow.FinalizeObject;
begin
  if FEditCol<>NIL then
  FEditCol.free;
  inherited;
end;

procedure TW3GridDataRow.MouseDown(button:TMouseButton;
          shiftState:TShiftState;x,y:Integer);
begin
  inherited MouseDown(Button,ShiftState,x,y);

  if  assigned(parent)
  and assigned(parent.parent) then
  begin

    parent.parent.showTools;

  end;
  Selected:=not Selected;

end;

procedure TW3GridDataRow.Update;
begin
  Beginupdate;
  AddToComponentState([csSized]);
  EndUpdate;
end;

procedure TW3GridDataRow.UpdateIdentifier;
var
  x:  Integer;
begin
  Identifier:=0;
  for x:=0 to self.Count-1 do
  Identifier:=Identifier + ((Column[x].Width + Column[x].left)  shl x);
end;

function TW3GridDataRow.getGrid:TCustomGrid;
begin
  result:=NIL;
  if  (parent<>NIL)
  and (parent.parent<>NIL) then
  result:=TCustomGrid(parent.parent);
end;

procedure TW3GridDataRow.Resize;
var
  x:  integer;
begin
  inherited;
  if FEditCol<>NIL then
  Begin
    FEditCol.setBounds(0,0,Height,Height);
  end;

  for x:=0 to Count-1 do
  begin
    var mItem:=self.Column[x];
    if mItem.ColumnItem<>NIL then
    begin
      (* mItem.fxScaleTo
        (
        mItem.ColumnItem.Left,
        0,
        mItem.ColumnItem.Width,
        clientHeight,
        0.2
        ); *)

      mItem.SetBounds
        (
          mItem.ColumnItem.Left,
          0,
          mItem.ColumnItem.Width,
          clientHeight
        );
    end;
  end;
end;

Procedure TW3GridDataRow.Populate;
var
  x:  Integer;

  function  RandomColor:TColor;
  begin
    result:=RGBToColor
      (
        round( Random * 255 ),
        round( random * 255 ),
        round( random * 255 )
      );
  end;

begin
  if Parent<>NIL then
  begin
    var mGrid:=self.getGrid;
    if mGrid<>NIL then
    begin
      (* Create edit-cursor column? *)
      if mGrid.Options<>NIL then
      Begin
        if mGrid.Options.ShowEditCol then
        FEditCol:=TGridEditorColumn.Create(self);
      end;

      var rowColor := clNone;
      if index>=0 then
      begin
        if Index mod 2=1 then
        StyleClass:='RowOdd' else
        StyleClass:='RowEven';

        if index mod 2=1 then
        RowColor:=RGBToColor(33,33,33) else
        rowcolor:=RGBToColor(0,0,0);
      end;

      (* Now create columns based on header *)
      for x:=0 to mgrid.header.count-1 do
      Begin
        var mItem:=TGridDataColumn.Create(self);
        mItem.ColumnItem:=mGrid.Header.Columns[x];
        if x in [0,2] then
        mItem.Background.fromColor(RGBToColor(55,55,55));
      end;

      //handle.style['background-color']:=ColorToWebStr(rowColor);
      background.FromColor(rowColor);

      (* Update identifier, used by the grid to know
         if a row needs a resize or have a different layout
         from the main-form *)
      UpdateIdentifier;
    end;
  end;
end;

procedure TW3GridDataRow.setSelected(Const Value:Boolean);
begin
  if value<>FSelected then
  begin
    FSelected:=Value;
    case Value of
    True:   CSSClasses.Add("RowSelected");
    false:  CSSClasses.RemoveByName("RowSelected");
    end;
  end;
end;


//############################################################################
// TGridOptions
//############################################################################

procedure TGridOptions.setScrollDelay(Value:Integer);
begin
  value:=TInteger.EnsureRange(Value,0,100);
  if value<>FScrollDelay then
  begin
    FScrollDelay:=Value;
  end;
end;

//############################################################################
// TCustomGrid
//############################################################################

procedure TCustomGrid.InitializeObject;
begin
  inherited;

  FOptions:=TGridOptions.Create(self);

  FHeader:=TGridHeader.Create(self);

  FVScroll:=TGridVerticalScrollbar.Create(self);
  FVScroll.OnChanged:=HandleScroll;
  FVScroll.Enabled:=False;
  FVScroll.width:=24;
  FVScroll.Background.FromColor(clWhite);

  FContainer:=TGridRowContainer.Create(self);
  FContainer.Background.FromColor(clGreen);

  FHeader.OnColumnMoved:=HandleHeaderColumnMoved;
  FHeader.OnColumnSized:=HandleHeaderColumnSized;
end;

procedure TCustomGrid.FinalizeObject;
begin
  FContainer.free;
  FVScroll.free;
  FHeader.clear;
  FHeader.free;
  FOptions.free;
  inherited;
end;

procedure TCustomGrid.HandleHeaderColumnSized
              (Sender:TObject;Column:TGridHeaderColumn;OldSize:TPoint);
begin
  Header.UpdateIdentifier;
  Render;
end;

procedure TCustomGrid.HandleHeaderColumnMoved
          (Sender:TObject;Column:TGridHeaderColumn);
var
  x:  Integer;
begin
  var mIndex:=getTopItemIndex;
  var mPage:=self.getPageSize;

  Header.UpdateIdentifier;
  //Render;

  for x:=0 to mPage-1 do
  begin
    var mRow:=FRowInfo[mIndex + x].DOM;
    if (mRow<>NIL) then
    begin
      mRow.BeginUpdate;
      mRow.addToComponentState([csSized]);
      mRow.EndUpdate;
    end;
  end;
end;

procedure TCustomGrid.setGeneralRowHeight(const Value:Integer);
begin
  FRowSize:=TInteger.EnsureRange(Value,12,128);
end;

procedure TCustomGrid.Clear;
var
  x:  Integer;
begin
  try
    for x:=0 to self.FRowInfo.length-1 do
    begin
      if FRowInfo[x].DOM<>NIL then
      FRowInfo[x].DOM.free;
    end;
  finally
    FRowInfo.Clear;
  end;
end;

function TCustomGrid.getTopItemIndex:Integer;
begin
  result:=FVScroll.Position;
end;

function TCustomGrid.getOffsetForItem(Const RowIndex:Integer):Integer;
begin
  result:=RowIndex * FRowSize;
end;

function TCustomGrid.getPageSize:Integer;
Begin
  result:=FContainer.ClientHeight div FRowSize;
end;

function TCustomGrid.getContentHeight:Integer;
var
  x:  Integer;
begin
  result:=(FRowInfo.Length-FExInfo.length) * FRowSize;
  for x:=0 to FExInfo.length-1 do
  inc(result,FRowInfo[x].DOM.height);
end;

procedure TCustomGrid.ProcessStack;
var
  mItem:  TW3GridDataRow;
  mIndex: Integer;
Begin
  if FStack.Count>0 then
  begin
    (* We leave the number on the stack, that way we dont end
       up creating duplicates, which would drain memory line insane *)
    mIndex:=FStack.Peek;
    try
      if FRowInfo[mIndex].DOM=NIL then
      Begin
        mItem:=Add(mIndex);
        FRowInfo[mIndex].DOM:=mItem;

        mItem.Column[0].InnerHTML:=IntToStr(mIndex);
        mItem.SetBounds
        (
          0,
          getOffsetForItem(mIndex),
          clientwidth - self.FVScroll.width,
          FRowSize
        );
      end;
    finally
      FStack.Pop;
    end;

    if FStack.count>0 then
    ProcessStack;
  end;
end;

Procedure TCustomGrid.Render;
var
  x:  Integer;
  mTopIndex:  Integer;
  mPageItems: Integer;
  mObj:TW3GridDataRow;
begin

  mTopIndex:=getTopItemIndex;
  mPageItems:=FContainer.Height div FRowSize;

  for x:=0 to mPageItems-1 do
  begin
    var mIndex:= x + mTopIndex;

    (* Get allocated row object *)
    mObj:=FRowInfo[mIndex].DOM;

    (* No allocated row? Push to stack, late create *)
    if mObj=NIL then
    begin
      if FStack.IndexOf(mIndex)=-1 then
      FStack.Push(mIndex);
    end else
    begin
      (* Is the row identifier different from the header layout? *)
      if mObj.Identifier<>FHeader.Identifier then
      begin
        mObj.UpdateIdentifier;
        mObj.update;
      end;

    end;
  end;

  if FStack.Length>0 then
  ProcessStack;
end;

procedure TCustomGrid.Allocate(Rows:Integer);
begin
  if FRowInfo.length>0 then
  Clear;

  if Rows>0 then
  begin
    FRowInfo.Clear;
    FRowInfo.SetLength(Rows);
    writeln("Allocating " + rows.tostring + " rows");

    FVScroll.Enabled:=true;
    FVScroll.Total:=Rows;
    FVScroll.Position:=0;
    FVScroll.PageSize:=getPageSize;
    FVScroll.Visible:=true;

    w3_requestAnimationFrame(Render);
  end;
end;

function TCustomGrid.IndexOfRow(Const Row:TW3GridDataRow):Integer;
var
  x:  Integer;
begin
  result:=-1;
  for x:=0 to FRowInfo.Length do
  begin
    if FRowInfo[x].DOM = Row then
    Begin
      result:=x;
      break;
    end;
  end;
end;

procedure TCustomGrid.ShowTools;
var
  mHeight:  integer;
  mTargetPos: integer;
  mTestPos:   Integer;
begin
  if not (csDestroying in ComponentState) then
  begin
    if FRowInfo.Length>0 then
    begin
      mTargetPos:=(ClientHeight - FHeader.Height) div 2;
      mTestPos  :=FHeader.top + FHeader.height + 10;

      mHeight:=(ClientHeight-FHeader.height) div 2;

      if FContainer.top>=mTestPos then
      FContainer.fxScaleTo(0,FHeader.height,FContainer.Width,clientHeight-Fheader.Height,0.3,
        procedure ()
        begin
          FVScroll.PageSize:=getPageSize;
        end)
      else
      FContainer.fxScaleTo(0,mHeight,FContainer.width,FContainer.height ,0.4,
        procedure ()
        begin
          FContainer.height := (ClientHeight -mHeight) - 20;
          FVScroll.PageSize:=getPageSize;
        end);
    end;
  end;
end;


function TCustomGrid.Add(const Index:Integer):TW3GridDataRow;
Begin
  result:=TW3GridDataRow.Create(FContainer);
  result.setBounds(
    0,
    Header.BoundsRect.bottom + getContentHeight,
    FContainer.clientwidth,
    FRowSize);

    result.Index:=Index;

  result.BeginUpdate;
  try
    (result as IGridDataRow).populate;
  except
    on e: exception do
    begin
      result.free;
      result:=NIL;
      exit;
    end;
  end;
  result.AddToComponentState([csSized]);
  result.EndUpdate;
end;

procedure TCustomGrid.HandleScroll(Sender:TObject);
begin
  if (csReady in ComponentState) then
  Begin
    FContainer.ScrollInfo.ScrollTo(0,FVScroll.Position * FRowSize);
    if FOptions.ScrollDelay=0 then
    Render else
    w3_setTimeout(Render,FOptions.ScrollDelay);
  end;
end;

procedure TCustomGrid.Resize;
var
  mScaledHeight:  Integer;
begin
  inherited;
  If Handle.Valid
  and handle.ready then
  begin
    FHeader.SetBounds(0,0,clientwidth,32);

    FVScroll.setBounds(
      clientwidth-FVScroll.width,
      FHeader.height,
      FVScroll.width,
      clientheight - Fheader.height);
      //mScaledHeight:=mScaledHeight * FRowSize;
    //end else

    mScaledHeight:=clientHeight - (FHeader.Height);

    FContainer.setBounds(0,FHeader.height,
      clientWidth-FVScroll.width,
      mScaledHeight);
  end;
end;

//############################################################################
// TGridHeader
//############################################################################

procedure TGridHeader.FinalizeObject;
begin
  inherited;
end;

Procedure TGridHeader.styleTagObject;
Begin
  inherited;
end;

procedure TGridHeader.Resize;
var
  wd: Integer;
  x:  Integer;
  dx: Integer;
  cnt:  Integer;
begin
  cnt:=Count;
  if cnt>0 then
  begin
    if handle.valid
    and handle.ready then
    begin
      dx:=0;
      wd:=clientWidth div cnt;
      for x:=0 to cnt-1 do
      begin
        wd:=Columns[x].width;
        Columns[x].setBounds(dx,0,wd,clientHeight);
        inc(dx,wd);
      end;
    end;
  end;
end;

procedure TGridHeader.RegisterChild(aChild: TW3Component);
begin
  if (aChild<>NIL) then
  begin
    if (aChild is TGridHeaderColumn) then
    inherited RegisterChild(aChild) else
    Raise Exception.Create
    ('Only column controls can be added to a grid header');
  end;
end;

procedure TGridHeader.ChildAdded(aChild: TW3Component);
begin
  inherited ChildAdded(aChild);
  FItems.Add(TGridHeaderColumn(aChild));
  if not (csDestroying in ComponentState)
  and not (csLoading in ComponentState) then
  Resize;

end;

procedure TGridHeader.ChildRemoved(aChild: TW3Component);
var
  mIndex: Integer;
begin
  inherited ChildRemoved(aChild);
  mIndex:=FItems.IndexOf(TGridHeaderColumn(aChild));
  if mIndex>=0 then
  FItems.delete(mIndex,1);
  if not (csDestroying in ComponentState)
  and not (csLoading in ComponentState) then
  Resize;
end;

procedure TGridHeader.ColumnReSizeBegins(const column:TGridHeaderColumn);
begin
  FOldSize:=TPoint.Create(Column.Width,Column.Height);
  if assigned(FOnSizeBegins) then
  FOnSizeBegins(self,Column);
end;

procedure TGridHeader.ColumnReSizeEnds(const column:TGridHeaderColumn);
begin
  if assigned(FOnSized) then
  FOnSized(self,Column,
  FOldSize);
  if assigned(FOnSizeEnds) then
  FOnSizeEnds(self,Column);
end;

procedure TGridHeader.ColumnMoveBegins(Const column:TGridHeaderColumn);
begin
  if assigned(FOnMoveBegins) then
  FOnMoveBegins(self,Column);
end;

procedure TGridHeader.ColumnMoveEnds(const column:TGridHeaderColumn);
begin
  if assigned(FOnMoveEnds) then
  FOnMoveEnds(self,Column);
end;

Procedure TGridHeader.ColumnMoved(const Column:TGridHeaderColumn);

  function GetChildrenSortedByXPos: Array of TGridHeaderColumn;
  var
    mCount: Integer;
    x:  Integer;
    mAltered: Boolean;
    mObj: TGridHeaderColumn;
    mLast:  TGridHeaderColumn;
    mCurrent: TGridHeaderColumn;
  begin
    mCount := GetChildCount;

    if mCount>0 then
    begin
      (* populate list *)
      for x := 0 to mCount - 1 do
      begin
        mObj := Columns[x];
        if (mObj is TGridHeaderColumn) then
        Result.add(mObj);
      end;

      (* sort by X-pos *)
      if Result.Count>1 then
      begin
        repeat
          mAltered := False;
          for x := 1 to mCount - 1 do
          begin
            mLast := TGridHeaderColumn(Result[x - 1]);
            mCurrent := TGridHeaderColumn(Result[x]);
            if
              mCurrent.left + (mCurrent.width div 2)
              <
              mLast.left + (mLast.width div 2) then
            begin
              Result.Swap(x - 1,x);
              mAltered := True;
            end;
          end;
        until mAltered=False;
      end;
    end;
  end;


begin
  var mItems := GetChildrenSortedByXPos;

  var x:=0;
  var dx:=0;
  var mWaits:=mItems.count;

  for x:=0 to mItems.count-1 do
  begin
    mItems[x].fxMoveTo(dx,mItems[x].Top,0.3, procedure ()
      begin
        dec(mWaits);
        if mWaits=0 then
        begin
          if assigned(FOnMoved) then
          FOnMoved(self,Column);
        end;
      end);
    inc(dx,mItems[x].width);
  end;
  FItems:=mItems;
end;

procedure TGridHeader.ColumnSized(const column:TGridHeaderColumn);
begin
  w3_requestAnimationFrame(Resize);
end;

Procedure TGridHeader.Adjust;
begin
  Resize;
end;

procedure TGridHeader.Clear;

  procedure doClear;
  var
    x:  Integer;
    mItem:  TGridHeaderColumn;
  begin
    for x:=0 to getChildCount-1 do
    Begin
      if (getChildObject(x) is TGridHeaderColumn) then
      Begin
        mItem:=TGridHeaderColumn(getChildObject(x));
        mItem.free;
      end;
    end;
  end;

begin
  if not (csDestroying in ComponentState) then
  begin
    BeginUpdate;
    try
      doClear;
    finally
      addToComponentState([csSized]);
      endUpdate;
      UpdateIdentifier;
    end;
  end else
  doClear;
end;

procedure TGridHeader.UpdateIdentifier;
var
  x:  Integer;
begin
  (* Calculate new identifier *)
  Identifier:=0;
  for x:=0 to FItems.Length-1 do
  Identifier:=Identifier + ((Columns[x].Width + Columns[x].left)  shl x);
end;

function TGridHeader.Add:TGridHeaderColumn;
begin
  beginupdate;
  result:=TGridHeaderColumn.Create(self);
  result.width:=100;
  result.height:=clientHeight;
  addToComponentState([csSized]);
  endupdate;
  UpdateIdentifier;
  w3_setTimeOut( procedure ()
    begin
      if assigned(FOnAdded) then
      FOnAdded(self,result);
    end,
    10);
end;

function TGridHeader.Add(Caption:String):TGridHeaderColumn;
begin
  beginupdate;
  result:=TGridHeaderColumn.Create(self);
  result.width:=100;
  result.height:=clientHeight;
  result.caption:=Caption;
  addToComponentState([csSized]);
  endupdate;
  UpdateIdentifier;

  w3_setTimeOut( procedure ()
    begin
      if assigned(FOnAdded) then
      FOnAdded(self,result);
    end,
    10);
end;

//############################################################################
// TGridHeaderColumn
//############################################################################

procedure TGridHeaderColumn.InitializeObject;
begin
  inherited;
  (* Manually initialize event handlers *)
  (Handle)['onmousedown'] := @CBMouseDown;
  (Handle)['onmouseup'] := @CBMouseUp;

  setSenseEdges([scRight]);
  Caption:='Column';

  font.Name:="verdana";
  font.size:=12;
  font.color:=clWhite;

end;

procedure TGridHeaderColumn.MouseDown(button:TMouseButton;
          shiftState:TShiftState;x,y:Integer);
begin
  inherited MouseDown(button,shiftstate,x,y);
  if (ActiveEdge in [scLeft,scRight]) then
  begin
    DisableSense;
    setCapture;
    FSizing:=True;
    FStartX:=x;
    FBaseWidth:=Width;
    (Parent as IGridHeader).ColumnReSizeBegins(self);
  end else
  Begin
    if clientRect.ContainsPos(x,y) then
    Begin
      FMoving:=True;
      DisableSense;
      setCapture;
      FStartX:=x;
      FStartY:=y;
      w3_setStyle(Handle,'cursor','move');
    (Parent as IGridHeader).ColumnMoveBegins(self);
    end;
  end;
end;

procedure TGridHeaderColumn.MouseMove(shiftState:TShiftState;x,y:Integer);
var
  dx: Integer;
begin
  inherited MouseMove(ShiftState,x,y);
  if FSizing then
  begin
    FNowX:=x;
    dx:=FNowX - FStartX ;

    SetWidth(FBaseWidth + dx);
    (TGridHeader(parent) as IGridHeader).ColumnSized(self);
  end;

  if FMoving then
  begin
    left:=self.ClientToScreen( TPoint.Create(x - FStartX,top) ).x;
  end;
end;

function TGridHeaderColumn.getGrid:TCustomGrid;
begin
  result:=NIL;
  if Parent<>NIL then
  Begin
    if Parent.parent<>NIL then
    result:=TCustomGrid(parent.Parent);
  end;
end;

procedure TGridHeaderColumn.MouseUp(button:TMouseButton;
          shiftState:TShiftState;x,y:Integer);
begin
  inherited MouseUp(button,shiftstate,x,y);
  if FSizing then
  Begin
    FSizing:=False;
    ReleaseCapture;
    EnableSense;
    (Parent as IGridHeader).ColumnSized(self);
    (Parent as IGridHeader).ColumnReSizeEnds(self);
  end;

  if FMoving then
  begin
    FMoving:=false;
    ReleaseCapture;
    EnableSense;
    w3_setStyle(Handle,'cursor','default');
    (Parent as IGridHeader).ColumnMoved(self);
  end;
end;


//############################################################################
// TEdgeSenseControl
//############################################################################

Procedure TEdgeSenseControl.initializeObject;
Begin
  inherited;
  FEdges:=[scLeft,scTop,scRight,scBottom];

  (* Manually hook up events *)
  (Handle)['onmousemove'] := @CBMouseMove;
  (Handle)['onmouseover'] := @CBMouseEnter;
  (Handle)['onmouseout'] := @CBMouseExit;

  FSense:=True;

  AlignText:=TTextAlign.taCenter;
end;

Procedure TEdgeSenseControl.setSenseEdges(const Value:TEdgeSenseEdges);
begin
  if (scLeft in Value) then Include(FEdges,scLeft) else Exclude(FEdges,scLeft);
  if (scTop in Value) then include(FEdges,scTop) else Exclude(FEdges,scTop);
  if (scRight in Value) then Include(FEdges,scRight) else
  Exclude(FEdges,scRight);
  if (scBottom in Value) then include(FEdges,scBottom) else
  Exclude(FEdges,scBottom);
end;

procedure TEdgeSenseControl.Resize;
begin
  inherited;
  FRects[0]:=TRect.CreateSized(0,CNT_SIZE,CNT_SIZE,ClientHeight-CNT_SIZE);
  FRects[1]:=TRect.CreateSized(0,0,ClientWidth,CNT_SIZE);
  FRects[2]:=TRect.CreateSized(ClientWidth-CNT_SIZE,CNT_SIZE,Clientwidth,ClientHeight-CNT_SIZE);
  FRects[3]:=TRect.CreateSized(0,ClientHeight-CNT_SIZE,ClientWidth,CNT_SIZE);
end;

procedure TEdgeSenseControl.CheckCorners(const x,y:Integer);
var
  mItem:TRect;
  mIndex: Integer;
begin
  FEdgeId:=-1;
  for mItem in FRects do
  begin
    if mItem.ContainsPos(x,y) then
    begin
      FEdgeId:=mIndex;
      break;
    end;
    inc(mIndex);
  end;
end;

function TEdgeSenseControl.getActiveEdgeOffset(x,y:Integer):TPoint;
begin
  if FEdgeId>=0 then
  result:=TPoint.Create
    ( x - FRects[FEdgeId].Left,
      y - FRects[FEdgeId].Top
    );
end;

function TEdgeSenseControl.getActiveEdge:TEdgeRegions;
begin
  if (FEdgeId>=0) and (FEdgeId<=3) then
  result:=TEdgeRegions(FEdgeid) else
  result:=scNone;
end;

procedure TEdgeSenseControl.UpdateCursor;
const
  CN_LEFT   = 0;
  CN_TOP    = 1;
  CN_RIGHT  = 2;
  CN_BOTTOM = 3;
var
  mCursor:  string;

  procedure doDefault;
  begin
    if mCursor<>'default' then
    w3_setStyle(Handle,'cursor','default');
  end;

begin
  mCursor:=w3_getStyleAsStr(Handle,'cursor').LowerCase;

  case FEdgeId of
    CN_LEFT:
      Begin
        if (scLeft in FEdges) then
        begin
          if mCursor<>'col-resize' then
          w3_setStyle(Handle,'cursor','col-resize');
        end else
        doDefault;
      end;
    CN_RIGHT:
      Begin
        if (scRight in FEdges) then
        begin
          if mCursor<>'col-resize' then
          w3_setStyle(Handle,'cursor','col-resize');
        end else
        doDefault;
      end;
    CN_TOP:
      begin
        if (scTop in FEdges) then
        begin
          if mCursor<>'row-resize' then
          w3_setStyle(Handle,'cursor','row-resize');
        end else
        doDefault;
      end;
    CN_BOTTOM:
      begin
        if (scBottom in FEdges) then
        begin
          if mCursor<>'row-resize' then
          w3_setStyle(Handle,'cursor','row-resize');
        end else
        doDefault;
      end;
    else
    doDefault;
  end;
end;

procedure TEdgeSenseControl.DisableSense;
begin
  FSense:=False;
end;

procedure TEdgeSenseControl.EnableSense;
begin
  FSense:=True;
end;

procedure TEdgeSenseControl.MouseMove(shiftState:TShiftState;x,y:Integer);
begin
  if FSense then
  begin
    CheckCorners(x,y);
    UpdateCursor;
  end;
  inherited MouseMove(ShiftState,x,y);
end;

procedure TEdgeSenseControl.MouseEnter(shiftState:TShiftState;x,y:Integer);
begin
  if FSense then
  begin
    CheckCorners(x,y);
    UpdateCursor;
  end;
  inherited MouseEnter(ShiftState,x,y);
end;

procedure TEdgeSenseControl.MouseExit(shiftState:TShiftState;x,y:Integer);
begin
  if FSense then
  Begin
    CheckCorners(x,y);
    UpdateCursor;
  end;
  inherited MouseExit(ShiftState,x,y);
end;

end.

Notes on the grid

The reason the grid is able to deal with hundreds of rows quickly, is because i use a stack technique. A row is only allocated once it steps into view, or is assigned data.

You are more than welcome to play around with it. Just keep in mind that its experimental at this stage, and the final version will no doubt be more polished.

Well, hope you got inspired! Enjoy, and merry xmas!

Smart Mobile, we want your ideas!

Smart Mobile Studio has so much potential and can go so many ways, so much in fact, that we want to hear your ideas on some important subjects. As a company we want to deliver what our customers need, rather than what we feel is appropriate.

So I will be airing various topics in the weeks to come, hoping that as many of you take the time to think, ponder and give us some ideas. If you have your own framework and feel it would be perfect for global adoption, then send it to our main website (www.smartmobilestudio.com) and we will have a look at it.

Database

This has been a hot potato for a while now. It’s been a tough nut to crack because JavaScript really is utterly data-agnostic. There is no default framework to adhere to in the browser, and as such – no real object model to implement.

To make things even worse, browsers ship with 3 different DB engines (WebSQL was by far the best, but it’s now marked as obsolete), all of them so different that orchestrating one common framework to encapsulate them all has turned out futile.

But all is not lost, we still have the coolest OOP JS compiler on the market and with a solid Delphi background, we can easily create a DB framework which makes data a joy to work with. It may even be that writing our own engine from scratch is the best way to go, all things considered.

The criteria we should keep in mind is (on top of my head):

• Support for browser engines
• Support remote DB providers
• JSON intermediate format
• Easy to implement custom data providers
• Future proof and adaptable

Browser based engines

The first point on this list, support for browser engines, is questionable. Smart Mobile Studio ships with support for WebSQL and IndexDB, and while these are supported natively by most browsers – they serve little or no purpose beyond storing name/value pairs. And they are both crippled by a ridicules 5-10 megabyte limitation.

This really is the sad truth, that browser environments at this point in time is pretty much useless when it comes to data storage. The reality is that native engines provided by the browser, gives you absolutely no benefit over a hand-sculpted, structured, indexed array. You just dont gain anything useful by using these DB engines.

SQLite

Smart Mobile Studio ships with a third engine, one which IMHO is a much better alternative than any of the native, browser based options. We took the time to compile the now industry standard SQLite from it’s orginal C source code, into JavaScript. Yes you read right, we have a pure JavaScript version of SQlite  which does everything it’s native counterpart is capable of, including creating binary compatible DB files.

But before you say “Great! Let’s use that”, keep in mind the other points on our list, namely “future proof” and “support remote DB providers”. If we marry SQLite by tooth and claw, we may end up with serious problems in the future. The database capabilities of the browser will change, just like object pascal did years ago. Remember when Paradox was the default database? Remember how hard it was to get rid of the BDE only 10 years ago? Well, if we can avoid that kindof scenario we should. By any means.

In my view SQLite should be an engine, one you can chose to use for local data storage if you need to work with complex data structures (read: data that needs SQL to work properly). It should just be one solution in a series of options, ranging from TClientDataset to TRemoteDataset (or something in that ballpark).

So already we begin to sense that our framework must abstract away any notion of where data comes from. Also, since JavaScript is purely ASYNC (including network capabilities), the link between provider and consumer must have a signaling mechanism. Requesting data and consuming data does not occur in sequence, like we have under Delphi. So we can write that down and keep it in mind as we dig deeper.

Some benefits

The benefit of picking just one engine, like SQLite, is that you can write code that pretty much knows what is going to happen. If the only engine you will ever support is SQLite then naturally your code will reflect that and you dont have to take height for scenarios which SQLite doesnt cause. So there are benefits to sticking to a simple, ad-hoc architecture. The downside is that – once data binding get’s into the codebase, throwing it out again or altering it in the future is going to be a nitemare. It may even break the codebase completely, especially for our customers.

Complete abstraction

In a perfect world data-consumers and data-providers doesnt know “how” things are done, or even what format data comes in. They only know about the access interface between them and that’s it.

From what we have covered so far, it becomes clear that in order to deal with multiple sources of data (local database, remote access) that at least on this level, abstraction is a must.

In my mind, at least 3 source types should be supported out of the box:

• Remote DB
• Local DB (WebSQL, SQLite drivers, TClientDataset)
• UDD (User defined data)

What we end up with is an architcture very much like the .net framework. A framework which involves logical, linear naming as such:

• DataEngine (*1)
  • DataConnection (*1)
• Dataprovider
• Dataset
• Datasource
• Databinding
  • DataEmitter (*2)
  • DataConsumer (*2)

*1) A data connection object contains properties and methods for executing and maintaining a connection to a remote host. Typically this object is exposed as a property of a DataProvider, which in turn represents a particular engine.

*2) Internal mechanisms used by visual components as couplings to a data-binding. The binding itself does little but describe source and target, while emitter and consumer objects are created on each side of the binding when the binding is activated

Data provider

What is a data provider? It is an object which provides access to structured data. It can be a table, the result of a query, a fixed user defined list of values or anything that can be represented as a linear, structured set of data.

Dataset

Like the name implies this is a set of data, a collection of items or rows -where each row has a series of columns, and each column can contain data of a particular type.

Datasets are exposed by dataproviders, they can be bound or unbound. Bound datasets are live and any update/write operation is performed on the database itself (with corresponding update to any DB aware components). Unbound datasets have no such contract and must be manually updated.

Data source

This is the bridge between the non-visual and visual components. A data-source keeps track of a collection of data-bindings and replicates update signals to attached components.

Databinding

A databinding is an object which describes a connection between a visual control (textbox, boolean switch etc.) and a dataset field. Whenever the visual control alter the value, the change also occurs in the datasource. And whenever the value is altered in the datasource, the databinding makes sure the value is also updated in any bound visual controls.

When a databinding is activated (for instance when a dataset is populated by data, like a table being opened), it creates two auxillary objects: A data emitter and a data consumer object. The emitter and consumer is created as child objects for the binding itself, but the visual control is given an interface to the consumer so it can read and write data through that.

Visual programming, extending the IDE

All of the above is great and it will no doubt give us the same benefits as .net developers currently enjoy. But in order for databases to become a living part of the Smart Mobile Studio cycle, we need to extend the IDE.

The first option is to do like Delphi does it, and allow non-visual objects to be dropped onto a form. But this is truly a complete waste of CPU power and to be honest. It can be done (actually quite easy), but I have nothing positive to say about it. It opens up for a world of pain. People are lazy and will copy stuff between forms rather than isolate data access in one, central place. Trust me on this, it would be to take a step backwards.

A much better idea is to create a new entity. A visual component, but one that can only be dropped onto a special area of the form designer. This gives us plenty of benefits:

• We avoid the overhead of TComponent
• All objects can be created by the automatically generated code
• Lightweight and fast, avoid code bloat
• Easier for us to implement in the IDE
• Easier to add to the existing package format

Here is a picture (example only, ignore colors) of what I have in mind. As you can see we have a bottom horizontal region where non-visual components can be dropped. When you select them you get to edit their properties in the property-inspector, just like under Visual Studio.

Globals and locals

In the above idea we find an interesting concept. First is the obvious, namely that the generated startup-code for a form creates the non-visual components when the form is created. But we can also introduce a global scope drag & drop placeholder (!)

A non visual drag & drop area like Visual Studio has would be nice

The global placeholder, which becomes available when you select the application unit, would be automatically created when the application starts. This is actually very powerful. It means that we can isolate our central DB components here, and they are compiled into TApplication. They would be globally available to the entire application.

The benefit is that on form level, all we have to drop is a datasource and then X number of bindings linking to visual components. See?

And it doesnt stop there, once we have stuff like image-lists implemented, they too can be make globally available by keeping them in “globals”. I know it’s not the same as a TDatamodule, but when it comes to DB programming it’s actually a restriction that helps us write cleaner code. You wont believe some of the horrible DB code i have seen over the years. People copying queries into every form, bloating the application and abusing the database, rather than isolating all data access in a single datamodule.

Your ideas matter

I would very much like to hear your ideas around this. And please, spend a few minutes reflecting on the model. And if you have a model presently in use that you feel SMS would benefit from – then dont hessitate to present it. The goal here is to create a solution which is future proof, easy to work with and adaptable. Not “who is the coolest programmer”.

I also think it’s important to have a closely knit, open and friendly community — hence i share and write as much as I do. I’ve never been a fan of closed doors or companies that keep their friends at arms-length.

Well, have a happy XMas and let’s make 2016 a kick ass Smart Mobile Studio year!

 

Merry Christmas, Smart Mobile Studio

This has been a fantastic and very exciting year, especially for Smart Mobile Studio. I dont think our product has seen so many improvements and new features being added since the 1.2 release way back in 2012.

The Smart Company

One of the reasons we have held a lower profile than usual this year, is because we have focused on the infrastructure of our product. Smart Mobile Studio has been from the very start a second job. Everyone involved work full time on other products, and we then allocate time to work on Smart Mobile Studio.

To solve this and to be able to deliver better service and product features we decided it was time to separate Smart Mobile Studio from Optimale Systemer AS. So you will be pleased to hear that Smart Mobile Studio now stands on it’s own legs, it has it’s own economy and is represented by a newly registered, fully tradable stock based company: The Smart Company AS.

Investors

With the realization and establishment of a proper IT company around our product, we can now accept and work with investors.

In order to really push our technology into a new level of quality, one where our customers can produce applications which targets, lives and exist in the cloud; we naturally need time. And time is money. So over the next months we will actively be looking for investors, distribution channels and any means of obtaining the required capital.

Our biggest strength is that we have a living product. Investors are not meet with an idea or paperwork outlining a possible future; They are greeted with an already existing product, in sale, being used by 1500+ customers around the world. A programming environment and system which is responsible for many successful mobile applications on both Apple Store and Google Play.

Investors will also find technology that works with and easily integrates with existing IT infrastructures. Smart Mobile Studio is presently the bridge between native back-end solutions and JavaScript based mobile applications or HTML5 sites.

The upcoming changes to the RTL consolidates the API and makes the run-time library capable of targeting even more platforms, including low-level systems like Windows command-line and the Linux shell. This opens up for a rich and completely object pascal based server and client-side infrastructure, equal and surpassing in features to native JavaScript, Ruby, Perl or Lua. In many respects it exposed features previously only available in native languages, with execution speed even surpassing natively compiled solutions.

The future of Smart Mobile Studio

We still have meetings before we can publish the roadmap for the next couple of years, but the general future of the product is bright. In fact, our product will be the only Rapid Application Development studio for cloud computing on the market. This is a monumental game-changer because it allows our customers to produce portable, independent NodeJS based services that can be hosted anywhere.

This new project type which targets cloud brings in so much power to the end-users. Being able to connect and talk directly with native DB services, being able to subscribe and make use of SOAP and JSON services (unbound by CORS limitations). Plenty of IDE editors and Wizards to make creating advanced JSON services even easier than Delphi and C# presently offers.

But the really fantastic news is that your end product, your compiled JSON services, are 100% completely platform independent. They can be hosted on Amazon or Azure; if you already have a dedicated Linux or Windows server, hosting the solutions there is likewise a snap.

So what is the future of Smart Mobile Studio? In short: The first Rapid Application Development studio that targets the cloud completely. No more expensive renting of VPS accounts, no more being bound to Windows exclusively. JSON Services can be hosted anywhere NodeJS is available.

More components

During the next year we will see more and more component packages arrive for Smart Mobile Studio. Many of the original, lightweight implementations that ship with Smart have been re-written from scratch. And there will be tremendous focus on porting Delphi components over.

This was not possible previously since JavaScript does not support pointers or low-level memory allocation. But with the introduction of marshaled pointers, raw memory access and streams in our RTL earlier this year, we are now able to port almost any Delphi component.

More platforms

Smart presently targets mobile devices, desktop browsers and NodeJS. As we begin to implement cloud API’s our NodeJS run-time units will be wastly improved. NodeJS can also execute your programs from the command-line, or directly from the desktop if you assign an Icon to it.

What we want to do is to expand our codebase to cover IOT frameworks, allowing you to create applications for Raspberry PI, Banana PI and many other embedded boards with support for JavaScript.

IOT is not going away, in fact it’s only just begun. Giving our customers the power to write applications for IOT devices is something we really want to deliver. There are so many cool new platforms out there, and it’s going to exponentially grow over the next 4-8 years.

We believe that our platform gives you the upper hand. When working with IOT devices supporting JavaScript directly, Smart Mobile Studio gives you a tremendous advantage over plain JavaScript. In most cases it also gives you bonuses over natively compiled solutions, because JavaScript is so much easier to maintain.

NodeJS executes your code in near native speeds so that is no longer a factor to consider either.

More layout and UI tools

Yes, we realize that Smart Mobile Studio has had a less than attractive layout designer. This is unfortunate, we agree, but Smart was initially designed from a Mono/CLR point of view. In other words, visually designing UI interfaces was the exception rather than the rule. But this is really going to change in 2016.

I have personally spent quite some time investigating various widgets-toolkits and how we can integrate these into Smart Mobile Studio. In most cases it’s as easy as writing a simple unit file which exposed the underlying JS code, and then linking to that code so it’s compiled into your project. Isolating this in packages and writing register code for it is also a very simple task.

So yes, we are looking to support alternative UI’s like JQuery UI, Sencha ExtJS and Facebook React UI. We also have our TypeScript importer which opens up for a whole world of TypeScript packages.

Happy holidays

Well, i hope you enjoyed reading about the plans for Smart Mobile Studio in the future. I for one cant wait to get cracking on the cloud infrastructure and get single-click deployment to Amazon implemented in the IDE.  That is going to be a game changer, no doubt about it.

So I wish you a merry xmas and a happy new year!

Enjoy the holidays!