BaiduFMX

1
// ***************************************************************************
2
//
3
// FMXComponents: Firemonkey Opensource Components Set from China
4
//
5
// A simple Firemonkey Circle Score Indicator component
6
//
7
// Copyright 2017 谢顿 (zhaoyipeng@hotmail.com)
8
//
9
// https://github.com/zhaoyipeng/FMXComponents
10
//
11
// ***************************************************************************
12
// version history
13
// 2017-01-20, v0.1.0.0 : first release
14

15
unit FMX.CircleScoreIndicator;
16

17
interface
18

19
uses
20
  System.Classes,
21
  System.Types,
22
  System.Math.Vectors,
23
  System.UITypes,
24
  System.Generics.Collections,
25
  FMX.Controls,
26
  FMX.Graphics,
27
  FMX.Objects,
28
  FMX.ComponentsCommon;
29

30
type
31
  [ComponentPlatformsAttribute(TFMXPlatforms)]
32
  TFMXCircleScoreIndicator = class(TShape)
33
  private
34
    { Private declarations }
35
    FMax: Single;
36
    FMin: Single;
37
    FStartAngle: Single;
38
    FThickness: Single;
39
    FBackStroke: TStrokeBrush;
40
    FHeadBrush: TStrokeBrush;
41
    FTailBrush: TStrokeBrush;
42
    FScoreBrush: TBrush;
43
    FValue: Single;
44
    FIsHealthy: Boolean;
45
    procedure SetMax(const Value: Single);
46
    procedure SetMin(const Value: Single);
47
    procedure SetStartAngle(const Value: Single);
48
    procedure SetThickness(const Value: Single);
49
    procedure SetBackStroke(const Value: TStrokeBrush);
50
    procedure SetScoreBrush(const Value: TBrush);
51
    procedure SetValue(const Value: Single);
52
    function CreateMatrix(Angle: Single; cp2: TPointF): TMatrix;
53
    procedure RotateBrush(aBrush: TBrush; Angle: Single);
54
    procedure SetIsHealthy(const Value: Boolean);
55
  protected
56
    procedure Paint; override;
57
  public
58
    { Public declarations }
59
    constructor Create(AOwner: TComponent); override;
60
    destructor Destroy; override;
61
    procedure SetHealthyTheme;
62
    procedure SetUnhealthyTheme;
63
  published
64
   property Align;
65
    property Anchors;
66
    property ClipChildren default False;
67
    property ClipParent default False;
68
    property Cursor default crDefault;
69
    property DragMode default TDragMode.dmManual;
70
    property EnableDragHighlight default True;
71
    property Enabled default True;
72
    property Locked default False;
73
    property Height;
74
    property HitTest default True;
75
    property Padding;
76
    property Opacity;
77
    property Margins;
78
    property PopupMenu;
79
    property Position;
80
    property RotationAngle;
81
    property RotationCenter;
82
    property Scale;
83
    property Size;
84
    property Stroke;
85
    property Visible default True;
86
    property Width;
87
    property OnDragEnter;
88
    property OnDragLeave;
89
    property OnDragOver;
90
    property OnDragDrop;
91
    property OnDragEnd;
92
    property OnClick;
93
    property OnDblClick;
94
    property OnMouseDown;
95
    property OnMouseMove;
96
    property OnMouseUp;
97
    property OnMouseWheel;
98
    property OnMouseEnter;
99
    property OnMouseLeave;
100
    property OnPainting;
101
    property OnPaint;
102
    property OnResize;
103
    property Max: Single read FMax write SetMax;
104
    property Min: Single read FMin write SetMin;
105
    property Value: Single read FValue write SetValue;
106
    property StartAngle: Single read FStartAngle write SetStartAngle;
107
    property Thickness: Single read FThickness write SetThickness;
108
    property BackStroke: TStrokeBrush read FBackStroke write SetBackStroke;
109
    property ScoreBrush: TBrush read FScoreBrush write SetScoreBrush;
110
    property IsHealthy: Boolean read FIsHealthy write SetIsHealthy;
111
  end;
112

113
implementation
114

115
uses
116
  System.Math;
117

118
{ TFMXCircleScore }
119

120
constructor TFMXCircleScoreIndicator.Create(AOwner: TComponent);
121
var
122
  g: TGradientPoint;
123
begin
124
  inherited;
