{*********************************************}
{  TeeChart Charting Library for FireMonkey   }
{  Copyright (c) 2012-2020 by Steema Software }
{  All Rights Reserved                        }
{*********************************************}
unit FMXTee.Animations;
{$I TeeDefs.inc}

interface

{$WARN IMPLICIT_STRING_CAST OFF}

uses
  System.Classes, FMX.Types, FMX.Ani,
  {$IFDEF D22}
  FMX.Utils,
  {$ENDIF}
  FMX.Types3D;

type
  { TBaseAnimation }

  TBaseAnimation = class(TAnimation)
  private
    FStartFromCurrent: Boolean;
    FPath, FPropertyName: {$IFDEF D17}String{$ELSE}AnsiString{$ENDIF};
    FInstance: TObject;
  protected
    procedure CheckPath;
  public
    property Instance:TObject read FInstance write FInstance;
    property Path:{$IFDEF D17}String{$ELSE}AnsiString{$ENDIF} read FPath write FPath;
  published
    property StartFromCurrent: Boolean read FStartFromCurrent write FStartFromCurrent default False;
    property PropertyName: {$IFDEF D17}String{$ELSE}AnsiString{$ENDIF} read FPropertyName write FPropertyName;
  end;

  { TIntegerAnimation }

  {$IFDEF D16}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 {$IFDEF D26}or pidOSX64{$ENDIF})]
  {$ENDIF}
  TIntegerAnimation = class(TBaseAnimation)
  private
    FStartInt: Integer;
    FStopInt: Integer;
  protected
    procedure ProcessAnimation; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Start; override;
    procedure Stop; override;
  published
    property StartValue: Integer read FStartInt write FStartInt stored True;
    property StopValue: Integer read FStopInt write FStopInt stored True;
  end;

  {$IFDEF D16}
  [ComponentPlatformsAttribute(pidWin32 or pidWin64 or pidOSX32 {$IFDEF D26}or pidOSX64{$ENDIF})]
  {$ENDIF}
  TChildrenAnimation=class(TFloatAnimation)
  private
    FOverlap: Single;

    procedure CreateAnimations;
    function ParentChildrenCount:Integer;
  public
    procedure Start; override;
  published
    property Overlap: Single read FOverlap write FOverlap;
  end;

  TSequenceAnimation=class(TAnimation)
  {$IFDEF D17}
  protected
    procedure ProcessAnimation; override;
  {$ENDIF}
  public
    procedure Start; override;
  end;

  TPosition3DAnimation = class(TBaseAnimation)
  private
    FStart: TPosition3D;
    FCurrent: TPosition3D;
    FStop: TPosition3D;
  protected
    procedure ProcessAnimation; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Start; override;
  published
    property StartValue: TPosition3D read FStart write FStart;
    property StopValue: TPosition3D read FStop write FStop;
  end;

implementation

uses
  System.TypInfo, System.SysUtils;

{ TBaseAnimation }

procedure TBaseAnimation.CheckPath;
var
  Persistent: string;
  I: Integer;
  Comp: TFmxObject;
begin
  if (Parent <> nil) and (FPropertyName <> '') then
  begin
    if FInstance = nil then
    begin
      FInstance := Parent;
      FPath := FPropertyName;
      while Pos('.', FPath) > 0 do
      begin
        Persistent := GetToken(FPath, '.');
        if GetPropInfo(FInstance.ClassInfo, Persistent, [tkClass]) <> nil then
          FInstance := GetObjectProp(FInstance, Persistent)
        else
        if Parent <> nil then
        begin
          for I := 0 to Parent.ChildrenCount - 1 do
            if CompareText(Parent.Children[I].Name, Persistent) = 0 then
            begin
              Comp := Parent.Children[I];
              if GetPropInfo(Comp.ClassInfo, FPath) <> nil then
              begin
                FInstance := Comp;
                Break;
              end;
            end;
        end;
      end;
    end;
  end;
end;

{ TIntegerAnimation }

constructor TIntegerAnimation.Create(AOwner: TComponent);
begin
  inherited;
  Duration := 0.2;
  FStartInt := 0;
  FStopInt := 0;
end;

destructor TIntegerAnimation.Destroy;
begin
  inherited;
end;

procedure TIntegerAnimation.Start;
begin
  CheckPath;

  if (FInstance <> nil) and StartFromCurrent then
    { is integer prop }
     if GetPropInfo(FInstance.ClassInfo, FPath, [tkInteger]) <> nil then
        StartValue := GetOrdProp(FInstance, FPath);

  inherited;
end;

procedure TIntegerAnimation.Stop;
begin
  inherited;
  FInstance := nil;
end;

procedure TIntegerAnimation.ProcessAnimation;
var Value : Integer;
begin
  if FInstance <> nil then
  begin
    { is integer prop }
    if GetPropInfo(FInstance.ClassInfo, FPath, [tkInteger]) <> nil then
    begin
      Value:=Round(InterpolateSingle(FStartInt, FStopInt,NormalizedTime));
      SetOrdProp(FInstance, FPath, Value);
    end;
  end;
