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
11unit dtthemedgauge;
12
13{$mode objfpc}{$H+}
14
15interface
16
17uses
18  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DTAnalogCommon,
19  BGRABitmap, BGRABitmapTypes;
20
21type
22
23  { TDTCustomThemedGauge }
24
25  TDTCustomThemedGauge = class(TDTBaseAnalogDevice)
26  private
27    FPointerCapSettings: TDTPointerCapSettings;
28    FPointerSettings: TDTPointerSettings;
29    FScaleBitmap: TBGRABitmap;
30    FPointerBitmap: TBGRABitmap;
31    FPosition: integer;
32    procedure SetPointerCapSettings(AValue: TDTPointerCapSettings);
33    procedure SetPointerSettings(AValue: TDTPointerSettings);
34    procedure SetPosition(AValue: integer);
35    { Private declarations }
36  protected
37    { Protected declarations }
38    property PointerSettings: TDTPointerSettings read FPointerSettings write SetPointerSettings;
39    property PointerCapSettings: TDTPointerCapSettings read FPointerCapSettings write SetPointerCapSettings;
40    property Position: integer read FPosition write SetPosition;
41  public
42    { Public declarations }
43    constructor Create(AOwner: TComponent); override;
44    destructor Destroy; override;
45    procedure Paint; override;
46    procedure DrawScale;
47    procedure DrawPointer;
48  end;
49
50  { TDTThemedGauge }
51
52  TDTThemedGauge = class(TDTCustomThemedGauge)
53  private
54    { Private declarations }
55  protected
56    { Protected declarations }
57  public
58    { Public declarations }
59  published
60    { Published declarations }
61    property FaceSettings;
62    property ScaleSettings;
63    property PointerSettings;
64    property PointerCapSettings;
65    property Position;
66  end;
67
68procedure Register;
69
70implementation
71
72procedure Register;
73begin
74  //{$I icons\dtthemedgauge_icon.lrs}
75  RegisterComponents('BGRA Controls', [TDTThemedGauge]);
76end;
77
78{ TDTCustomThemedGauge }
79
80//procedure TDTCustomThemedGauge.SetNeedleSettings(AValue: TDTNeedleSettings);
81//begin
82//  if FNeedleSettings = AValue then
83//    Exit;
84//  FNeedleSettings := AValue;
85//
86//  DoChange(self);
87//end;
88//
89procedure TDTCustomThemedGauge.SetPointerCapSettings(AValue: TDTPointerCapSettings);
90begin
91  if FPointerCapSettings = AValue then
92    Exit;
93  FPointerCapSettings := AValue;
94
95  DoChange(self);
96end;
97
98procedure TDTCustomThemedGauge.SetPointerSettings(AValue: TDTPointerSettings);
99begin
100  if FPointerSettings = AValue then
101    Exit;
102  FPointerSettings := AValue;
103
104  DoChange(self);
105end;
106
107
108procedure TDTCustomThemedGauge.SetPosition(AValue: integer);
109begin
110  if FPosition = AValue then
111    Exit;
112  FPosition := AValue;
113
114  DoChange(self);
115end;
116
117constructor TDTCustomThemedGauge.Create(AOwner: TComponent);
118begin
119  inherited Create(AOwner);
120
121  FPointerSettings := TDTPointerSettings.Create;
122  FPointerSettings.OnChange := @DoChange;
123  FPointerSettings.Color := BGRA(255, 81, 81);
124
125  FPointerCapSettings := TDTPointerCapSettings.Create;
126  FPointerCapSettings.OnChange := @DoChange;
127
128  FScaleBitmap := TBGRABitmap.Create;
129  FPointerBitmap := TBGRABitmap.Create;
130
131end;
132
133destructor TDTCustomThemedGauge.Destroy;
134begin
135  FPointerCapSettings.OnChange:=nil;
136  FPointerCapSettings.Free;
137  FPointerSettings.OnChange:=nil;
138  FPointerSettings.Free;
139
140  FScaleBitmap.Free;
141  FPointerBitmap.Free;
142  inherited Destroy;
143end;
144
145procedure TDTCustomThemedGauge.Paint;
146begin
147  inherited Paint;
148  DrawScale;
149  DrawPointer;
150
151  FGaugeBitmap.BlendImage(0, 0, FScaleBitmap, boLinearBlend);
152  FGaugeBitmap.BlendImage(0, 0, FPointerBitmap, boLinearBlend);
153
154  FGaugeBitmap.Draw(Canvas, 0, 0, False);
155
156end;
157
158procedure TDTCustomThemedGauge.DrawScale;
159var
160  Origin: TDTOrigin;
161  r, i, n, x, y, xt, yt: integer;
162  j: single;
163begin
164
165  Origin := Initializebitmap(FScaleBitmap, Width, Height);
166
167  r := round(Origin.Radius * 0.85);
168
169  //j := (180 - ScaleSettings.Angle) / 2;
170  j := (180 - 270) / 2;
171
172  // Draw SubTicks
173  if ScaleSettings.EnableSubTicks then
174  begin
175
176    n := ScaleSettings.MainTickCount * ScaleSettings.SubTickCount;
177
178    for i := 0 to n do
179    begin
180      // Calculate draw from point
181      X := Origin.CenterPoint.x - Round(r * cos((j + i * 270 / n) * Pi / 180));
182      Y := Origin.CenterPoint.y - Round(r * sin((j + i * 270 / n) * Pi / 180));
183
184      // Calculate draw to point
185      Xt := Origin.CenterPoint.x - Round((r - ScaleSettings.LengthSubTick) * cos((j + i * 270 / n) * Pi / 180));
186      Yt := Origin.CenterPoint.y - Round((r - ScaleSettings.LengthSubTick) * sin((j + i * 270 / n) * Pi / 180));
187
188      FScaleBitmap.DrawLineAntialias(x, y, xt, yt, ScaleSettings.TickColor, ScaleSettings.ThicknessSubTick);
189
190    end;
191  end;
192
193  if ScaleSettings.EnableMainTicks then
194  begin
195
196    FScaleBitmap.FontName := ScaleSettings.TextFont;
197    FScaleBitmap.FontHeight := ScaleSettings.TextSize;
198    FScaleBitmap.FontQuality := fqFineAntialiasing;
199
200    n := ScaleSettings.MainTickCount;
201
202    for i := 0 to n do
203    begin
204      // Draw main ticks
205      // Calculate draw from point
206      X := Origin.CenterPoint.x - Round(r * cos((j + i * 270 / n) * Pi / 180));
207      Y := Origin.CenterPoint.y - Round(r * sin((j + i * 270 / n) * Pi / 180));
208
209      // Calculate draw to point
210      Xt := Origin.CenterPoint.x - Round((r - ScaleSettings.LengthMainTick) * cos((j + i * 270 / n) * Pi / 180));
211      Yt := Origin.CenterPoint.y - Round((r - ScaleSettings.LengthMainTick) * sin((j + i * 270 / n) * Pi / 180));
212
213      FScaleBitmap.DrawLineAntialias(x, y, xt, yt, ScaleSettings.TickColor, ScaleSettings.ThicknessMainTick);
214
215      if ScaleSettings.EnableScaleText then
216      begin
217        // Draw text for main ticks
218        Xt := Origin.CenterPoint.x - Round(ScaleSettings.TextRadius * cos((j + i * 270 / n) * Pi / 180));
219        Yt := Origin.CenterPoint.y - Round(ScaleSettings.TextRadius * sin((j + i * 270 / n) * Pi / 180));
220
221        FScaleBitmap.TextOut(Xt, Yt - (FScaleBitmap.FontHeight / 1.7), IntToStr(i * ScaleSettings.Maximum div ScaleSettings.MainTickCount), ScaleSettings.TextColor, taCenter);
222      end;
223    end;
224  end;
225end;
226
227procedure TDTCustomThemedGauge.DrawPointer;
228var
229  Origin: TDTOrigin;
230  {%H-}r, x, y: integer;
231  j: single;
232begin
233
234  Origin := Initializebitmap(FPointerBitmap, Width, Height);
235
236  r := round(Origin.Radius * 0.85);
237
238  j := (180 - 270) / 2;
239
240  X := origin.CenterPoint.x - Round(PointerSettings.Length * cos((j + Position * 270 / ScaleSettings.Maximum) * Pi / 180));
241  Y := origin.CenterPoint.y - Round(PointerSettings.Length * sin((j + Position * 270 / ScaleSettings.Maximum) * Pi / 180));
242
243  FPointerBitmap.DrawLineAntialias(origin.CenterPoint.y, origin.CenterPoint.y, x, y, PointerSettings.Color, PointerSettings.Thickness);
244
245  // Draw cap over needle
246  FPointerBitmap.EllipseAntialias(origin.CenterPoint.x, origin.CenterPoint.y, PointerCapSettings.Radius, PointerCapSettings.Radius, PointerCapSettings.EdgeColor, 2, ColorToBGRA(PointerCapSettings.FillColor));
247end;
248
249end.
250