［小ネタ］クラスヘルパーでタブコントロールのアニメーションを早める

はじめに

FiremonkeyのTTabControl はスマートフォンアプリ作成においてページの切り替えに使用したりと応用範囲が広いのですが、如何せん切り替え速度が0.3秒固定は使いづらいっ・・と誰もが感じていると思います。
なんとかしたい！
　下が改良版（0.2秒）

やること

TTabControl.SetActiveTabWithTransitionAsyncメソッドにて、遷移アニメーション時間に固定値が指定されていることが問題なので、このメソッドをまるっとコピーし、当該の固定値をメソッドの引数に置き換えます。

TTabControl のPrivateフィールド・メソッドを呼ぶ箇所が多いので、with文で回避します。
（参考：【Delphi】クラスヘルパによる private メンバアクセスの件を with 文で回避できると聞いて ）

途中、TTabItem.ContentのスコープがProtectedの為、こちらもクラスヘルパーで読めるようにします。

//宣言部
type
  TTabItemHelper = class helper for TTabItem
    function ReadContent:TContent;
  end;

  TTabTransitionEx = (None, Slide, Overlap);

  TTabControlHelper = class helper for TTabControl
    procedure DoTransition(
      const ATab: TTabItem;
      const ATransition: TTabTransitionEx;
      const ADirection: TTabTransitionDirection;
      const ADuration:Single;
      const AOnFinish: TProc);
  end;

//実装部
{ TTabItemHelper }
function TTabItemHelper.ReadContent: TContent;
begin
  result := Self.Content;
end;

{ TTabControlHelper }
procedure TTabControlHelper.DoTransition(
  const ATab: TTabItem; const ATransition: TTabTransitionEx;
  const ADirection: TTabTransitionDirection; const ADuration: Single;
  const AOnFinish: TProc);

  procedure AnimateControlPositionX(AParent: TFmxObject; 
    const NewValue: Integer; const AProgressHandler: TNotifyEvent;
    const AFinishHandler: TNotifyEvent);
  var
    A: TIntAnimation;
  begin
    TAnimator.StopPropertyAnimation(AParent, 'Position.X');

    A := TIntAnimation.Create(AParent);
    A.Parent := AParent;
    A.AnimationType := TAnimationType.In;
    A.Interpolation := TInterpolationType.Linear;
    A.OnFinish := AFinishHandler;
    A.OnProcess := AProgressHandler;
    A.Duration := ADuration; //変更箇所
    A.PropertyName := 'Position.X';
    A.StartFromCurrent := True;
    A.StopValue := NewValue;
    A.Start;
  end;

var
  PreviousTab, NewTab: TTabItem;
  PreviousTabContent, NewTabContent: TControl;
  LayoutRect: TRectF;
  P, LayoutPos: TPointF;
begin
  if ATab = ActiveTab then
    Exit;

  FinishCurrentTabTransition;

  if ATransition = TTabTransitionEx.None then
  begin
    ActiveTab := ATab;
    Exit;
  end;

  with Self do
  begin
    FTransitionRunning := True;
    ClipChildren := True;
    FTransitionFinishedCallback := AOnFinish;

    LayoutPos := ActiveTab.ReadContent.LocalToAbsolute(TPointF.Zero);
    LayoutRect := ActiveTab.ReadContent.BoundsRect;

    PreviousTab := ActiveTab;
    PreviousTabContent := ActiveTab.ReadContent;
    ActiveTab := ATab;
    NewTab := ATab;
    NewTabContent := ActiveTab.ReadContent;
    FTransitionTabs := [PreviousTab, NewTab];

    DisableDisappear(PreviousTab);

    PreviousTabContent.Visible := True;
    NewTabContent.Visible := True;
    if not NewTab.DisableDisappear then
    begin
      DisableDisappear(NewTab);
      PreloadContent(NewTabContent);
    end;

    P := PreviousTab.AbsoluteToLocal(LayoutPos);
    PreviousTabContent.SetBounds(P.X, P.Y, LayoutRect.Width, LayoutRect.Height);

    if ADirection = TTabTransitionDirection.Normal then
    begin
      if ATransition = TTabTransitionEx.Slide then
        AnimateControlPositionX(PreviousTabContent, Round(P.X - LayoutRect.Width), nil, nil);

      P := NewTab.AbsoluteToLocal(LayoutPos);
      NewTabContent.SetBounds(P.X + LayoutRect.Width, P.Y, LayoutRect.Width, LayoutRect.Height);
      AnimateControlPositionX(NewTabContent, Round(P.X), WebBrowserRealign, AnimationFinished);
    end
    else
    begin
      if ATransition = TTabTransitionEx.Slide then
        AnimateControlPositionX(PreviousTabContent, Round(P.X + LayoutRect.Width), nil, nil);

      P := NewTab.AbsoluteToLocal(LayoutPos);
      NewTabContent.SetBounds(P.X - LayoutRect.Width, P.Y, LayoutRect.Width, LayoutRect.Height);
      AnimateControlPositionX(NewTabContent, Round(P.X), WebBrowserRealign, AnimationFinished);
    end;
  end;
end;

　
TTabTransitionExについては遊び心というか・・Overlapを指定すると、ページが被さる様なアニメーションにできます。

工夫すれば色々な切り替えアニメーションが作れそうですが、FinishCurrentTabTransitionの中で停止させているアニメーションがPosition.Xのみなので、あまり無茶はできないかもしれません（未検証）。

おわりに

クラスヘルパーのwith文によるPriveteメンバアクセスが今後も可能かわからないので、そういったリスクを抱えることになることはご留意ください。
個人的にはTTabControlが改良されてアニメーション時間だけでも設定できるようになると良いなあ、と思っています。

また、TGridLayout等を使ってタブコントロールを自作する、という手もあるそうですので、そういった沼も面白いと思います！