BaiduFMX

1
// ***************************************************************************
2
//
3
// A Firemonkey Bezier Animation Component
4
//
5
// Copyright 2017 л¶Ù (zhaoyipeng@hotmail.com)
6
//
7
// https://github.com/zhaoyipeng/FMXComponents
8
//
9
// ***************************************************************************
10
// version history
11
// 2017-12-04, v0.1.0.0 :
12
//  first release version
13
//
14
unit FMX.BezierAnimation;
15

16
interface
17

18
uses
19
  System.Classes,
20
  System.Rtti,
21
  FMX.Types,
22
  FMX.Utils,
23
  FMX.Ani,
24
  FMX.ComponentsCommon;
25

26
type
27
  TBezier = class
28
  public const
29
    epsilon = 1.0E-5;
30
  private
31
    ax, bx, cx, ay, by, cy: Double;
32
    x1, y1, x2, y2: Double;
33
  public
34
    constructor Create(p1x, p1y, p2x, p2y: Double);
35
    procedure SetData(p1x, p1y, p2x, p2y: Double);
36
    function SampleCurveX(t: Double): Double;
37
    function SampleCurveY(t: Double): Double;
38
    function SampleCurveDerivativeX(t: Double): Double;
39
    function SolveCurveX(x, epsilon: Double): Double;
40
    function Solve(x, epsilon: Double): Double;
41
    class function GetLinear: TBezier;
42
    class function GetEase: TBezier;
43
    class function GetEaseIn: TBezier;
44
    class function GetEaseOut: TBezier;
45
    class function GetEaseInOut: TBezier;
46
  end;
47

48
  [ComponentPlatformsAttribute(TFMXPlatforms)]
49
  TFMXBezierAnimation = class(TFloatAnimation)
50
  private
51
    FBezier: TBezier;
52
    FP2X: Double;
53
    FP2Y: Double;
54
    FP1X: Double;
55
    FP1Y: Double;
56
    procedure SetP1X(const Value: Double);
57
    procedure SetP1Y(const Value: Double);
58
    procedure SetP2X(const Value: Double);
59
    procedure SetP2Y(const Value: Double);
60
    procedure UpdateBezier;
61
  protected
62
    procedure ProcessAnimation; override;
63
  public
64
    constructor Create(AOwner: TComponent); override;
65
    destructor Destroy; override;
66
    procedure SetData(p1x, p1y, p2x, p2y: Double);
67
    procedure SetBezier(bezier: TBezier);
68
    function BezierTime: Single;
69
  published
70
    property P1X: Double read FP1X write SetP1X;
71
    property P1Y: Double read FP1Y write SetP1Y;
72
    property P2X: Double read FP2X write SetP2X;
73
    property P2Y: Double read FP2Y write SetP2Y;
74
  end;
75

76
implementation
77

78
var
79
  Linear: TBezier = nil;
80
  Ease: TBezier = nil;
81
  EaseIn: TBezier = nil;
82
  EaseOut: TBezier = nil;
83
  EaseInOut: TBezier = nil;
84

85
type
86
  TAnimationHelper = class helper for TAnimation
87
  public
88
    function GetDelayTime: Single;
89
  end;
90

91
{ TBezier }
92

93
constructor TBezier.Create(p1x, p1y, p2x, p2y: Double);
94
begin
95
  SetData(p1x, p1y, p2x, p2y);
96
end;
97

98
class function TBezier.GetEase: TBezier;
99
begin
100
  if not Assigned(Ease) then
101
    Ease := TBezier.Create(0.25,0.1,0.25,1);
102
  Result := Ease;
103
end;
104

105
class function TBezier.GetEaseIn: TBezier;
106
begin
107
  if not Assigned(EaseInOut) then
108
    EaseInOut := TBezier.Create(0.42,0,1,1);
109
  Result := EaseIn;
110
end;
111

112

113
class function TBezier.GetEaseInOut: TBezier;
114
begin
115
  if not Assigned(EaseInOut) then
116
    EaseInOut := TBezier.Create(0.42,0,0.58,1);
117
  Result := EaseInOut;
118
end;
119

120

121
class function TBezier.GetEaseOut: TBezier;
122
begin
123
  if not Assigned(EaseInOut) then
124
    EaseInOut := TBezier.Create(0,0,0.58,1);
125
  Result := EaseOut;
126
end;
127

128

129
class function TBezier.GetLinear: TBezier;
130
begin
131
  if not Assigned(Linear) then
132
    Linear := TBezier.Create(0, 0, 1, 1);
133
  Result := Linear;
134
end;
135

136
function TBezier.SampleCurveDerivativeX(t: Double): Double;
137
begin
138
  Result := (3.0 * ax * t + 2.0 * bx) * t + cx;
139
end;
140

141
function TBezier.SampleCurveX(t: Double): Double;
142
begin
143
  // `ax t^3 + bx t^2 + cx t' expanded using Horner's rule.
144
  Result := ((ax * t + bx) * t + cx) * t;
145
end;
146

147
function TBezier.SampleCurveY(t: Double): Double;
148
begin
149
   Result := ((ay * t + by) * t + cy) * t;
150
end;
151

152
procedure TBezier.SetData(p1x, p1y, p2x, p2y: Double);
153
begin
154
  x1 := p1x;
155
  y1 := p1y;
156
  x2 := p2x;
157
  y2 := p2y;
158
  // Calculate the polynomial coefficients, implicit first and last control points are (0,0) and (1,1).
159
	cx := 3.0 * p1x;
