如何解决如何在 Windows 上为 Delphi VCL 表单的调整大小设置动画?
是否有任何相当简单和健壮的方法来平滑动画在 Windows 上以编程方式调整 Delphi VCL 表单的大小?
例如,当用户单击“显示详细信息”按钮时,表单的高度会增加,并在新客户区中显示详细信息面板。
通过设置 Height
(或 ClientHeight
)属性来调整表单的大小会立即调整它的大小。我希望表单的高度在半秒内从其原始值平滑增长到新值。
如何平滑地为 Delphi VCL 表单的大小调整设置动画?
解决方法
是的,这其实很简单。
可能最简单的方法是将解决方案基于 TTimer
,它每秒触发大约 30 次,每次更新表单的大小。
我们只需要从时间到尺寸(宽度或高度)的映射 T,这样 T(0) 是原始尺寸, T(1) 是最终的目标大小,T(t) 是 t 时刻的中间大小,归一化到 [0,1]。
这里最简单的方法是让大小随时间线性增长或缩小。然而,这看起来很糟糕。相反,我们应该使用一些 sigmoid function 使速度在开始和结束时变慢,并在 t = 0.5 时达到最大值。我最喜欢的 sigmoid 函数是 inverse tangent function,但我们同样可以使用 hyperbolic tangent function 或 error function。
现在,如果 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]
是初始和最终大小的 convex combination。
以下组件使用此代码来实现动画调整大小:
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)),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
引用让您可以在动画之前和/或之后运行一些代码;通常,您希望在增大大小后填充任何新获得的客户区,并在减小大小前隐藏一些内容。
这是正在运行的组件,显示和隐藏“详细信息”文本:
这是一个更复杂的例子,包含一个三级输入过程:
动画的总持续时间以及 sigmoid 函数的锐度,可以使用组件的已发布属性进行调整。
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。