325 lines
9.9 KiB
ObjectPascal
325 lines
9.9 KiB
ObjectPascal
// 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 dtthemedclock;
|
|
|
|
{$I bgracontrols.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, ExtCtrls, {$IFDEF FPC}LResources,{$ENDIF} Forms, Controls, Graphics, Dialogs, DTAnalogCommon,
|
|
{$IFNDEF FPC}Types, BGRAGraphics, GraphType, FPImage, {$ENDIF}
|
|
BGRABitmap, BGRABitmapTypes;
|
|
|
|
type
|
|
|
|
{ TDTCustomThemedClock }
|
|
|
|
TDTCustomThemedClock = class(TDTBaseAnalogDevice)
|
|
private
|
|
FClockFace: TBGRABitmap;
|
|
FPointerBitmap: TBGRABitmap;
|
|
FEnabled: boolean;
|
|
FHoursPointerSettings: TDTPointerSettings;
|
|
FMinutesPointerSettings: TDTPointerSettings;
|
|
FPointerCapSettings: TDTPointerCapSettings;
|
|
FPosition: integer;
|
|
FSecondsPointerSettings: TDTPointerSettings;
|
|
FTimer: TTimer;
|
|
procedure SetHoursPointerSettings(AValue: TDTPointerSettings);
|
|
procedure SetMinutesPointerSettings(AValue: TDTPointerSettings);
|
|
procedure SetPointerCapSettings(AValue: TDTPointerCapSettings);
|
|
procedure SetPosition(AValue: integer);
|
|
procedure SetSecondsPointerSettings(AValue: TDTPointerSettings);
|
|
{ Private declarations }
|
|
protected
|
|
procedure SetEnabled(AValue: boolean); override;
|
|
{ Protected declarations }
|
|
property SecondsPointerSettings: TDTPointerSettings read FSecondsPointerSettings write SetSecondsPointerSettings;
|
|
property MinutesPointerSettings: TDTPointerSettings read FMinutesPointerSettings write SetMinutesPointerSettings;
|
|
property HoursPointerSettings: TDTPointerSettings read FHoursPointerSettings write SetHoursPointerSettings;
|
|
property PointerCapSettings: TDTPointerCapSettings read FPointerCapSettings write SetPointerCapSettings;
|
|
property Position: integer read FPosition write SetPosition;
|
|
property Enabled: boolean read FEnabled write SetEnabled;
|
|
procedure TimerEvent({%H-}Sender: TObject);
|
|
public
|
|
{ Public declarations }
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Paint; override;
|
|
procedure DrawClock;
|
|
procedure DrawPointers;
|
|
end;
|
|
|
|
TDTThemedClock = class(TDTCustomThemedClock)
|
|
private
|
|
{ Private declarations }
|
|
protected
|
|
{ Protected declarations }
|
|
public
|
|
{ Public declarations }
|
|
published
|
|
{ Public declarations }
|
|
property SecondsPointerSettings;
|
|
property MinutesPointerSettings;
|
|
property HoursPointerSettings;
|
|
property PointerCapSettings;
|
|
property ScaleSettings;
|
|
property Position;
|
|
property Enabled;
|
|
end;
|
|
|
|
{$IFDEF FPC}procedure Register;{$ENDIF}
|
|
|
|
implementation
|
|
|
|
{$IFDEF FPC}
|
|
procedure Register;
|
|
begin
|
|
RegisterComponents('BGRA Controls', [TDTThemedClock]);
|
|
end;
|
|
{$ENDIF}
|
|
|
|
{ TDTCustomThemedClock }
|
|
|
|
procedure TDTCustomThemedClock.SetPointerCapSettings(AValue: TDTPointerCapSettings);
|
|
begin
|
|
if FPointerCapSettings = AValue then
|
|
Exit;
|
|
FPointerCapSettings := AValue;
|
|
|
|
DoChange(self);
|
|
end;
|
|
|
|
procedure TDTCustomThemedClock.SetHoursPointerSettings(AValue: TDTPointerSettings);
|
|
begin
|
|
if FHoursPointerSettings = AValue then
|
|
Exit;
|
|
FHoursPointerSettings := AValue;
|
|
|
|
DoChange(self);
|
|
end;
|
|
|
|
procedure TDTCustomThemedClock.SetEnabled(AValue: boolean);
|
|
begin
|
|
if FEnabled = AValue then
|
|
Exit;
|
|
FEnabled := AValue;
|
|
|
|
FTimer.Enabled := FEnabled;
|
|
|
|
DoChange(self);
|
|
end;
|
|
|
|
procedure TDTCustomThemedClock.SetMinutesPointerSettings(AValue: TDTPointerSettings);
|
|
begin
|
|
if FMinutesPointerSettings = AValue then
|
|
Exit;
|
|
FMinutesPointerSettings := AValue;
|
|
|
|
DoChange(self);
|
|
end;
|
|
|
|
procedure TDTCustomThemedClock.SetPosition(AValue: integer);
|
|
begin
|
|
if FPosition = AValue then
|
|
Exit;
|
|
FPosition := AValue;
|
|
|
|
DoChange(self);
|
|
end;
|
|
|
|
procedure TDTCustomThemedClock.SetSecondsPointerSettings(AValue: TDTPointerSettings);
|
|
begin
|
|
if FSecondsPointerSettings = AValue then
|
|
Exit;
|
|
FSecondsPointerSettings := AValue;
|
|
|
|
DoChange(self);
|
|
end;
|
|
|
|
procedure TDTCustomThemedClock.TimerEvent(Sender: TObject);
|
|
begin
|
|
DrawPointers;
|
|
DoChange(self);
|
|
end;
|
|
|
|
constructor TDTCustomThemedClock.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
FSecondsPointerSettings := TDTPointerSettings.Create;
|
|
FSecondsPointerSettings.OnChange := DoChange;
|
|
FMinutesPointerSettings := TDTPointerSettings.Create;
|
|
FMinutesPointerSettings.OnChange := DoChange;
|
|
FHoursPointerSettings := TDTPointerSettings.Create;
|
|
FHoursPointerSettings.OnChange := DoChange;
|
|
|
|
FPointerCapSettings := TDTPointerCapSettings.Create;
|
|
FPointerCapSettings.OnChange := DoChange;
|
|
|
|
FClockFace := TBGRABitmap.Create;
|
|
FPointerBitmap := TBGRABitmap.Create;
|
|
|
|
FSecondsPointerSettings.Color := BGRA(255, 81, 81);
|
|
FSecondsPointerSettings.Length := 80;
|
|
FSecondsPointerSettings.Thickness := 3;
|
|
|
|
FMinutesPointerSettings.Color := BGRA(199, 199, 173);
|
|
FMinutesPointerSettings.Length := 80;
|
|
FMinutesPointerSettings.Thickness := 3;
|
|
|
|
FHoursPointerSettings.Color := BGRA(199, 199, 173);
|
|
FHoursPointerSettings.Length := 60;
|
|
FHoursPointerSettings.Thickness := 5;
|
|
|
|
FTimer := TTimer.Create(Self);
|
|
FTimer.Interval := 1000;
|
|
FTimer.Enabled := FEnabled;
|
|
FTimer.OnTimer := TimerEvent;
|
|
|
|
end;
|
|
|
|
destructor TDTCustomThemedClock.Destroy;
|
|
begin
|
|
FSecondsPointerSettings.OnChange:=nil;
|
|
FSecondsPointerSettings.Free;
|
|
FMinutesPointerSettings.OnChange:=nil;
|
|
FMinutesPointerSettings.Free;
|
|
FHoursPointerSettings.OnChange:=nil;
|
|
FHoursPointerSettings.Free;
|
|
FTimer.Enabled:=False;
|
|
FTimer.OnTimer:=nil;
|
|
FPointerCapSettings.OnChange:=nil;
|
|
FPointerCapSettings.Free;
|
|
|
|
FClockFace.Free;
|
|
FPointerBitmap.Free;
|
|
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TDTCustomThemedClock.Paint;
|
|
begin
|
|
inherited Paint;
|
|
|
|
DrawClock;
|
|
DrawPointers;
|
|
|
|
FGaugeBitmap.BlendImage(0, 0, FClockFace, boLinearBlend);
|
|
FGaugeBitmap.BlendImage(0, 0, FPointerBitmap, boLinearBlend);
|
|
|
|
FGaugeBitmap.Draw(Canvas, 0, 0, False);
|
|
end;
|
|
|
|
procedure TDTCustomThemedClock.DrawClock;
|
|
var
|
|
Origin: TDTOrigin;
|
|
r, i, x, y, xt, yt: integer;
|
|
begin
|
|
|
|
Origin := Initializebitmap(FClockFace, Width, Height);
|
|
|
|
r := round(Origin.Radius * 0.85);
|
|
|
|
// Draw minor tick marks
|
|
if ScaleSettings.EnableSubTicks then
|
|
begin
|
|
for i := 1 to 60 do
|
|
begin
|
|
// Calculate draw from point
|
|
X := Origin.CenterPoint.x + Round(r * sin(6 * i * Pi / 180));
|
|
Y := Origin.CenterPoint.y - Round(r * cos(6 * i * Pi / 180));
|
|
|
|
// Calculate draw to point
|
|
xt := Origin.CenterPoint.x + Round((r - ScaleSettings.LengthSubTick) * sin(6 * i * Pi / 180));
|
|
yt := Origin.CenterPoint.y - Round((r - ScaleSettings.LengthSubTick) * cos(6 * i * Pi / 180));
|
|
|
|
FClockFace.DrawLineAntialias(x, y, xt, yt, ScaleSettings.TickColor, ScaleSettings.ThicknessSubTick);
|
|
end;
|
|
end;
|
|
|
|
// Draw major tick marks
|
|
if ScaleSettings.EnableMainTicks then
|
|
begin
|
|
for i := 1 to 12 do
|
|
begin
|
|
// Calculate draw from point
|
|
X := Origin.CenterPoint.x + Round(r * sin(30 * i * Pi / 180));
|
|
Y := Origin.CenterPoint.y - Round(r * cos(30 * i * Pi / 180));
|
|
|
|
// Calculate draw to point
|
|
xt := Origin.CenterPoint.x + Round((r - ScaleSettings.LengthMainTick) * sin(30 * i * Pi / 180));
|
|
yt := Origin.CenterPoint.y - Round((r - ScaleSettings.LengthMainTick) * cos(30 * i * Pi / 180));
|
|
|
|
FClockFace.DrawLineAntialias(x, y, xt, yt, ScaleSettings.TickColor, ScaleSettings.ThicknessMainTick);
|
|
|
|
if ScaleSettings.EnableScaleText then
|
|
begin
|
|
FClockFace.FontName := ScaleSettings.TextFont;
|
|
FClockFace.FontHeight := ScaleSettings.TextSize;
|
|
FClockFace.FontQuality := fqFineAntialiasing;
|
|
|
|
// Draw text for main ticks
|
|
xt := Origin.CenterPoint.x + Round(ScaleSettings.TextRadius * sin(30 * i * Pi / 180));
|
|
yt := Origin.CenterPoint.y - Round(ScaleSettings.TextRadius * cos(30 * i * Pi / 180));
|
|
|
|
FClockFace.TextOut(Xt, Yt - (FClockFace.FontHeight / 1.7), IntToStr(i), ScaleSettings.TextColor, taCenter);
|
|
end;
|
|
|
|
end;
|
|
end;
|
|
|
|
end;
|
|
|
|
procedure TDTCustomThemedClock.DrawPointers;
|
|
var
|
|
Origin: TDTOrigin;
|
|
{%H-}r: integer;
|
|
Xs, Ys, Xm, Ym, Xh, Yh: integer;
|
|
th, tm, ts, tn: word;
|
|
begin
|
|
|
|
Origin := Initializebitmap(FPointerBitmap, Width, Height);
|
|
|
|
r := round(Origin.Radius * 0.85);
|
|
|
|
//// Convert current time to integer values
|
|
decodetime(Time, th, tm, ts, tn);
|
|
|
|
//{ Set coordinates (length of arm) for seconds }
|
|
Xs := Origin.CenterPoint.x + Round(SecondsPointerSettings.Length * Sin(ts * 6 * Pi / 180));
|
|
Ys := Origin.CenterPoint.y - Round(SecondsPointerSettings.Length * Cos(ts * 6 * Pi / 180));
|
|
|
|
//{ Set coordinates (length of arm) for minutes }
|
|
Xm := Origin.CenterPoint.x + Round(MinutesPointerSettings.Length * Sin(tm * 6 * Pi / 180));
|
|
Ym := Origin.CenterPoint.y - Round(MinutesPointerSettings.Length * Cos(tm * 6 * Pi / 180));
|
|
|
|
//{ Set coordinates (length of arm) for hours }
|
|
Xh := Origin.CenterPoint.x + Round(HoursPointerSettings.Length * Sin((th * 30 + tm / 2) * Pi / 180));
|
|
Yh := Origin.CenterPoint.y - Round(HoursPointerSettings.Length * Cos((th * 30 + tm / 2) * Pi / 180));
|
|
|
|
FPointerBitmap.DrawLineAntialias(Origin.CenterPoint.x, Origin.CenterPoint.y, xs, ys, SecondsPointerSettings.Color, SecondsPointerSettings.Thickness);
|
|
FPointerBitmap.DrawLineAntialias(Origin.CenterPoint.x, Origin.CenterPoint.y, xm, ym, MinutesPointerSettings.Color, MinutesPointerSettings.Thickness);
|
|
FPointerBitmap.DrawLineAntialias(Origin.CenterPoint.x, Origin.CenterPoint.y, xh, yh, HoursPointerSettings.Color, HoursPointerSettings.Thickness);
|
|
|
|
// Draw cap over needle
|
|
FPointerBitmap.EllipseAntialias(origin.CenterPoint.x, origin.CenterPoint.y, PointerCapSettings.Radius, PointerCapSettings.Radius, PointerCapSettings.EdgeColor, 2, ColorToBGRA(PointerCapSettings.FillColor));
|
|
|
|
|
|
end;
|
|
|
|
end.
|