如何在Windows上为Delphi VCL窗体调整大小添加动画效果？

Question

有没有一种相当简单且稳健的方法可以平滑地动画化 Delphi VCL 窗体在 Windows 上的编程调整大小？

例如，当用户单击“显示详细信息”按钮时，窗体的高度会增加，并在新的客户区域中显示详细面板。

通过设置窗体的 Height（或 ClientHeight）属性来调整窗体大小将立即调整它。我希望窗体能够在半秒钟的时间内从原始值平滑地增长到新值。

如何平滑地动画化调整 Delphi VCL 窗体的大小？

- Andreas Rejbrand

---

这让我想起20年前我是AnimateWindow()的粉丝，但后来因为浪费时间而讨厌所有动画。请给用户提供禁用动画的选项，或者尊重系统设置。 - AmigoJack

这是一个旧问题，有一个简单的解决方案：https://dev59.com/jJbfa4cB1Zd3GeqPwJwH#36956429 - John Easley

@JohnEasley：在我的看法中，那个解决方案会在动画期间阻塞GUI线程，这是一个相当大的缺点。 - Andreas Rejbrand

Answer 1

是的，这实际上非常容易。

可能最简单的方法是基于一个TTimer解决方案，每秒触发大约30次，每次更新表单的大小。

我们只需要确定从时间到大小（宽度或高度）的映射T，使得T(0)是原始大小，T(1)是最终目标大小，T(t)是在时间t处的中间大小，归一化为[0,1]。

这里最简单的方法是让大小随时间线性增长或缩小。然而，这看起来很糟糕。相反，我们应该使用一些Sigmoid函数，使得速度在开始和结束时变慢，并在t = 0.5时达到最大值。我最喜欢的Sigmoid函数是反正切函数，但我们同样可以使用双曲正切函数或误差函数。

现在，如果FFrames[i]是第i帧的大小，则

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;

按照此方案计算轨迹。请注意，FFrames[i] 是初始大小和最终大小的 凸组合。

以下组件使用此代码实现动态调整大小：

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.

要使用此组件，只需将其放在表单上并使用其公共方法即可：

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

可选的TProc引用允许您在动画之前和/或之后运行一些代码；通常，您希望在尺寸增加后填充任何新获得的客户区域，并在尺寸减小之前隐藏某些内容。

以下是组件实际应用，显示和隐藏“详细信息”文本： 这是一个更复杂的示例，具有三个阶段的输入过程： 可以使用组件的已发布属性调整动画的总持续时间以及S形函数的锐度。

- Andreas Rejbrand

---

太棒了，+1！有趣的是，在SO上观看动画让我感到有点恶心 ;) - MartynA

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;

不要使用任何计时器尝试this ;)

- kazuser

---

我不喜欢这种方法，因为它会在动画期间阻塞UI线程。我使用计时器并不是因为我想让它变得复杂或者因为我不知道其他的替代方案，而是因为结果的质量！使用计时器，消息泵将在整个动画期间保持活跃。你的图片是误导性的，因为它来自Windows而不是你的代码。使用你的代码，进度条在调整大小期间会冻结。此外，你的代码没有使用Sigmoid函数。 - Andreas Rejbrand