125
  FBackStroke := TStrokeBrush.Create(TBrushKind.Solid, $FFF5E0E2);
126
  FBackStroke.Thickness := 11;
127
  FBackStroke.OnChanged := FillChanged;
128
  FScoreBrush := TBrush.Create(TBrushKind.Gradient, $FFF14D4D);
129
  FScoreBrush.Gradient.Points.Clear;
130
  FScoreBrush.Gradient.Points.Add;
131
  FScoreBrush.Gradient.Points.Add;
132
  FScoreBrush.Gradient.Points.Add;
133
  g := FScoreBrush.Gradient.Points[0];
134
  g.Offset := 0;
135
  g.Color := $FFF14D4D;
136
  g := FScoreBrush.Gradient.Points[1];
137
  g.Offset := 0.5;
138
  g.Color := $FFE46161;
139
  g := FScoreBrush.Gradient.Points[2];
140
  g.Offset := 1.0;
141
  g.Color := $FFEB8F73;
142
  FScoreBrush.OnChanged := FillChanged;
143
  FMin := 0;
144
  FMax := 100;
145
  FValue := 45;
146
  FThickness := 11;
147
  FHeadBrush := TStrokeBrush.Create(TBrushKind.Solid, $FFF14D4D);
148
  FTailBrush := TStrokeBrush.Create(TBrushKind.Solid, $FFEB8F73);
149
end;
150

151
destructor TFMXCircleScoreIndicator.Destroy;
152
begin
153
  FTailBrush.Free;
154
  FHeadBrush.Free;
155
  FBackStroke.Free;
156
  inherited;
157
end;
158

159
function TFMXCircleScoreIndicator.CreateMatrix(Angle: Single; cp2: TPointF): TMatrix;
160
var
161
  ScaleMatrix: TMatrix;
162
  M1: TMatrix;
163
  M2: TMatrix;
164
  RotMatrix: TMatrix;
165
begin
166
  ScaleMatrix := TMatrix.Identity;
167
  ScaleMatrix.m11 := Scale.X;
168
  ScaleMatrix.m22 := Scale.Y;
169
  Result := ScaleMatrix;
170
  // rotation
171
  if Angle <> 0 then
172
  begin
173
    M1 := TMatrix.Identity;
174
    M1.m31 := -cp2.X * Scale.X;
175
    M1.m32 := -cp2.Y * Scale.Y;
176
    M2 := TMatrix.Identity;
177
    M2.m31 := cp2.X * Scale.X;
178
    M2.m32 := cp2.Y * Scale.Y;
179
    RotMatrix := M1 * (TMatrix.CreateRotation(DegToRad(Angle)) * M2);
180
    Result := Result * RotMatrix;
181
  end;
182
end;
183

184
procedure TFMXCircleScoreIndicator.Paint;
185
var
186
  r, r1, r2: Single;
187
  cr: TRectF;
188
  path: TPathData;
189
  Angle, delta, stAngle, enAngle: Single;
190
  Count: Integer;
191
  I: Integer;
192
  cp, cp1, cp2, p1, p2, p3, p4: TPointF;
193
  s, s2: TStrokeBrush;
194
  v1, v2: Single;
195
  oldMatrix, M: TMatrix;
196
begin
197
  inherited;
198
  r := (System.Math.Min(Width, Height) - Thickness) * 0.5;
199
  r1 := r - Thickness * 0.5;
200
  r2 := r + Thickness * 0.5;
201

202
  cr := TRectF.Create(0, 0, 1, 1).FitInto(LocalRect);
203
  cp := cr.CenterPoint;
204
  cr.Inflate(-Thickness * 0.5, -Thickness * 0.5);
205
  Canvas.DrawEllipse(cr, AbsoluteOpacity, FBackStroke);
206

207
  Angle := 360 * (FValue - FMin) / FMax;
208
  if SameValue(Angle, 0.0, 1E-4) then
209
    Exit;
210

211
  Count := Ceil(Angle / 5.0);
212
  if Odd(Count) then
213
    Count := Count + 1;
214
  delta := Angle / Count;
215
  path := TPathData.Create;
216
  s := TStrokeBrush.Create(TBrushKind.Gradient, TAlphaColors.Black);
217
  s2 := TStrokeBrush.Create(TBrushKind.Solid, TAlphaColors.Black);
