How to animate the resize of a Delphi VCL form on Windows?

Is there any reasonably simple and robust way to smoothly animate the programmatic resize of a Delphi VCL form on Windows?

For instance, when the user clicks the "Show details" button the form's height is increased with a details panel shown in the new client area.

Resizing the form by setting its Height (or ClientHeight) property will resize it immediately. I want the form to grow smoothly in height from its original value to the new value over a half-second duration.

How to smoothly animate the resize of a Delphi VCL form?

Solution

Yes, this is actually pretty easy.

Probably the simplest way is to base the solution on a TTimer which fires some 30 times per second or so, each time updating the form's size.

We just have to settle for a mapping T from time to size (width or height), so that T(0) is the original size, T(1) is the final, target size, and T(t) is the intermediate size at time t, normalized to [0, 1].

Here the simplest approach would be to let the size grow or shrink linearly with time. However, this looks bad. Instead, we should use some sigmoid function to make the speed slow at the beginning and the end and maximal at t = 0.5. My favourite sigmoid function is the inverse tangent function, but we could equally well use the hyperbolic tangent function or the error function.

Now, if FFrames[i] is the size of the ith frame, then

var F := 1 / ArcTan(Gamma);

for var i := 0 to High(FFrames) do
begin
  var t := i / High(FFrames);         // [0, 1]
      t := 2*t - 1;                   // [-1, 1]
      t := F*ArcTan(Gamma*t);         // sigmoid transformation
      t := (t + 1) / 2;               // [0, 1]
  FFrames[i] := Round((1 - t) * AFrom + t * ATo);
end;

computes the trajectory according to this scheme. Notice that FFrames[i] is a convex combination of the initial and final sizes.

The following component uses this code to implement animated resizing:

unit WindowAnimator;

interface

uses
  SysUtils, Windows, Types, Classes, Vcl.Forms, Vcl.ExtCtrls;

type
  TWindowAnimator = class(TComponent)
  strict private
  type
    TAxis = (axWidth, axHeight);
  const
    DEFAULT_GAMMA = 10;
    DEFAULT_DURATION = 1000 {ms};
    FrameCount = 256;
  var
    FTimer: TTimer;
    FGamma: Integer;
    FDuration: Integer {ms};
    FFrames: array[0..FrameCount - 1] of Integer;
    FAxis: TAxis;
    FTarget: Integer;
    FAnimStart,
    FAnimEnd: TDateTime;
    FForm: TCustomForm;
    FBeforeProc, FAfterProc: TProc;
    procedure TimerProc(Sender: TObject);
    procedure Plot(AFrom, ATo: Integer);
    procedure Stop;
    procedure Animate(ABeforeProc: TProc = nil; AAfterProc: TProc = nil);
    procedure DoBegin;
    procedure DoFinish;
  public
    constructor Create(AOwner: TComponent); override;
    procedure AnimateWidth(ANewWidth: Integer; ABeforeProc: TProc = nil; AAfterProc: TProc = nil);
    procedure AnimateHeight(ANewHeight: Integer; ABeforeProc: TProc = nil; AAfterProc: TProc = nil);
  published
    property Gamma: Integer read FGamma write FGamma default DEFAULT_GAMMA;
    property Duration {ms}: Integer read FDuration write FDuration default DEFAULT_DURATION;
  end;

procedure Register;

implementation

uses
  Math, DateUtils;

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

{ TWindowAnimator }

procedure TWindowAnimator.Animate(ABeforeProc, AAfterProc: TProc);
begin

  if FForm = nil then
    Exit;

  FBeforeProc := ABeforeProc;
  FAfterProc := AAfterProc;

  DoBegin;
  FAnimStart := Now;
  FAnimEnd := IncMilliSecond(FAnimStart, FDuration);
  FTimer.Enabled := True;

end;

procedure TWindowAnimator.AnimateHeight(ANewHeight: Integer;
  ABeforeProc, AAfterProc: TProc);
begin

  if FForm = nil then
    Exit;

  Stop;
  FAxis := axHeight;
  Plot(FForm.Height, ANewHeight);
  Animate(ABeforeProc, AAfterProc);

end;

procedure TWindowAnimator.AnimateWidth(ANewWidth: Integer;
  ABeforeProc, AAfterProc: TProc);
begin

  if FForm = nil then
    Exit;

  Stop;
  FAxis := axWidth;
  Plot(FForm.Width, ANewWidth);
  Animate(ABeforeProc, AAfterProc);

end;

constructor TWindowAnimator.Create(AOwner: TComponent);
begin
  inherited;
  if AOwner is TCustomForm then
    FForm := TCustomForm(AOwner);
  FGamma := DEFAULT_GAMMA;
  FDuration := DEFAULT_DURATION;
  FTimer := TTimer.Create(Self);
  FTimer.Interval := 30;
  FTimer.OnTimer := TimerProc;
  FTimer.Enabled := False;
end;

procedure TWindowAnimator.DoBegin;
begin
  if Assigned(FBeforeProc) then
    FBeforeProc();
end;

procedure TWindowAnimator.DoFinish;
begin
  if Assigned(FAfterProc) then
    FAfterProc();
end;

procedure TWindowAnimator.Plot(AFrom, ATo: Integer);
begin

  FTarget := ATo;

  var F := 1 / ArcTan(Gamma);

  for var i := 0 to High(FFrames) do
  begin
    var t := i / High(FFrames);         // [0, 1]
        t := 2*t - 1;                   // [-1, 1]
        t := F*ArcTan(Gamma*t);         // sigmoid transformation
        t := (t + 1) / 2;               // [0, 1]
    FFrames[i] := Round((1 - t) * AFrom + t * ATo);
  end;

end;

procedure TWindowAnimator.Stop;
begin
  FTimer.Enabled := False;
end;

procedure TWindowAnimator.TimerProc(Sender: TObject);
begin

  var LNow := Now;

  if (FForm = nil) or (FAnimEnd = 0.0) then
  begin
    FTimer.Enabled := False;
    Exit;
  end;

  if LNow > FAnimEnd then // play it safe
  begin
    FTimer.Enabled := False;
    case FAxis of
      axWidth:
        FForm.Width := FTarget;
      axHeight:
        FForm.Height := FTarget;
    end;
    DoFinish;
    Exit;
  end;

  var t := MilliSecondsBetween(LNow, FAnimStart) / MilliSecondsBetween(FAnimStart, FAnimEnd);
  var i := EnsureRange(Round(t * High(FFrames)), 0, High(FFrames));

  case FAxis of
    axWidth:
      FForm.Width := FFrames[i];
    axHeight:
      FForm.Height := FFrames[i];
  end;

end;

end.

To use this component, simply drop it on a form and use its public methods:

procedure AnimateWidth(ANewWidth: Integer; ABeforeProc: TProc = nil;
  AAfterProc: TProc = nil);
procedure AnimateHeight(ANewHeight: Integer; ABeforeProc: TProc = nil;
  AAfterProc: TProc = nil);

The optional TProc references let you run some code before and/or after the animation; typically, you want to populate any newly obtained client area after an increase in size and hide some content before a reduction in size.

Here's the component in action, showing and hiding a "Details" text:

Here's a more complicated example with a three-stage input procedure:

The total duration of the animation, as well as the sharpness of the sigmoid function, can be adjusted using the component's published properties.