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

Question

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?

Answer 1

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.

Answer 2

procedure TForm1.SmoothResizeFormTo(const ToSize: integer);
var
CurrentHeight: integer;
Step: integer;
begin
while Height <> ToSize do
begin
CurrentHeight := Form1.Height;
// this is the trick which both accelerates initially then
// decelerates as the form reaches its target size
Step := (ToSize - CurrentHeight) div 3;
// this allows for both collapse and expand by using Absolute
// calculated value
if (Step = 0) and (Abs(ToSize - CurrentHeight) > 0) then
begin
Step := ToSize - CurrentHeight;
Sleep(50); // adjust for smoothness
end;
if Step <> 0 then
begin
Height := Height + Step;
sleep(50); // adjust for smoothness
end;
end;
end;
procedure TForm1.btnCollapseClick(Sender: TObject);
begin
SmoothResizeFormTo(100);
end;
procedure TForm1.btnExpandClick(Sender: TObject);
begin
SmoothResizeFormTo(800);
end;
Try this without any timers ;)