218
  try
219
    s.Gradient.Points.Clear;
220
    s.Gradient.Points.Add;
221
    s.Gradient.Points.Add;
222

223
    cp1 := PointF(cp.X, cp.Y - r);
224
    Canvas.FillArc(cp1, PointF(Thickness * 0.5, Thickness * 0.5), -90, -180,
225
      AbsoluteOpacity, FHeadBrush);
226
    Canvas.DrawArc(cp1, PointF(Thickness * 0.5, Thickness * 0.5), -90, -180,
227
      AbsoluteOpacity, FHeadBrush);
228
    for I := 0 to Count - 1 do
229
    begin
230
      v1 := I / Count;
231
      v2 := (I + 1) / Count;
232

233
      stAngle := -90 + I * delta;
234
      enAngle := -90 + (I + 1) * delta;
235

236
      s.Gradient.Points[0].Color := FScoreBrush.Gradient.InterpolateColor(v1);
237
      s.Gradient.Points[1].Color := FScoreBrush.Gradient.InterpolateColor(v2);
238
      RotateBrush(s, stAngle + delta * 0.5);
239

240
      p1 := PointF(cp.X + r1 * Sin(stAngle), cp.Y + r1 * Cos(stAngle));
241
      p2 := PointF(cp.X + r1 * Sin(enAngle), cp.Y + r1 * Cos(enAngle));
242
      p3 := PointF(cp.X + r2 * Sin(enAngle), cp.Y + r2 * Cos(enAngle));
243
      p4 := PointF(cp.X + r2 * Sin(stAngle), cp.Y + r2 * Cos(stAngle));
244

245
      path.AddArc(cp, PointF(r1, r1), stAngle, delta);
246
      path.AddArc(cp, PointF(r2, r2), enAngle, -delta);
247
      path.ClosePath;
248
      Canvas.FillPath(path, AbsoluteOpacity, s);
249
      {$IFDEF MSWINDOWS}
250
      Canvas.DrawArc(cp, PointF(r1, r1), stAngle, delta, AbsoluteOpacity, s);
251
      Canvas.DrawArc(cp, PointF(r2, r2), stAngle, delta, AbsoluteOpacity, s);
252
      s2.Color := FScoreBrush.Gradient.InterpolateColor(v1);
253
      Canvas.DrawLine(path.Points[0].Point, path.Points[7].Point,
254
        AbsoluteOpacity, s2);
255
      {$ENDIF}
256
      path.Clear;
257
    end;
258

259
    cp2 := PointF(cp.X + r * Cos(DegToRad(Angle - 90)),
260
      cp.Y + r * Sin(DegToRad(Angle - 90)));
261
    M := CreateMatrix(Angle, cp2);
262
    oldMatrix := Canvas.Matrix;
263
    Canvas.MultiplyMatrix(M);
264
    Canvas.FillArc(cp2, PointF(Thickness * 0.5, Thickness * 0.5), -90, 180,
265
      AbsoluteOpacity, FTailBrush);
266
    Canvas.DrawArc(cp2, PointF(Thickness * 0.5, Thickness * 0.5), -90, 180,
267
      AbsoluteOpacity, FTailBrush);
268
    Canvas.SetMatrix(oldMatrix);
269
  finally
270
    path.Free;
271
    s.Free;
272
    s2.Free;
273
  end;
274
end;
275

276
procedure TFMXCircleScoreIndicator.RotateBrush(aBrush: TBrush; Angle: Single);
277
var
278
  M1, M2, RotMatrix: TMatrix;
279
  p1, p2: TPointF;
280
begin
281
  M1 := TMatrix.Identity;
282
  M1.m31 := -0.5;
283
  M1.m32 := -0.5;
284
  M2 := TMatrix.Identity;
285
  M2.m31 := 0.5;
286
  M2.m32 := 0.5;
287
  RotMatrix := M1 * (TMatrix.CreateRotation(DegToRad(Angle)) * M2);
288
  p1 := PointF(0, 0.5);
289
  p2 := PointF(1, 0.5);
290
  p1 := p1 * RotMatrix;
291
  p2 := p2 * RotMatrix;
292
  aBrush.Gradient.StartPosition.Point := p1;
293
  aBrush.Gradient.StopPosition.Point := p2;
294
end;
295

