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