unit WindowAnimator; interface uses SysUtils, Windows, Types, Classes, Vcl.Forms, Vcl.ExtCtrls; type TWindowAnimator = class(TComponent) strict private type TAxis = (axWidth, axHeight, axWidthLeft); 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 AnimateWidthLeft(ANewWidth: Integer; ABeforeProc: TProc = nil; AAfterProc: TProc = nil); // 왼쪽으로 크기 늘어나게 추가 22_0427 23:16:35 kku 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; procedure TWindowAnimator.AnimateWidthLeft(ANewWidth: Integer; ABeforeProc: TProc = nil; AAfterProc: TProc = nil); begin if FForm = nil then Exit; Stop; FAxis := axWidthLeft; 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); var nTemp: Integer; 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; axWidthLeft: begin nTemp := FTarget - FForm.Width; FForm.Width := FTarget; FForm.Left := FForm.Left - nTemp; end; 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]; axWidthLeft: begin nTemp := FFrames[i] - FForm.Width; FForm.Width := FFrames[i]; FForm.Left := FForm.Left - nTemp; end; end; end; end.