296
procedure TFMXCircleScoreIndicator.SetBackStroke(const Value: TStrokeBrush);
297
begin
298
  FBackStroke := Value;
299
end;
300

301
procedure TFMXCircleScoreIndicator.SetHealthyTheme;
302
var
303
  g: TGradientPoint;
304
begin
305
  BeginUpdate;
306
  FBackStroke.Color := $FFe0f5ef;
307
  FScoreBrush.Gradient.Points.Clear;
308
  FScoreBrush.Gradient.Points.Add;
309
  FScoreBrush.Gradient.Points.Add;
310
  FScoreBrush.Gradient.Points.Add;
311
  g := FScoreBrush.Gradient.Points[0];
312
  g.Offset := 0;
313
  g.Color := $FF14b98c;
314
  g := FScoreBrush.Gradient.Points[1];
315
  g.Offset := 0.5;
316
  g.Color := $FF0cd49e;
317
  g := FScoreBrush.Gradient.Points[2];
318
  g.Offset := 1.0;
319
  g.Color := $FF73eba0;
320
  FHeadBrush := TStrokeBrush.Create(TBrushKind.Solid, FScoreBrush.Gradient.Points[0].Color);
321
  FTailBrush := TStrokeBrush.Create(TBrushKind.Solid, FScoreBrush.Gradient.Points[2].Color);
322
  EndUpdate;
323
end;
324

325
procedure TFMXCircleScoreIndicator.SetIsHealthy(const Value: Boolean);
326
begin
327
  if FIsHealthy <> Value then
328
  begin
329
    FIsHealthy := Value;
330
    if FIsHealthy then
331
      SetHealthyTheme
332
    else
333
      SetUnhealthyTheme;
334
  end;
335
end;
336

337
procedure TFMXCircleScoreIndicator.SetMax(const Value: Single);
338
begin
339
  if FMax <> Value then
340
  begin
341
    FMax := Value;
342
    Repaint;
343
  end;
344
end;
345

346
procedure TFMXCircleScoreIndicator.SetMin(const Value: Single);
347
begin
348
  if FMin <> Value then
349
  begin
350
    FMin := Value;
351
    Repaint;
352
  end;
353
end;
354

355
procedure TFMXCircleScoreIndicator.SetScoreBrush(const Value: TBrush);
356
begin
357
  FScoreBrush := Value;
358
end;
359

360
procedure TFMXCircleScoreIndicator.SetStartAngle(const Value: Single);
361
begin
362
  if FStartAngle <> Value then
363
  begin
364
    FStartAngle := Value;
365
    Repaint;
366
  end;
367
end;
368

369
procedure TFMXCircleScoreIndicator.SetThickness(const Value: Single);
370
begin
371
  if FThickness <> Value then
372
  begin
373
    FThickness := Value;
374
    FBackStroke.Thickness := Value;
375
    Repaint;
376
  end;
377
end;
378

379
procedure TFMXCircleScoreIndicator.SetUnhealthyTheme;
380
var
381
  g: TGradientPoint;
382
begin
383
  BeginUpdate;
384
  FBackStroke.Color := $FFF5E0E2;
385
  FScoreBrush.Gradient.Points.Clear;
386
  FScoreBrush.Gradient.Points.Add;
387
  FScoreBrush.Gradient.Points.Add;
388
  FScoreBrush.Gradient.Points.Add;
389
  g := FScoreBrush.Gradient.Points[0];
390
  g.Offset := 0;
391
  g.Color := $FFF14D4D;
392
  g := FScoreBrush.Gradient.Points[1];
393
  g.Offset := 0.5;
394
  g.Color := $FFE46161;
395
  g := FScoreBrush.Gradient.Points[2];
396
  g.Offset := 1.0;
397
  g.Color := $FFEB8F73;
398
  FHeadBrush := TStrokeBrush.Create(TBrushKind.Solid, FScoreBrush.Gradient.Points[0].Color);
399
  FTailBrush := TStrokeBrush.Create(TBrushKind.Solid, FScoreBrush.Gradient.Points[2].Color);
400
  EndUpdate;
401
end;
402

403
procedure TFMXCircleScoreIndicator.SetValue(const Value: Single);
404
begin
405
  if FValue <> Value then
406
  begin
407
    FValue := Value;
408
    Repaint;
409
  end;
410
end;
411

412
end.
413