SProgressIndicator.pas

unit SProgressIndicator;

interface

uses
  Windows, Messages, SysUtils, Types, UITypes, Classes, Graphics, Controls,
  Direct2D, D2D1, ExtCtrls, Forms;

type
  TGetBoolFloatFcn = function(Sender: TObject; out AOpacity: Double): Boolean of object;
  TSProgressIndicator = class(TCustomControl)
  strict private
  type
    TPartData = record
      Position: Double;
      Angle: Double;
      Speed: Double;
      Scale: Double;
      Opacity: Double;
    end;
    TState = (sStopped, sRunning, sPausing, sPaused, sStopping, sFailureStopped);
  const
    Complexity = 5;
    ZAnimDuration = 500;
    SpeedAnimDuration = 500;
    OpacityAnimDuration = 500;
  var
    FCanvas: TDirect2DCanvas;
    FPartDataArr: array[0..5] of array[0..Complexity - 1] of TPartData;
    FPart,
    FLargeSecond,
    FSecond,
    FMinute,
    FHour: ID2D1PathGeometry;
    FAnimator: TTimer;
    FStartTime: TDateTime;
    FSavedSeconds: Int64;
    FLastDurationSeconds: Double;
    FState: TState;
    FZ, FOldZ, FTargetZ: Double;
    FZAnimBegin, FZAnimEnd: TDateTime;
    FSpeed, FOldSpeed, FTargetSpeed: Double;
    FSpeedAnimBegin, FSpeedAnimEnd: TDateTime;
    FOpacity, FOldOpacity, FTargetOpacity: Double;
    FOpacityAnimBegin, FOpacityAnimEnd: TDateTime;
    FFilled: Boolean;
    FAccentColor: TColor;
    FOnGetFilled: TGetBoolFloatFcn;
    procedure AnimatorTimer(Sender: TObject);
    function Fraction(const A, B: TDateTime): Double;
    function Combine(const A, B: TDateTime; const First, Second: Double): Double;
    procedure SetTargetZ(const ATargetZ: Double);
    procedure SetTargetSpeed(const ATargetSpeed: Double);
    procedure SetTargetOpacity(const ATargetOpacity: Double);
    procedure CreateDeviceIndependentResources;
    procedure SetFilled(const Value: Boolean);
    procedure SetState(const Value: TState);
    procedure SetAccentColor(const Value: TColor);
    procedure SetSavedSeconds(const Value: Int64);
    function DynGetFilled(out AOpacity: Double): Boolean;
  protected
    procedure CreateWnd; override;
    procedure WMPaint(var Message: TWMPaint); message WM_PAINT;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure WMEraseBkgnd(var Message: TWMEraseBkgnd); message WM_ERASEBKGND;
    procedure Paint; override;
    procedure Click; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    property Canvas: TDirect2DCanvas read FCanvas;
    property StartTime: TDateTime read FStartTime write FStartTime;
    procedure Start;
    procedure Pausing;
    procedure Pause;
    procedure Resume;
    procedure Stopping;
    procedure Stop;
    procedure FailureStop;
    procedure Restart;
  published
    property AccentColor: TColor read FAccentColor write SetAccentColor default clNavy;
    property Align;
    property AlignWithMargins;
    property Anchors;
    property Cursor;
    property Filled: Boolean read FFilled write SetFilled;
    property Font;
    property Hint;
    property Margins;
    property PopupMenu;
    property ShowHint;
    property SavedSeconds: Int64 read FSavedSeconds write SetSavedSeconds;
    property State: TState read FState write SetState default sStopped;
    property TabOrder;
    property TabStop;
    property OnClick;
    property OnDblClick;
    property OnDynGetFilled: TGetBoolFloatFcn read FOnGetFilled write FOnGetFilled;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseActivate;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
  end;

procedure Register;

implementation

uses
  Math, DateUtils, Timespan;

procedure Register;
begin
  RegisterComponents('Rejbrand 2020', [TSProgressIndicator]);
end;

