1 // SPDX-License-Identifier: LGPL-3.0-only (modified to allow linking)
2 {
3   Part of BGRA Controls. Made by third party.
4   For detailed information see readme.txt
5 
6   Site: https://sourceforge.net/p/bgra-controls/
7   Wiki: http://wiki.lazarus.freepascal.org/BGRAControls
8   Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html
9 }
10 {******************************* CONTRIBUTOR(S) ******************************
11 - Edivando S. Santos Brasil | mailedivando@gmail.com
12   (Compatibility with delphi VCL 11/2018)
13 
14 ***************************** END CONTRIBUTOR(S) *****************************}
15 unit DTAnalogClock;
16 
17 {$I bgracontrols.inc}
18 
19 interface
20 
21 uses
22   Classes, SysUtils, {$IFDEF FPC}LResources,{$ENDIF}
23   Forms, Controls, Graphics, Dialogs, ExtCtrls,
24   {$IFNDEF FPC}Types, BGRAGraphics, GraphType, FPImage, {$ENDIF}
25   BCBaseCtrls, BGRABitmap, BGRABitmapTypes, BGRAGradients;
26 
27 type
28   TClockStyle = (stlBlue, stlGreen, stlWhite);
29 
30   { TDTCustomAnalogClock }
31 
32   TDTCustomAnalogClock = class(TBGRAGraphicCtrl)
33   private
34     FClockStyle: TClockStyle;
35     FBitmap: TBGRABitmap;
36     FClockFace: TBGRABitmap;
37     FEnabled: boolean;
38     FMovingParts: TBGRABitmap;
39     FTimer: TTimer;
40     FResized: boolean;
41     procedure SetClockStyle(AValue: TClockStyle);
42     { Private declarations }
43   protected
44     procedure SetEnabled(AValue: boolean); override;
45     { Protected declarations }
46     procedure Paint; override;
47     procedure DrawClock; virtual;
48     procedure DrawClockFace; virtual;
49     procedure DrawMovingParts; virtual;
50     procedure SwitchTimer;
51 
52     procedure TimerEvent({%H-}Sender: TObject);
53     procedure ResizeEvent({%H-}Sender: TObject);
54   public
55     { Public declarations }
56     constructor Create(AOwner: TComponent); override;
57     destructor Destroy; override;
58     property Enabled: boolean read FEnabled write SetEnabled;// default False;
59   end;
60 
61   TDTAnalogClock = class(TDTCustomAnalogClock)
62   private
63     { Private declarations }
64   protected
65     { Protected declarations }
66   public
67     { Public declarations }
68   published
69     { Published declarations }
70     //property ClockStyle;
71     property Enabled;
72   end;
73 
74 {$IFDEF FPC}procedure Register;{$ENDIF}
75 
76 implementation
77 
78 { TDTCustomAnalogClock }
79 
80 constructor TDTCustomAnalogClock.Create(AOwner: TComponent);
81 begin
82   inherited Create(AOwner);
83 
84   OnResize := ResizeEvent;
85 
86   Width := 128;
87   Height := 128;
88 
89   FBitmap := TBGRABitmap.Create;
90   FClockFace := TBGRABitmap.Create;
91   FMovingParts := TBGRABitmap.Create;
92 
93   FBitmap.SetSize(Width, Height);
94 
95   DrawClockFace;
96   DrawMovingParts;
97 
98 
99   FTimer := TTimer.Create(Self);
100   FTimer.Interval := 1000;
101   FTimer.Enabled := FEnabled;
102   FTimer.OnTimer := TimerEvent;
103 
104 end;
105 
106 destructor TDTCustomAnalogClock.Destroy;
107 begin
108   FTimer.Enabled:=False;
109   FTimer.OnTimer:=nil;
110   FBitmap.Free;
111   FClockFace.Free;
112   FMovingParts.Free;
113 
114   inherited Destroy;
115 end;
116 
117 procedure TDTCustomAnalogClock.DrawClock;
118 begin
119 
120 end;
121 
122 procedure TDTCustomAnalogClock.DrawClockFace;
123 var
124   img: TBGRABitmap;
125   A: integer;
126   w, h, r, Xo, Yo, X, Y, Xt, Yt: integer;
127   phong: TPhongShading;
128 begin
129   w := Width;
130   h := Height;
131 
132   { Set center point }
133   Xo := w div 2;
134   Yo := h div 2;
135 
136   // Determine radius. If canvas is rectangular then r = shortest length w or h
137   r := yo;
138 
139   if xo > yo then
140     r := yo;
141 
142   if xo < yo then
143     r := xo;
144 
145   img := TBGRABitmap.Create(w, h);
146 
147   // Draw Bitmap frame
148   img.FillEllipseAntialias(Xo, Yo, r * 0.99, r * 0.99, BGRA(175, 175, 175));
149 
150   // Draw Rounded/RIng type border using shading
151   phong := TPhongShading.Create;
152   phong.LightPosition := point(Xo, Yo);
153   phong.DrawSphere(img, rect(round(Xo - r * 0.98), round(Yo - r * 0.98), round(Xo + r * 0.98) + 1, round(Yo + r * 0.98) + 1), 4, BGRA(245, 245, 245));
154   phong.Free;
155   img.EllipseAntialias(Xo, Yo, r * 0.99, r * 0.99, ColorToBGRA(clBlack, 110), 1);
156 
157   img.FillEllipseLinearColorAntialias(Xo, Yo, r * 0.88, r * 0.88, BGRA(0, 58, 81), BGRA(2, 94, 131));
158 
159   // Draw Face frame
160   img.FillEllipseAntialias(Xo, Yo, r * 0.90, r * 0.90, BGRA(175, 175, 175));
161 
162   // Draw face background
163   img.FillEllipseLinearColorAntialias(Xo, Yo, r * 0.88, r * 0.88, BGRA(0, 58, 81), BGRA(2, 94, 131));
164 
165   // Draw Bitmap face
166   for A := 1 to 12 do
167   begin
168     X := Xo + Round(r * 0.80 * sin(30 * A * Pi / 180));
169     Y := Yo - Round(r * 0.80 * cos(30 * A * Pi / 180));
170     Xt := Xo + Round(r * 0.70 * sin(30 * A * Pi / 180));
171     Yt := Yo - Round(r * 0.70 * cos(30 * A * Pi / 180));
172     img.EllipseAntialias(x, y, (r * 0.02), (r * 0.02), BGRA(255, 255, 255, 200), 2, BGRA(2, 94, 131));
173 
174     img.FontName := 'Calibri';
175     img.FontHeight := r div 8;
176     img.FontQuality := fqFineAntialiasing;
177     img.TextOut(Xt, Yt - (img.FontHeight / 1.7), IntToStr(A), BGRA(245, 245, 245), taCenter);
178   end;
179 
180   FClockFace.Fill(BGRA(0, 0, 0, 0));
181   FClockFace.Assign(img);
182 
183   img.Free;
184 
185 end;
186 
187 procedure TDTCustomAnalogClock.DrawMovingParts;
188 var
189   img: TBGRABitmap;
190   w, h, r, Xo, Yo: integer;
191   Xs, Ys, Xm, Ym, Xh, Yh: integer;
192   th, tm, ts, tn: word;
193 begin
194 
195   w := Width;
196   h := Height;
197 
198   { Set center point }
199   Xo := w div 2;
200   Yo := h div 2;
201 
202   // Determine radius. If canvas is rectangular then r = shortest length w or h
203   r := yo;
204 
205   if xo > yo then
206     r := yo;
207 
208   if xo < yo then
209     r := xo;
210 
211   //// Convert current time to integer values
212   decodetime(Time, th, tm, ts, tn);
213 
214   //{ Set coordinates (length of arm) for seconds }
215   Xs := Xo + Round(r * 0.78 * Sin(ts * 6 * Pi / 180));
216   Ys := Yo - Round(r * 0.78 * Cos(ts * 6 * Pi / 180));
217 
218   //{ Set coordinates (length of arm) for minutes }
219   Xm := Xo + Round(r * 0.68 * Sin(tm * 6 * Pi / 180));
220   Ym := Yo - Round(r * 0.68 * Cos(tm * 6 * Pi / 180));
221 
222   //{ Set coordinates (length of arm) for hours }
223   Xh := Xo + Round(r * 0.50 * Sin((th * 30 + tm / 2) * Pi / 180));
224   Yh := Yo - Round(r * 0.50 * Cos((th * 30 + tm / 2) * Pi / 180));
225 
226   img := TBGRABitmap.Create(w, h);
227 
228   // Draw time hands
229   img.DrawLineAntialias(xo, yo, xs, ys, BGRA(255, 0, 0), r * 0.02);
230   img.DrawLineAntialias(xo, yo, xm, ym, BGRA(245, 245, 245), r * 0.03);
231   img.DrawLineAntialias(xo, yo, xh, yh, BGRA(245, 245, 245), r * 0.07);
232   img.DrawLineAntialias(xo, yo, xh, yh, BGRA(2, 94, 131), r * 0.04);
233 
234   // Draw Bitmap centre dot
235   img.EllipseAntialias(Xo, Yo, r * 0.04, r * 0.04, BGRA(245, 245, 245, 255), r * 0.02, BGRA(210, 210, 210, 255));
236 
237   // Clear bitmap first
238   FMovingParts.Fill(BGRA(0, 0, 0, 0));
239   FMovingParts.Assign(img);
240 
241   img.Free;
242 end;
243 
244 procedure TDTCustomAnalogClock.SwitchTimer;
245 begin
246   FTimer.Enabled := Enabled;
247 end;
248 
249 procedure TDTCustomAnalogClock.Paint;
250 begin
251   inherited Paint;
252 
253   FBitmap.SetSize(Width, Height);
254   FBitMap.Fill(BGRA(0, 0, 0, 0));
255 
256   if FResized then
257   begin
258     DrawClockFace;
259     DrawMovingParts;
260     FResized := False;
261   end;
262 
263   FBitmap.BlendImage(0, 0, FClockFace, boLinearBlend);
264   FBitmap.BlendImage(0, 0, FMovingParts, boLinearBlend);
265 
266   FBitmap.Draw(Canvas, 0, 0, False);
267 
268 end;
269 
270 procedure TDTCustomAnalogClock.ResizeEvent(Sender: TObject);
271 begin
272   FResized := True;
273 end;
274 
275 procedure TDTCustomAnalogClock.SetClockStyle(AValue: TClockStyle);
276 begin
277   if FClockStyle = AValue then
278     Exit;
279   FClockStyle := AValue;
280 end;
281 
282 procedure TDTCustomAnalogClock.SetEnabled(AValue: boolean);
283 begin
284   if FEnabled = AValue then
285     Exit;
286   FEnabled := AValue;
287   SwitchTimer;
288 end;
289 
290 procedure TDTCustomAnalogClock.TimerEvent(Sender: TObject);
291 begin
292   DrawMovingParts;
293   Refresh;
294 end;
295 
296 {$IFDEF FPC}
297 procedure Register;
298 begin
299   //{$I icons\dtanalogclock_icon.lrs}
300   RegisterComponents('BGRA Controls', [TDTAnalogClock]);
301 end;
302 {$ENDIF}
303 
304 
305 end.
306