160
	bx := 3.0 * (p2x - p1x) - cx;
161
  ax := 1.0 - cx -bx;
162

163
  cy := 3.0 * p1y;
164
  by := 3.0 * (p2y - p1y) - cy;
165
  ay := 1.0 - cy - by;
166
end;
167

168
// Given an x value, find a parametric value it came from.
169
function TBezier.Solve(x, epsilon: Double): Double;
170
begin
171
   Result := SampleCurveY(SolveCurveX(x, epsilon));
172
end;
173

174
function TBezier.SolveCurveX(x, epsilon: Double): Double;
175
var
176
  t0, t1, t2, x2, d2: Double;
177
  i: Integer;
178
begin
179
  // First try a few iterations of Newton's method -- normally very fast.
180
  t2 := x;
181
  for i := 0 to 7 do
182
  begin
183
    x2 := sampleCurveX(t2) - x;
184
    if (Abs(x2) < epsilon) then
185
      Exit(t2);
186
    d2 := SampleCurveDerivativeX(t2);
187
    if (Abs(d2) < 1e-6) then
188
      break;
189
    t2 := t2 - x2 / d2;
190
  end;
191

192
  // Fall back to the bisection method for reliability.
193
  t0 := 0.0;
194
  t1 := 1.0;
195
  t2 := x;
196

197
  if (t2 < t0) then
198
    Exit(t0);
199
  if (t2 > t1) then
200
    Exit(t1);
201

202
  while (t0 < t1) do
203
  begin
204
    x2 := SampleCurveX(t2);
205
    if (Abs(x2 - x) < epsilon) then
206
      Exit(t2);
207
    if (x > x2) then
208
      t0 := t2
209
    else
210
      t1 := t2;
211
    t2 := (t1 - t0) * 0.5 + t0;
212
  end;
213

214
  // Failure.
215
  Exit(t2);
216
end;
217

218
{ TBezierAnimation }
219

220
function TFMXBezierAnimation.BezierTime: Single;
221
begin
222
  Result := 0;
223
  if (Duration > 0) and (GetDelayTime <= 0) then
224
  begin
225
    Result := FBezier.Solve(InterpolateLinear(CurrentTime, 0, 1, Duration), TBezier.epsilon);
226
  end;
227
end;
228

229
constructor TFMXBezierAnimation.Create(AOwner: TComponent);
230
begin
231
  inherited;
232
  FP1X := 0;
233
  FP1Y := 0;
234
  FP2X := 1;
235
  FP2Y := 1;
236
  FBezier := TBezier.Create(0,0,1,1);
237
end;
238

239
destructor TFMXBezierAnimation.Destroy;
240
begin
241
  FBezier.Free;
242
  inherited;
243
end;
244

245
procedure TFMXBezierAnimation.ProcessAnimation;
246
var
247
  T: TRttiType;
248
  P: TRttiProperty;
249
begin
250
  if FInstance <> nil then
251
  begin
252
    T := SharedContext.GetType(FInstance.ClassInfo);
253
    if T <> nil then
254
    begin
255
      P := T.GetProperty(FPath);
256
      if (P <> nil) and (P.PropertyType.TypeKind = tkFloat) then
257
        P.SetValue(FInstance, InterpolateSingle(StartValue, StopValue, BezierTime));
258
    end;
259
  end;
260
end;
261

262
procedure TFMXBezierAnimation.SetBezier(bezier: TBezier);
263
begin
264
  FP1X := bezier.x1;
265
  FP1Y := bezier.y1;
266
  FP2X := bezier.x2;
267
  FP2Y := bezier.y2;
268
  FBezier.SetData(bezier.x1, bezier.y1, bezier.x2, bezier.y2);
269
end;
270

271
procedure TFMXBezierAnimation.SetData(p1x, p1y, p2x, p2y: Double);
272
begin
273
  FP1X := p1x;
274
  FP1Y := p1y;
275
  FP2X := p2x;
276
  FP2Y := p2y;
277
  FBezier.SetData(p1x, p1y, p2x, p2y);
278
end;
279

280
procedure TFMXBezierAnimation.SetP1X(const Value: Double);
281
begin
282
  if FP1X <> Value then
283
  begin
284
    FP1X := Value;
285
    UpdateBezier;
286
  end;
287
end;
288

289
procedure TFMXBezierAnimation.SetP1Y(const Value: Double);
290
begin
291
  if FP1Y <> Value then
292
  begin
293
    FP1Y := Value;
294
    UpdateBezier;
295
  end;
296
end;
297

298
procedure TFMXBezierAnimation.SetP2X(const Value: Double);
299
begin
300
  if FP2X <> Value then
301
  begin
302
    FP2X := Value;
303
    UpdateBezier;
304
  end;
305
end;
306

307
procedure TFMXBezierAnimation.SetP2Y(const Value: Double);
308
begin
309
  if FP2Y <> Value then
310
  begin
311
    FP2Y := Value;
312
    UpdateBezier;
313
  end;
314
end;
315

316
procedure TFMXBezierAnimation.UpdateBezier;
317
begin
318
  FBezier.SetData(FP1X, FP1Y, FP2X, FP2Y);
319
end;
320

321
{ TAnimationHelper }
322

323
function TAnimationHelper.GetDelayTime: Single;
324
begin
325
  with Self do
326
    Result := FDelayTime;
327
end;
328

329
initialization
330
finalization
331
  Linear.Free;
332
  Ease.Free;
333
  EaseIn.Free;
334
  EaseOut.Free;
335
  EaseInOut.Free;
336
end.
337