end;

{ TChildrenAnimation }

function TChildrenAnimation.ParentChildrenCount:Integer;
var t : Integer;
begin
  result:=0;

  for t := 0 to Parent.ChildrenCount-1 do
  if Parent.Children[t]<>Self then
     Inc(result);
end;

procedure TChildrenAnimation.CreateAnimations;
var t : Integer;
    f : TFloatAnimation;
    tmp,tmpCount : Integer;
begin
  // Remove our animations
  t:=0;
  while t<ChildrenCount do
  if Children[t].Owner=Self then
     {$IFDEF D18}
     Children[t].DisposeOf
     {$ELSE}
     Children[t].Free
     {$ENDIF}
  else
     Inc(t);

  tmpCount:=ParentChildrenCount;

  tmp:=0;

  for t := 0 to Parent.ChildrenCount-1 do
  if Parent.Children[t]<>Self then
  begin
    Inc(tmp);

    f:=TFloatAnimation.Create(Self);
    f.StartValue:=StartValue;
    f.StopValue:=StopValue;
    f.Loop:=Loop;
    f.StartFromCurrent:=StartFromCurrent;
    f.PropertyName:=PropertyName;
    f.Inverse:=Inverse;
    f.AutoReverse:=AutoReverse;
    f.AnimationType:=AnimationType;
    f.Interpolation:=Interpolation;
    f.Duration:=Duration;
    f.Trigger:=Trigger;
    f.TriggerInverse:=TriggerInverse;

    if Overlap=0 then
       f.Delay:=Delay
    else
       f.Delay:=Duration*Overlap*((tmpCount-tmp)/tmpCount);

    f.Parent:=Parent.Children[t];
    f.Start;
  end;
end;

procedure TChildrenAnimation.Start;
begin
  if Assigned(Parent) and
     ((ChildrenCount=0) or (ChildrenCount<>ParentChildrenCount)) then
     CreateAnimations;
end;

{ TSequenceAnimation }

{$IFDEF D17}
procedure TSequenceAnimation.ProcessAnimation;
begin
  // ?
end;
{$ENDIF}

procedure TSequenceAnimation.Start;
var
  tmp : Single;

  procedure Check(AObject:TFmxObject);
  var t : Integer;
  begin
    for t := 0 to AObject.ChildrenCount-1 do
      if AObject.Children[t] is TAnimation then
      begin
        TAnimation(AObject.Children[t]).Delay:=tmp;
        tmp:=tmp+TAnimation(AObject.Children[t]).Duration;
        TAnimation(AObject.Children[t]).Start;
      end;
  end;

var t : Integer;
begin
  tmp:=Delay;

  if Assigned(Parent) then
     for t := 0 to Parent.ChildrenCount-1 do
         Check(Parent.Children[t])
  else
     for t := 0 to ChildrenCount-1 do
         Check(Children[t])
end;

{ TPosition3DAnimation }

constructor TPosition3DAnimation.Create(AOwner: TComponent);
begin
  inherited;
  Duration := 0.2;
  FStart := TPosition3D.Create(NullPoint3D);
  FStop := TPosition3D.Create(NullPoint3D);
  FCurrent := TPosition3D.Create(NullPoint3D);
end;

destructor TPosition3DAnimation.Destroy;
begin
  FCurrent.Free;
  FStart.Free;
  FStop.Free;
  inherited;
end;

procedure TPosition3DAnimation.ProcessAnimation;
var
  Value: TObject;
  tmp : Single;
begin
  if FInstance <> nil then
  begin
    { calc value }
    tmp:=NormalizedTime;

    FCurrent.X := InterpolateSingle(FStart.X, FStop.X, tmp);
    FCurrent.Y := InterpolateSingle(FStart.Y, FStop.Y, tmp);
    FCurrent.Z := InterpolateSingle(FStart.Z, FStop.Z, tmp);

    { is Position3D prop }
    if GetPropInfo(FInstance.ClassInfo, FPath, [tkClass]) <> nil then
    begin
      Value := GetObjectProp(FInstance, FPath);
      if (Value <> nil) and (Value is TPersistent) then
        TPersistent(Value).Assign(FCurrent);
    end;
  end;
end;

procedure TPosition3DAnimation.Start;
var
  Value: TObject;
begin
  CheckPath;

  if (FInstance <> nil) and StartFromCurrent then
  begin
    { is Rect prop }
    if GetPropInfo(FInstance.ClassInfo, FPropertyName, [tkClass]) <> nil then
    begin
      Value := GetObjectProp(FInstance, FPropertyName);
      if (Value <> nil) and (Value is TPersistent) then
        FStart.Assign(TPersistent(Value));
    end;
  end;

  inherited;
end;

initialization
  RegisterFmxClasses([TIntegerAnimation,TChildrenAnimation,TSequenceAnimation,
                      TPosition3DAnimation]);
end.
