// SPDX-License-Identifier: LGPL-3.0-linking-exception { Part of BGRA Controls. Made by third party. For detailed information see readme.txt Site: https://sourceforge.net/p/bgra-controls/ Wiki: http://wiki.lazarus.freepascal.org/BGRAControls Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html } {******************************* CONTRIBUTOR(S) ****************************** - Edivando S. Santos Brasil | mailedivando@gmail.com (Compatibility with delphi VCL 11/2018) ***************************** END CONTRIBUTOR(S) *****************************} unit DTAnalogClock; {$I bgracontrols.inc} interface uses Classes, SysUtils, {$IFDEF FPC}LResources,{$ENDIF} Forms, Controls, Graphics, Dialogs, ExtCtrls, {$IFNDEF FPC}Types, BGRAGraphics, GraphType, FPImage, {$ENDIF} BCBaseCtrls, BGRABitmap, BGRABitmapTypes, BGRAGradients; type TClockStyle = (stlBlue, stlGreen, stlWhite); { TDTCustomAnalogClock } TDTCustomAnalogClock = class(TBGRAGraphicCtrl) private FClockStyle: TClockStyle; FBitmap: TBGRABitmap; FClockFace: TBGRABitmap; FEnabled: boolean; FMovingParts: TBGRABitmap; FTimer: TTimer; FResized: boolean; procedure SetClockStyle(AValue: TClockStyle); { Private declarations } protected procedure SetEnabled(AValue: boolean); override; { Protected declarations } procedure Paint; override; procedure DrawClock; virtual; procedure DrawClockFace; virtual; procedure DrawMovingParts; virtual; procedure SwitchTimer; procedure TimerEvent({%H-}Sender: TObject); procedure ResizeEvent({%H-}Sender: TObject); public { Public declarations } constructor Create(AOwner: TComponent); override; destructor Destroy; override; property Enabled: boolean read FEnabled write SetEnabled;// default False; end; TDTAnalogClock = class(TDTCustomAnalogClock) private { Private declarations } protected { Protected declarations } public { Public declarations } published { Published declarations } //property ClockStyle; property Enabled; end; {$IFDEF FPC}procedure Register;{$ENDIF} implementation { TDTCustomAnalogClock } constructor TDTCustomAnalogClock.Create(AOwner: TComponent); begin inherited Create(AOwner); OnResize := ResizeEvent; Width := 128; Height := 128; FBitmap := TBGRABitmap.Create; FClockFace := TBGRABitmap.Create; FMovingParts := TBGRABitmap.Create; FBitmap.SetSize(Width, Height); DrawClockFace; DrawMovingParts; FTimer := TTimer.Create(Self); FTimer.Interval := 1000; FTimer.Enabled := FEnabled; FTimer.OnTimer := TimerEvent; end; destructor TDTCustomAnalogClock.Destroy; begin FTimer.Enabled:=False; FTimer.OnTimer:=nil; FBitmap.Free; FClockFace.Free; FMovingParts.Free; inherited Destroy; end; procedure TDTCustomAnalogClock.DrawClock; begin end; procedure TDTCustomAnalogClock.DrawClockFace; var img: TBGRABitmap; A: integer; w, h, r, Xo, Yo, X, Y, Xt, Yt: integer; phong: TPhongShading; begin w := Width; h := Height; { Set center point } Xo := w div 2; Yo := h div 2; // Determine radius. If canvas is rectangular then r = shortest length w or h r := yo; if xo > yo then r := yo; if xo < yo then r := xo; img := TBGRABitmap.Create(w, h); // Draw Bitmap frame img.FillEllipseAntialias(Xo, Yo, r * 0.99, r * 0.99, BGRA(175, 175, 175)); // Draw Rounded/RIng type border using shading phong := TPhongShading.Create; phong.LightPosition := point(Xo, Yo); 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)); phong.Free; img.EllipseAntialias(Xo, Yo, r * 0.99, r * 0.99, ColorToBGRA(clBlack, 110), 1); img.FillEllipseLinearColorAntialias(Xo, Yo, r * 0.88, r * 0.88, BGRA(0, 58, 81), BGRA(2, 94, 131)); // Draw Face frame img.FillEllipseAntialias(Xo, Yo, r * 0.90, r * 0.90, BGRA(175, 175, 175)); // Draw face background img.FillEllipseLinearColorAntialias(Xo, Yo, r * 0.88, r * 0.88, BGRA(0, 58, 81), BGRA(2, 94, 131)); // Draw Bitmap face for A := 1 to 12 do begin X := Xo + Round(r * 0.80 * sin(30 * A * Pi / 180)); Y := Yo - Round(r * 0.80 * cos(30 * A * Pi / 180)); Xt := Xo + Round(r * 0.70 * sin(30 * A * Pi / 180)); Yt := Yo - Round(r * 0.70 * cos(30 * A * Pi / 180)); img.EllipseAntialias(x, y, (r * 0.02), (r * 0.02), BGRA(255, 255, 255, 200), 2, BGRA(2, 94, 131)); img.FontName := 'Calibri'; img.FontHeight := r div 8; img.FontQuality := fqFineAntialiasing; img.TextOut(Xt, Yt - (img.FontHeight / 1.7), IntToStr(A), BGRA(245, 245, 245), taCenter); end; FClockFace.Fill(BGRA(0, 0, 0, 0)); FClockFace.Assign(img); img.Free; end; procedure TDTCustomAnalogClock.DrawMovingParts; var img: TBGRABitmap; w, h, r, Xo, Yo: integer; Xs, Ys, Xm, Ym, Xh, Yh: integer; th, tm, ts, tn: word; begin w := Width; h := Height; { Set center point } Xo := w div 2; Yo := h div 2; // Determine radius. If canvas is rectangular then r = shortest length w or h r := yo; if xo > yo then r := yo; if xo < yo then r := xo; //// Convert current time to integer values decodetime(Time, th, tm, ts, tn); //{ Set coordinates (length of arm) for seconds } Xs := Xo + Round(r * 0.78 * Sin(ts * 6 * Pi / 180)); Ys := Yo - Round(r * 0.78 * Cos(ts * 6 * Pi / 180)); //{ Set coordinates (length of arm) for minutes } Xm := Xo + Round(r * 0.68 * Sin(tm * 6 * Pi / 180)); Ym := Yo - Round(r * 0.68 * Cos(tm * 6 * Pi / 180)); //{ Set coordinates (length of arm) for hours } Xh := Xo + Round(r * 0.50 * Sin((th * 30 + tm / 2) * Pi / 180)); Yh := Yo - Round(r * 0.50 * Cos((th * 30 + tm / 2) * Pi / 180)); img := TBGRABitmap.Create(w, h); // Draw time hands img.DrawLineAntialias(xo, yo, xs, ys, BGRA(255, 0, 0), r * 0.02); img.DrawLineAntialias(xo, yo, xm, ym, BGRA(245, 245, 245), r * 0.03); img.DrawLineAntialias(xo, yo, xh, yh, BGRA(245, 245, 245), r * 0.07); img.DrawLineAntialias(xo, yo, xh, yh, BGRA(2, 94, 131), r * 0.04); // Draw Bitmap centre dot img.EllipseAntialias(Xo, Yo, r * 0.04, r * 0.04, BGRA(245, 245, 245, 255), r * 0.02, BGRA(210, 210, 210, 255)); // Clear bitmap first FMovingParts.Fill(BGRA(0, 0, 0, 0)); FMovingParts.Assign(img); img.Free; end; procedure TDTCustomAnalogClock.SwitchTimer; begin FTimer.Enabled := Enabled; end; procedure TDTCustomAnalogClock.Paint; begin inherited Paint; FBitmap.SetSize(Width, Height); FBitMap.Fill(BGRA(0, 0, 0, 0)); if FResized then begin DrawClockFace; DrawMovingParts; FResized := False; end; FBitmap.BlendImage(0, 0, FClockFace, boLinearBlend); FBitmap.BlendImage(0, 0, FMovingParts, boLinearBlend); FBitmap.Draw(Canvas, 0, 0, False); end; procedure TDTCustomAnalogClock.ResizeEvent(Sender: TObject); begin FResized := True; end; procedure TDTCustomAnalogClock.SetClockStyle(AValue: TClockStyle); begin if FClockStyle = AValue then Exit; FClockStyle := AValue; end; procedure TDTCustomAnalogClock.SetEnabled(AValue: boolean); begin if FEnabled = AValue then Exit; FEnabled := AValue; SwitchTimer; end; procedure TDTCustomAnalogClock.TimerEvent(Sender: TObject); begin DrawMovingParts; Refresh; end; {$IFDEF FPC} procedure Register; begin RegisterComponents('BGRA Controls', [TDTAnalogClock]); end; {$ENDIF} end.