function ColorIsDark(AColor: TColor): Boolean;
begin
  AColor := ColorToRGB(AColor);
  Result := 0.299 * GetRValue(AColor) + 0.587 * GetGValue(AColor) + 0.114 * GetBValue(AColor) < 149;
end;

function DurationToString(const ASeconds: Double): string;

  procedure Add(AValue: Int64; const AUnit: string);
  var
    Sep: string;
  begin
    if AValue = 0 then
      Exit;
    Sep := StringOfChar(#32, Ord(not Result.IsEmpty));
    Result := Result + Sep + AValue.ToString + #32 + AUnit;
  end;

var
  LMilliseconds, LSeconds, LMinutes, LHours, LDays: Int64;
begin
  LMilliseconds := Round(1000*Frac(ASeconds));
  LSeconds := Trunc(ASeconds);
  LDays := LSeconds div SecsPerDay;
  Dec(LSeconds, LDays * SecsPerDay);
  LHours := LSeconds div SecsPerHour;
  Dec(LSeconds, LHours * SecsPerHour);
  LMinutes := LSeconds div SecsPerMin;
  Dec(LSeconds, LMinutes * SecsPerMin);
  Result := '';
  Add(LDays, 'd');
  Add(LHours, 'h');
  Add(LMinutes, 'm');
  Add(LSeconds, 's');
  if (LDays = 0) and (LHours = 0) then
    Add(LMilliseconds, 'ms');
end;

{ TSProgressIndicator }

procedure TSProgressIndicator.AnimatorTimer(Sender: TObject);
begin
  if FZ <> FTargetZ then
    FZ := Combine(FZAnimBegin, FZAnimEnd, FOldZ, FTargetZ);
  if FSpeed <> FTargetSpeed then
    FSpeed := Combine(FSpeedAnimBegin, FSpeedAnimEnd, FOldSpeed, FTargetSpeed);
  if FOpacity <> FTargetOpacity then
    FOpacity := Combine(FOpacityAnimBegin, FOpacityAnimEnd, FOldOpacity, FTargetOpacity);
  for var i := Low(FPartDataArr) to High(FPartDataArr) do
    for var j := Low(FPartDataArr[i]) to High(FPartDataArr[i]) do
      FPartDataArr[i, j].Angle := FPartDataArr[i, j].Angle + FSpeed * FPartDataArr[i, j].Speed;
  Invalidate;
end;

procedure TSProgressIndicator.Click;
begin
  inherited;
  if Assigned(Parent) and Parent.Visible and Parent.CanFocus then
    Parent.SetFocus;
end;

function TSProgressIndicator.Combine(const A, B: TDateTime; const First,
  Second: Double): Double;
begin
  var t := Fraction(A, B);
  Result := (1 - t) * First + t * Second;
end;

constructor TSProgressIndicator.Create(AOwner: TComponent);
begin
  inherited;
  CreateDeviceIndependentResources;
  FAnimator := TTimer.Create(Self);
  FAnimator.Interval := 30;
  FAnimator.OnTimer := AnimatorTimer;
  FAccentColor := clNavy;
end;

procedure TSProgressIndicator.CreateDeviceIndependentResources;
var
  Sink: ID2D1GeometrySink;
  i, j: Integer;
  s, c: Double;
begin
  if Succeeded(D2DFactory.CreatePathGeometry(FPart)) then
  begin
    if Succeeded(FPart.Open(Sink)) then
      try
        Sink.BeginFigure(D2D1PointF(1, 0), D2D1_FIGURE_BEGIN_FILLED);
        try
          Sink.AddArc(
            D2D1ArcSegment(D2D1PointF(0, 1), D2D1SizeF(1, 1), 0, D2D1_SWEEP_DIRECTION_CLOCKWISE, D2D1_ARC_SIZE_SMALL)
          );
          Sink.AddLine(D2D1PointF(0, 0.8));
          Sink.AddArc(
            D2D1ArcSegment(D2D1PointF(0.8, 0), D2D1SizeF(0.8, 0.8), 0, D2D1_SWEEP_DIRECTION_COUNTER_CLOCKWISE, D2D1_ARC_SIZE_SMALL)
          );
        finally
          Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
        end;
      finally
        Sink.Close;
      end;
  end;
  begin
    var LEndPos: Double := 0.72;
    for i := High(FPartDataArr) downto Low(FPartDataArr) do
    begin
      for j := Low(FPartDataArr[i]) to High(FPartDataArr[i]) do
      begin
        FPartDataArr[i, j].Position := LEndPos;
        FPartDataArr[i, j].Angle := 360*Random;
        FPartDataArr[i, j].Speed := 20*(Random - 0.5);
        FPartDataArr[i, j].Scale := Random;
        FPartDataArr[i, j].Opacity := Random;
      end;
      LEndPos := LEndPos - 0.2 * LEndPos;
    end;
  end;
  SinCos(1/60 * 2*Pi, s, c);
  if Succeeded(D2DFactory.CreatePathGeometry(FLargeSecond)) then
  begin
    if Succeeded(FLargeSecond.Open(Sink)) then
      try
        Sink.BeginFigure(D2D1PointF(0, -1.1), D2D1_FIGURE_BEGIN_FILLED);
        try
          Sink.AddArc(
            D2D1ArcSegment(D2D1PointF(1.1*s, -1.1*c), D2D1SizeF(1.1, 1.1), 0, D2D1_SWEEP_DIRECTION_CLOCKWISE, D2D1_ARC_SIZE_SMALL)
          );
          Sink.AddLine(D2D1PointF(0.8*s, -0.8*c));
          Sink.AddArc(
            D2D1ArcSegment(D2D1PointF(0, -0.8), D2D1SizeF(0.8, 0.8), 0, D2D1_SWEEP_DIRECTION_COUNTER_CLOCKWISE, D2D1_ARC_SIZE_SMALL)
          );
        finally
          Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
        end;
      finally
        Sink.Close;
      end;
  end;
  SinCos(1/60 * 2*Pi, s, c);
  if Succeeded(D2DFactory.CreatePathGeometry(FSecond)) then
  begin
    if Succeeded(FSecond.Open(Sink)) then
      try
        Sink.BeginFigure(D2D1PointF(0, -1.1), D2D1_FIGURE_BEGIN_FILLED);
        try
          Sink.AddArc(
            D2D1ArcSegment(D2D1PointF(1.1*s, -1.1*c), D2D1SizeF(1.1, 1.1), 0, D2D1_SWEEP_DIRECTION_CLOCKWISE, D2D1_ARC_SIZE_SMALL)
          );
          Sink.AddLine(D2D1PointF(0.9*s, -0.9*c));
          Sink.AddArc(
            D2D1ArcSegment(D2D1PointF(0, -0.9), D2D1SizeF(0.9, 0.9), 0, D2D1_SWEEP_DIRECTION_COUNTER_CLOCKWISE, D2D1_ARC_SIZE_SMALL)
          );
        finally
          Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
        end;
      finally
        Sink.Close;
      end;
  end;
  SinCos(1/60 * 2*Pi, s, c);
  if Succeeded(D2DFactory.CreatePathGeometry(FMinute)) then
  begin
    if Succeeded(FMinute.Open(Sink)) then
      try
        Sink.BeginFigure(D2D1PointF(0, -1), D2D1_FIGURE_BEGIN_FILLED);
        try
          Sink.AddArc(
            D2D1ArcSegment(D2D1PointF(s, -c), D2D1SizeF(1, 1), 0, D2D1_SWEEP_DIRECTION_CLOCKWISE, D2D1_ARC_SIZE_SMALL)
          );
          Sink.AddLine(D2D1PointF(0.9*s, -0.9*c));
          Sink.AddArc(
            D2D1ArcSegment(D2D1PointF(0, -0.9), D2D1SizeF(0.9, 0.9), 0, D2D1_SWEEP_DIRECTION_COUNTER_CLOCKWISE, D2D1_ARC_SIZE_SMALL)
          );
        finally
          Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
        end;
      finally
        Sink.Close;
      end;
  end;
  SinCos(1/24 * 2*Pi, s, c);
  if Succeeded(D2DFactory.CreatePathGeometry(FHour)) then
  begin
    if Succeeded(FHour.Open(Sink)) then
      try
        Sink.BeginFigure(D2D1PointF(0, -1), D2D1_FIGURE_BEGIN_FILLED);
        try
          Sink.AddArc(
            D2D1ArcSegment(D2D1PointF(s, -c), D2D1SizeF(1, 1), 0, D2D1_SWEEP_DIRECTION_CLOCKWISE, D2D1_ARC_SIZE_SMALL)
          );
          Sink.AddLine(D2D1PointF(0.9*s, -0.9*c));
          Sink.AddArc(
            D2D1ArcSegment(D2D1PointF(0, -0.9), D2D1SizeF(0.9, 0.9), 0, D2D1_SWEEP_DIRECTION_COUNTER_CLOCKWISE, D2D1_ARC_SIZE_SMALL)
          );
        finally
          Sink.EndFigure(D2D1_FIGURE_END_CLOSED);
        end;
      finally
        Sink.Close;
      end;
  end;
end;

procedure TSProgressIndicator.CreateWnd;
begin
  inherited;
  FreeAndNil(FCanvas);
  FCanvas := TDirect2DCanvas.Create(Handle);
end;

destructor TSProgressIndicator.Destroy;
begin
  FreeAndNil(FCanvas);
  inherited;
end;

function TSProgressIndicator.DynGetFilled(out AOpacity: Double): Boolean;
begin
  Result := Assigned(FOnGetFilled) and FOnGetFilled(Self, AOpacity);
end;

procedure TSProgressIndicator.FailureStop;
begin
  if not (FState in [sStopped, sFailureStopped]) then
  begin
    FLastDurationSeconds := FSavedSeconds;
    if FStartTime <> 0.0 then
      FLastDurationSeconds := FLastDurationSeconds + SecondSpan(Now, FStartTime);
  end;
  FStartTime := 0.0;
  FSavedSeconds := 0;
  FState := sFailureStopped;
  SetTargetZ(15.0);
  SetTargetSpeed(0.0);
  SetTargetOpacity(0.0);
  Invalidate;
end;

function TSProgressIndicator.Fraction(const A, B: TDateTime): Double;
begin
  var LNow := Now;
  if LNow <= A then
    Result := 0
  else if (LNow >= B) or (A = B) then
    Result := 1
  else
    Result := SecondSpan(LNow, A) / SecondSpan(A, B);
end;

procedure TSProgressIndicator.Paint;
var
  i, j: Integer;
  Seconds: Int64;
  EvenMinute: Boolean;
  SecondsRem: Integer;
  MinutesRem: Integer;
  HoursRem: Integer;
  F: Double;
  dim: Double;
  LDiskOpacity: Double;
begin

  try
    var ClientWidthDIP := ClientWidth * 96 / Screen.PixelsPerInch;
    var ClientHeightDIP := ClientHeight * 96 / Screen.PixelsPerInch;
    if (FState in [sStopped, sFailureStopped]) and (FZ = FTargetZ) then
    begin
      FZ := 0.0;
      FTargetZ := 0.0;
    end;
    F := 0.45*Min(ClientWidthDIP, ClientHeightDIP);
    Canvas.RenderTarget.Clear(D2D1ColorF(Color));
    if (FState = sStopped) and (FLastDurationSeconds <> 0.0) then
    begin
      Canvas.RenderTarget.SetTransform(
        TD2DMatrix3x2F.Translation(ClientWidthDIP / 2, ClientHeightDIP / 2)
      );
      Canvas.Brush.Color := FAccentColor;
      Canvas.Brush.Handle.SetOpacity((1.0 - FOpacity) * 0.1);
      Canvas.FillEllipse(D2D1Ellipse(D2D1PointF(0, 0), F, F));
      Canvas.RenderTarget.SetTransform(
        TD2DMatrix3x2F.Identity
      );
      var R := ClientRect;
      var S := DurationToString(FLastDurationSeconds);
      Canvas.Brush.Style := bsClear;
      Canvas.Font.Assign(Font);
      Canvas.Font.Size := Max(9, Round(24 * F / 200));
      if ColorIsDark(Color) then
        Canvas.Font.Color := clWhite
      else
        Canvas.Font.Color := clBlack;
      Canvas.TextRect(R, S, [tfSingleLine, tfCenter, tfVerticalCenter]);
      Canvas.Brush.Style := bsSolid;
    end;
    if FZ = 0.0 then
      Exit;
    if F < 100 then
      Dim := F / 100
    else
      Dim := 1.0;
    Canvas.RenderTarget.SetTransform(
      TD2DMatrix3x2F.Translation(ClientWidthDIP / 2, ClientHeightDIP / 2)
    );
    Canvas.Brush.Color := FAccentColor;
    Canvas.Brush.Handle.SetOpacity(FOpacity * 0.1);
    Canvas.FillEllipse(D2D1Ellipse(D2D1PointF(0, 0), FZ*F, FZ*F));
    for i := Low(FPartDataArr) to High(FPartDataArr) do
      for j := Low(FPartDataArr[i]) to High(FPartDataArr[i]) do
      begin
        Canvas.RenderTarget.SetTransform(
          TD2DMatrix3x2F.Rotation(FPartDataArr[i, j].Angle, 0, 0)
            *
          TD2DMatrix3x2F.Scale(FZ*F*FPartDataArr[i, j].Position, FZ*F*FPartDataArr[i, j].Position, D2D1PointF(0, 0))
            *
          TD2DMatrix3x2F.Translation(ClientWidthDIP / 2, ClientHeightDIP / 2)
        );
        case FState of
          sPausing,
          sStopping:
            begin
              Canvas.Brush.Color := FAccentColor;
              Canvas.Brush.Handle.SetOpacity(0.5*Dim*FPartDataArr[i, j].Opacity);
            end;
          sFailureStopped:
            begin
              Canvas.Brush.Color := clRed;
              Canvas.Brush.Handle.SetOpacity(Dim*FPartDataArr[i, j].Opacity);
            end;
        else
          Canvas.Brush.Color := FAccentColor;
          Canvas.Brush.Handle.SetOpacity(Dim*FPartDataArr[i, j].Opacity);
        end;
        Canvas.FillGeometry(FPart);
      end;
    if FFilled or DynGetFilled(LDiskOpacity) then
    begin
      Canvas.RenderTarget.SetTransform(
        TD2DMatrix3x2F.Translation(ClientWidthDIP / 2, ClientHeightDIP / 2)
      );
      Canvas.Brush.Color := IfThen(FState = sFailureStopped, clRed, AccentColor);
      Canvas.Brush.Handle.SetOpacity(LDiskOpacity * 0.75);
      Canvas.FillEllipse(D2D1Ellipse(D2D1PointF(0, 0), FZ*F*0.18874368, FZ*F*0.18874368));
    end;
    if (FState in [sRunning, sPausing, sPaused, sStopping]) and ((FStartTime <> 0) or (FSavedSeconds <> 0)) then
    begin
      Canvas.RenderTarget.SetTransform(
        TD2DMatrix3x2F.Translation(ClientWidthDIP / 2, ClientHeightDIP / 2)
      );
      Canvas.Pen.Color := $A0A0A0;
      Canvas.Pen.Width := 1;
      Canvas.DrawEllipse(D2D1Ellipse(D2D1PointF(0, 0), FZ*F, FZ*F));
      Canvas.Brush.Color := AccentColor;
      Canvas.Brush.Handle.SetOpacity(0.5);
      Seconds := FSavedSeconds;
      if FStartTime <> 0.0 then
        Seconds := Seconds + SecondsBetween(Now, FStartTime);
      EvenMinute := Odd(Seconds div 60);
      SecondsRem := Seconds mod 60;
      for i := 0 to 59 do
        if not (EvenMinute xor (i >= SecondsRem)) then
        begin
          Canvas.RenderTarget.SetTransform(
            TD2DMatrix3x2F.Rotation(6 * i, 0, 0)
              *
            TD2DMatrix3x2F.Scale(FZ*F, FZ*F, D2D1PointF(0, 0))
              *
            TD2DMatrix3x2F.Translation(ClientWidthDIP / 2, ClientHeightDIP / 2)
          );
          if Dim >= 0.5 then
            Canvas.FillGeometry(FSecond)
          else
            Canvas.FillGeometry(FLargeSecond)
        end;
      Canvas.Brush.Handle.SetOpacity(0.25);
      MinutesRem := Seconds div 60 mod 60;
      for i := 0 to MinutesRem - 1 do
      begin
        Canvas.Brush.Handle.SetOpacity(IfThen(i = MinutesRem - 1, 1, Dim*IfThen(Odd(i), 0.25, 0.35)));
        Canvas.RenderTarget.SetTransform(
          TD2DMatrix3x2F.Rotation(6 * i, 0, 0)
            *
          TD2DMatrix3x2F.Scale(FZ*F*0.9, FZ*F*0.9, D2D1PointF(0, 0))
            *
          TD2DMatrix3x2F.Translation(ClientWidthDIP / 2, ClientHeightDIP / 2)
        );
        Canvas.FillGeometry(FMinute);
      end;
      Canvas.Brush.Handle.SetOpacity(0.1);
      HoursRem := Seconds div 3600 mod 24;
      for i := 0 to HoursRem - 1 do
      begin
        Canvas.Brush.Handle.SetOpacity(IfThen(i = HoursRem - 1, 1, Dim*IfThen(Odd(i), 0.1, 0.2)));
        Canvas.RenderTarget.SetTransform(
          TD2DMatrix3x2F.Rotation(15 * i, 0, 0)
            *
          TD2DMatrix3x2F.Scale(FZ*F*0.81, FZ*F*0.81, D2D1PointF(0, 0))
            *
          TD2DMatrix3x2F.Translation(ClientWidthDIP / 2, ClientHeightDIP / 2)
        );
        Canvas.FillGeometry(FHour);
      end;
    end;
  finally
    FAnimator.Enabled := (FZ <> FTargetZ) or (FSpeed <> FTargetSpeed) or (FOpacity <> FTargetOpacity) or
      (FState in [sRunning, sPausing, sStopping]);
  end;

end;

procedure TSProgressIndicator.Pause;
begin
  if not (FState in [sRunning, sPausing]) then
    Exit;
  Inc(FSavedSeconds, SecondsBetween(Now, FStartTime));
  FStartTime := 0.0;
  FState := sPaused;
  SetTargetZ(1.0);
  SetTargetSpeed(0.0);
  SetTargetOpacity(1.0);
  Invalidate;
end;

procedure TSProgressIndicator.Pausing;
begin
  if FState <> sRunning then
    Exit;
  FState := sPausing;
  SetTargetZ(1.0);
  SetTargetSpeed(5.0);
  SetTargetOpacity(1.0);
  Invalidate;
end;

procedure TSProgressIndicator.Restart;
begin
  Stop;
  Start;
end;

procedure TSProgressIndicator.Resume;
begin
  if not (FState in [sPausing, sPaused]) then
    Exit;
  FStartTime := Now;
  FState := sRunning;
  SetTargetZ(1.0);
  SetTargetSpeed(1.0);
  SetTargetOpacity(1.0);
  Invalidate;
end;

procedure TSProgressIndicator.SetAccentColor(const Value: TColor);
begin
  if FAccentColor <> Value then
  begin
    FAccentColor := Value;
    Invalidate;
  end;
end;

procedure TSProgressIndicator.SetFilled(const Value: Boolean);
begin
  if FFilled <> Value then
  begin
    FFilled := Value;
    Invalidate;
  end;
end;

procedure TSProgressIndicator.SetSavedSeconds(const Value: Int64);
begin
  if FSavedSeconds <> Value then
  begin
    FSavedSeconds := Value;
    Invalidate;
  end;
end;

procedure TSProgressIndicator.SetState(const Value: TState);
begin
  case Value of
    sStopped:
      Stop;
    sRunning:
      if FState in [sStopped, sFailureStopped, sStopping] then
        Start
      else if FState in [sPaused, sPausing] then
        Resume;
    sPausing:
      Pausing;
    sPaused:
      Pause;
    sStopping:
      Stopping;
    sFailureStopped:
      FailureStop;
  end;
end;

procedure TSProgressIndicator.SetTargetOpacity(const ATargetOpacity: Double);
begin
  if FTargetOpacity = ATargetOpacity then
    Exit;
  FOldOpacity := FOpacity;
  FTargetOpacity := ATargetOpacity;
  FOpacityAnimBegin := Now;
  FOpacityAnimEnd := IncMilliSecond(FOpacityAnimBegin, OpacityAnimDuration);
end;

procedure TSProgressIndicator.SetTargetSpeed(const ATargetSpeed: Double);
begin
  if FTargetSpeed = ATargetSpeed then
    Exit;
  FOldSpeed := FSpeed;
  FTargetSpeed := ATargetSpeed;
  FSpeedAnimBegin := Now;
  FSpeedAnimEnd := IncMilliSecond(FSpeedAnimBegin, SpeedAnimDuration);
end;

procedure TSProgressIndicator.SetTargetZ(const ATargetZ: Double);
begin
  if FTargetZ = ATargetZ then
    Exit;
  FOldZ := FZ;
  FTargetZ := ATargetZ;
  FZAnimBegin := Now;
  FZAnimEnd := IncMilliSecond(FZAnimBegin, ZAnimDuration);
end;

procedure TSProgressIndicator.Start;
begin
  FStartTime := Now;
  FSavedSeconds := 0;
  FLastDurationSeconds := 0.0;
  FState := sRunning;
  FZ := 0.0;
  SetTargetZ(1.0);
  SetTargetSpeed(1.0);
  SetTargetOpacity(1.0);
  Invalidate;
end;

procedure TSProgressIndicator.Stop;
begin
  if not (FState in [sStopped, sFailureStopped]) then
  begin
    FLastDurationSeconds := FSavedSeconds;
    if FStartTime <> 0.0 then
      FLastDurationSeconds := FLastDurationSeconds + SecondSpan(Now, FStartTime);
  end;
  FStartTime := 0.0;
  FSavedSeconds := 0;
  FState := sStopped;
  SetTargetZ(15.0);
  SetTargetSpeed(0.0);
  SetTargetOpacity(0.0);
  Invalidate;
end;

procedure TSProgressIndicator.Stopping;
begin
  if not (FState in [sRunning, sPausing, sPaused]) then
    Exit;
  FState := sStopping;
  SetTargetZ(1.0);
  SetTargetSpeed(5.0);
  SetTargetOpacity(1.0);
  Invalidate;
end;

procedure TSProgressIndicator.WMEraseBkgnd(var Message: TWMEraseBkgnd);
begin
  Message.Result := 1;
end;

procedure TSProgressIndicator.WMPaint(var Message: TWMPaint);
var
  PaintStruct: TPaintStruct;
begin
  BeginPaint(Handle, PaintStruct);
  try
    if Assigned(FCanvas) then
    begin
      FCanvas.BeginDraw;
      try
        Paint;
      finally
//        FCanvas.EndDraw;
        if FCanvas.RenderTarget.EndDraw = D2DERR_RECREATE_TARGET then
        begin
          FCanvas.Refresh;
          var S := D2D1SizeU(ClientWidth, ClientHeight);
          ID2D1HwndRenderTarget(FCanvas.RenderTarget).Resize(S);
          Invalidate;
        end;
      end;
    end;
  finally
    EndPaint(Handle, PaintStruct);
  end;
  Message.Result := 0;
end;

procedure TSProgressIndicator.WMSize(var Message: TWMSize);
var
  S: TD2DSizeU;
begin
  if Assigned(FCanvas) then
  begin
    S := D2D1SizeU(ClientWidth, ClientHeight);
    ID2D1HwndRenderTarget(FCanvas.RenderTarget).Resize(S);
  end;
  Invalidate;
  inherited;
end;

end.