dtanalogcommon.pp 22 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873
  1. // SPDX-License-Identifier: LGPL-3.0-linking-exception
  2. {
  3. Part of BGRA Controls. Made by third party.
  4. For detailed information see readme.txt
  5. Site: https://sourceforge.net/p/bgra-controls/
  6. Wiki: http://wiki.lazarus.freepascal.org/BGRAControls
  7. Forum: http://forum.lazarus.freepascal.org/index.php/board,46.0.html
  8. }
  9. unit DTAnalogCommon;
  10. {$mode objfpc}{$H+}
  11. interface
  12. uses
  13. Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs,
  14. BGRABitmap, BGRABitmapTypes;
  15. type
  16. TDTFillStyle = (fsnone, fsGradient{, fsTexture});
  17. TDTNeedleStyle = (nsLine, nsTriangle{, nsLineExt, nsTriangleExt});
  18. { TDTOrigin }
  19. TDTOrigin = packed record
  20. CenterPoint: TPoint;
  21. Radius: integer;
  22. end;
  23. { TDTPointerCapSettings }
  24. TDTPointerCapSettings = class(TPersistent)
  25. private
  26. FEdgeColor: TColor;
  27. FEdgeThickness: integer;
  28. FFillColor: TColor;
  29. FOnChange: TNotifyEvent;
  30. FRadius: integer;
  31. procedure SetEdgeColor(AValue: TColor);
  32. procedure SetEdgeThickness(AValue: integer);
  33. procedure SetFillColor(AValue: TColor);
  34. procedure SetOnChange(AValue: TNotifyEvent);
  35. procedure SetRadius(AValue: integer);
  36. protected
  37. public
  38. constructor Create;
  39. destructor Destroy; override;
  40. property OnChange: TNotifyEvent read FOnChange write SetOnChange;
  41. published
  42. property EdgeColor: TColor read FEdgeColor write SetEdgeColor;
  43. property FillColor: TColor read FFillColor write SetFillColor;
  44. property Radius: integer read FRadius write SetRadius;
  45. property EdgeThickness: integer read FEdgeThickness write SetEdgeThickness;
  46. end;
  47. { TDTPointerSettings }
  48. TDTPointerSettings = class(TPersistent)
  49. private
  50. FColor: TColor;
  51. FLength: integer;
  52. FOnChange: TNotifyEvent;
  53. FThickness: integer;
  54. procedure SetColor(AValue: TColor);
  55. procedure SetLength(AValue: integer);
  56. procedure SetOnChange(AValue: TNotifyEvent);
  57. procedure SetThickness(AValue: integer);
  58. protected
  59. public
  60. constructor Create;
  61. destructor Destroy; override;
  62. property OnChange: TNotifyEvent read FOnChange write SetOnChange;
  63. published
  64. property Color: TColor read FColor write SetColor;
  65. property Length: integer read FLength write SetLength;
  66. property Thickness: integer read FThickness write SetThickness;
  67. end;
  68. { TDTNeedleSettings }
  69. TDTNeedleSettings = class(TPersistent)
  70. private
  71. FCapColor: TColor;
  72. FCapEdgeColor: TColor;
  73. FCapRadius: integer;
  74. FNeedleColor: TColor;
  75. FNeedleLength: integer;
  76. FNeedleStyle: TDTNeedleStyle;
  77. FOnChange: TNotifyEvent;
  78. procedure SetCapColor(AValue: TColor);
  79. procedure SetCapEdgeColor(AValue: TColor);
  80. procedure SetCapRadius(AValue: integer);
  81. procedure SetNeedleColor(AValue: TColor);
  82. procedure SetNeedleLength(AValue: integer);
  83. procedure SetNeedleStyle(AValue: TDTNeedleStyle);
  84. procedure SetOnChange(AValue: TNotifyEvent);
  85. protected
  86. public
  87. constructor Create;
  88. destructor Destroy; override;
  89. property OnChange: TNotifyEvent read FOnChange write SetOnChange;
  90. property NeedleStyle: TDTNeedleStyle read FNeedleStyle write SetNeedleStyle;
  91. published
  92. property NeedleColor: TColor read FNeedleColor write SetNeedleColor;
  93. property NeedleLength: integer read FNeedleLength write SetNeedleLength;
  94. property CapRadius: integer read FCapRadius write SetCapRadius;
  95. property CapColor: TColor read FCapColor write SetCapColor;
  96. property CapEdgeColor: TColor read FCapEdgeColor write SetCapEdgeColor;
  97. end;
  98. { TDTScaleSettings }
  99. TDTScaleSettings = class(TPersistent)
  100. private
  101. FEnableScaleText: boolean;
  102. FMaximum: integer;
  103. FTesting: boolean;
  104. FTextFont: string;
  105. FTextRadius: integer;
  106. FTextSize: integer;
  107. FTickColor: TColor;
  108. FEnableMainTicks: boolean;
  109. FEnableRangeIndicator: boolean;
  110. FEnableSubTicks: boolean;
  111. FLengthMainTick: integer;
  112. FLengthSubTick: integer;
  113. FMainTickCount: integer;
  114. FMinimum: integer;
  115. FOnChange: TNotifyEvent;
  116. FSubTickCount: integer;
  117. FTextColor: TColor;
  118. FThicknessMainTick: integer;
  119. FThicknessSubTick: integer;
  120. FAngle: integer;
  121. procedure SetEnableScaleText(AValue: boolean);
  122. procedure SetFAngle(AValue: integer);
  123. procedure SetMaximum(AValue: integer);
  124. procedure SetTesting(AValue: boolean);
  125. procedure SetTextFont(AValue: string);
  126. procedure SetTextRadius(AValue: integer);
  127. procedure SetTextSize(AValue: integer);
  128. procedure SetTickColor(AValue: TColor);
  129. procedure SetEnableMainTicks(AValue: boolean);
  130. procedure SetEnableRangeIndicator(AValue: boolean);
  131. procedure SetEnableSubTicks(AValue: boolean);
  132. procedure SetLengthMainTick(AValue: integer);
  133. procedure SetLengthSubTick(AValue: integer);
  134. procedure SetMainTickCount(AValue: integer);
  135. procedure SetOnChange(AValue: TNotifyEvent);
  136. procedure SetSubTickCount(AValue: integer);
  137. procedure SetTextColor(AValue: TColor);
  138. procedure SetThicknessMainTick(AValue: integer);
  139. procedure SetThicknessSubTick(AValue: integer);
  140. protected
  141. property Testing: boolean read FTesting write SetTesting;
  142. public
  143. constructor Create;
  144. destructor Destroy; override;
  145. property OnChange: TNotifyEvent read FOnChange write SetOnChange;
  146. published
  147. property TickColor: TColor read FTickColor write SetTickColor;
  148. property TextColor: TColor read FTextColor write SetTextColor;
  149. property TextSize: integer read FTextSize write SetTextSize;
  150. property TextFont: string read FTextFont write SetTextFont;
  151. property EnableMainTicks: boolean read FEnableMainTicks write SetEnableMainTicks;
  152. property EnableSubTicks: boolean read FEnableSubTicks write SetEnableSubTicks;
  153. property EnableScaleText: boolean read FEnableScaleText write SetEnableScaleText;
  154. property Maximum: integer read FMaximum write SetMaximum;
  155. property MainTickCount: integer read FMainTickCount write SetMainTickCount;
  156. property SubTickCount: integer read FSubTickCount write SetSubTickCount;
  157. property LengthMainTick: integer read FLengthMainTick write SetLengthMainTick;
  158. property LengthSubTick: integer read FLengthSubTick write SetLengthSubTick;
  159. property ThicknessMainTick: integer read FThicknessMainTick write SetThicknessMainTick;
  160. property ThicknessSubTick: integer read FThicknessSubTick write SetThicknessSubTick;
  161. property TextRadius: integer read FTextRadius write SetTextRadius;
  162. property Angle: integer read FAngle write SetFAngle;
  163. property EnableRangeIndicator: boolean read FEnableRangeIndicator write SetEnableRangeIndicator;
  164. //property RangeMinValue: integer read FRangeMinValue write SetRangeMinValue;
  165. //property RangeMidValue: integer read FRangeMidValue write SetRangeMidValue;
  166. //property RangeMaxValue: integer read FRangeMaxValue write SetRangeMaxValue;
  167. //property RangeMinColor: TColor read FRangeMinColor write SetRangeMinColor;
  168. //property RangeMidColor: TColor read FRangeMidColor write SetRangeMidColor;
  169. //property RangeMaxColor: TColor read FRangeMaxColor write SetRangeMaxColor;
  170. end;
  171. { TDTFaceSettings }
  172. TDTFaceSettings = class(TPersistent)
  173. private
  174. FColorEnd: TColor;
  175. FColorFrame: TColor;
  176. FColorStart: TColor;
  177. FFillStyle: TDTFillStyle;
  178. FOnChange: TNotifyEvent;
  179. procedure SetColorEnd(AValue: TColor);
  180. procedure SetColorFrame(AValue: TColor);
  181. procedure SetColorStart(AValue: TColor);
  182. procedure SetFillStyle(AValue: TDTFillStyle);
  183. procedure SetOnChange(AValue: TNotifyEvent);
  184. protected
  185. public
  186. constructor Create;
  187. destructor Destroy; override;
  188. property OnChange: TNotifyEvent read FOnChange write SetOnChange;
  189. published
  190. property FillStyle: TDTFillStyle read FFillStyle write SetFillStyle;
  191. property ColorFrame: TColor read FColorFrame write SetColorFrame;
  192. property ColorStart: TColor read FColorStart write SetColorStart;
  193. property ColorEnd: TColor read FColorEnd write SetColorEnd;
  194. end;
  195. { TDTBaseAnalogDevice }
  196. TDTBaseAnalogDevice = class(TGraphicControl)
  197. private
  198. FFaceSettings: TDTFaceSettings;
  199. FScaleSettings: TDTScaleSettings;
  200. procedure SetFaceSettings(AValue: TDTFaceSettings);
  201. procedure SetScaleSettings(AValue: TDTScaleSettings);
  202. protected
  203. procedure DoChange({%H-}Sender: TObject);
  204. public
  205. fGaugeBitmap: TBGRABitmap;
  206. FFrameBitmap: TBGRABitmap;
  207. FFaceBitmap: TBGRABitmap;
  208. constructor Create(AOwner: TComponent); override;
  209. destructor Destroy; override;
  210. property FaceSettings: TDTFaceSettings read FFaceSettings write SetFaceSettings;
  211. property ScaleSettings: TDTScaleSettings read FScaleSettings write SetScaleSettings;
  212. procedure Paint; override;
  213. procedure DrawGauge;
  214. procedure DrawFrame;
  215. procedure DrawFace;
  216. end;
  217. function Initializebitmap(var Bitmap: TBGRABitmap; Width, Height: integer): TDTOrigin;
  218. implementation
  219. function Initializebitmap(var Bitmap: TBGRABitmap; Width, Height: integer): TDTOrigin;
  220. begin
  221. Bitmap.SetSize(Width, Height);
  222. // Clear bitmap to transparent
  223. BitMap.Fill(BGRA(0, 0, 0, 0));
  224. // Get origin information
  225. Result.CenterPoint.x := Width div 2;
  226. Result.CenterPoint.y := Height div 2;
  227. Result.Radius := Result.CenterPoint.y;
  228. if Result.CenterPoint.x > Result.CenterPoint.y then
  229. Result.Radius := Result.CenterPoint.y;
  230. if Result.CenterPoint.x < Result.CenterPoint.y then
  231. Result.Radius := Result.CenterPoint.x;
  232. end;
  233. { TDTPointerCapSettings }
  234. procedure TDTPointerCapSettings.SetEdgeColor(AValue: TColor);
  235. begin
  236. if FEdgeColor = AValue then
  237. Exit;
  238. FEdgeColor := AValue;
  239. if Assigned(FOnChange) then
  240. FOnChange(Self);
  241. end;
  242. procedure TDTPointerCapSettings.SetEdgeThickness(AValue: integer);
  243. begin
  244. if FEdgeThickness = AValue then
  245. Exit;
  246. FEdgeThickness := AValue;
  247. if Assigned(FOnChange) then
  248. FOnChange(Self);
  249. end;
  250. procedure TDTPointerCapSettings.SetFillColor(AValue: TColor);
  251. begin
  252. if FFillColor = AValue then
  253. Exit;
  254. FFillColor := AValue;
  255. if Assigned(FOnChange) then
  256. FOnChange(Self);
  257. end;
  258. procedure TDTPointerCapSettings.SetOnChange(AValue: TNotifyEvent);
  259. begin
  260. if FOnChange = AValue then
  261. Exit;
  262. FOnChange := AValue;
  263. if Assigned(FOnChange) then
  264. FOnChange(Self);
  265. end;
  266. procedure TDTPointerCapSettings.SetRadius(AValue: integer);
  267. begin
  268. if FRadius = AValue then
  269. Exit;
  270. FRadius := AValue;
  271. if Assigned(FOnChange) then
  272. FOnChange(Self);
  273. end;
  274. constructor TDTPointerCapSettings.Create;
  275. begin
  276. FEdgeColor := $00CCDCDC;
  277. FFillColor := $003F3F3F;
  278. FRadius := 10;
  279. FEdgeThickness := 1;
  280. end;
  281. destructor TDTPointerCapSettings.Destroy;
  282. begin
  283. inherited Destroy;
  284. end;
  285. { TDTPointerSettings }
  286. procedure TDTPointerSettings.SetColor(AValue: TColor);
  287. begin
  288. if FColor = AValue then
  289. Exit;
  290. FColor := AValue;
  291. if Assigned(FOnChange) then
  292. FOnChange(Self);
  293. end;
  294. procedure TDTPointerSettings.SetLength(AValue: integer);
  295. begin
  296. if FLength = AValue then
  297. Exit;
  298. FLength := AValue;
  299. if Assigned(FOnChange) then
  300. FOnChange(Self);
  301. end;
  302. procedure TDTPointerSettings.SetOnChange(AValue: TNotifyEvent);
  303. begin
  304. if FOnChange = AValue then
  305. Exit;
  306. FOnChange := AValue;
  307. if Assigned(FOnChange) then
  308. FOnChange(Self);
  309. end;
  310. procedure TDTPointerSettings.SetThickness(AValue: integer);
  311. begin
  312. if FThickness = AValue then
  313. Exit;
  314. FThickness := AValue;
  315. if Assigned(FOnChange) then
  316. FOnChange(Self);
  317. end;
  318. constructor TDTPointerSettings.Create;
  319. begin
  320. FColor := BGRA(199, 199, 173);
  321. FLength := 100;
  322. FThickness := 3;
  323. end;
  324. destructor TDTPointerSettings.Destroy;
  325. begin
  326. inherited Destroy;
  327. end;
  328. { TDTBaseAnalogDevice }
  329. procedure TDTBaseAnalogDevice.SetFaceSettings(AValue: TDTFaceSettings);
  330. begin
  331. if FFaceSettings = AValue then
  332. Exit;
  333. FFaceSettings := AValue;
  334. DoChange(self);
  335. end;
  336. procedure TDTBaseAnalogDevice.SetScaleSettings(AValue: TDTScaleSettings);
  337. begin
  338. if FScaleSettings = AValue then
  339. Exit;
  340. FScaleSettings := AValue;
  341. DoChange(self);
  342. end;
  343. procedure TDTBaseAnalogDevice.DoChange(Sender: TObject);
  344. begin
  345. Invalidate;
  346. end;
  347. constructor TDTBaseAnalogDevice.Create(AOwner: TComponent);
  348. begin
  349. inherited Create(AOwner);
  350. Width := 240;
  351. Height := 240;
  352. FScaleSettings := TDTScaleSettings.Create;
  353. ScaleSettings.OnChange := @DoChange;
  354. ScaleSettings.TextRadius := round((Width * 0.6) / 2);
  355. FFaceSettings := TDTFaceSettings.Create;
  356. FaceSettings.OnChange := @DoChange;
  357. FGaugeBitmap := TBGRABitmap.Create;
  358. FFaceBitmap := TBGRABitmap.Create;
  359. FFrameBitmap := TBGRABitmap.Create;
  360. end;
  361. destructor TDTBaseAnalogDevice.Destroy;
  362. begin
  363. FScaleSettings.Free;
  364. FFaceSettings.Free;
  365. fGaugeBitmap.Free;
  366. FFaceBitmap.Free;
  367. FFrameBitmap.Free;
  368. inherited Destroy;
  369. end;
  370. procedure TDTBaseAnalogDevice.Paint;
  371. begin
  372. inherited Paint;
  373. FGaugeBitmap.Fill(BGRA(0, 0, 0, 0));
  374. fGaugeBitmap.SetSize(Width, Height);
  375. DrawGauge;
  376. FGaugeBitmap.BlendImage(0, 0, FFrameBitmap, boLinearBlend);
  377. FGaugeBitmap.BlendImage(0, 0, FFaceBitmap, boLinearBlend);
  378. FGaugeBitmap.Draw(Canvas, 0, 0, False);
  379. end;
  380. procedure TDTBaseAnalogDevice.DrawGauge;
  381. begin
  382. DrawFrame;
  383. DrawFace;
  384. end;
  385. procedure TDTBaseAnalogDevice.DrawFrame;
  386. var
  387. Origin: TDTOrigin;
  388. r: integer;
  389. begin
  390. Origin := Initializebitmap(FFrameBitmap, Width, Height);
  391. r := round(Origin.Radius * 0.95);
  392. // Draw Bitmap frame
  393. FFrameBitmap.FillEllipseAntialias(Origin.CenterPoint.x,
  394. Origin.CenterPoint.y,
  395. r, r, FFaceSettings.ColorFrame);
  396. // Draw thin antialiased border to smooth against background
  397. FFrameBitmap.EllipseAntialias(Origin.CenterPoint.x,
  398. Origin.CenterPoint.y,
  399. r, r, ColorToBGRA(clBlack, 120), 1);
  400. end;
  401. procedure TDTBaseAnalogDevice.DrawFace;
  402. var
  403. Origin: TDTOrigin;
  404. r: integer;
  405. begin
  406. Origin := Initializebitmap(FFaceBitmap, Width, Height);
  407. r := round(Origin.Radius * 0.95) - 5;
  408. case FFaceSettings.FillStyle of
  409. fsGradient:
  410. FFaceBitmap.FillEllipseLinearColorAntialias(Origin.CenterPoint.x, Origin.CenterPoint.y, r, r, ColorToBGRA(FFaceSettings.ColorStart), ColorToBGRA(FFaceSettings.ColorEnd));
  411. fsnone:
  412. FFaceBitmap.FillEllipseAntialias(Origin.CenterPoint.x, Origin.CenterPoint.y, r, r, FFaceSettings.ColorStart);
  413. end;
  414. end;
  415. { TDTNeedleSettings }
  416. procedure TDTNeedleSettings.SetCapColor(AValue: TColor);
  417. begin
  418. if FCapColor = AValue then
  419. Exit;
  420. FCapColor := AValue;
  421. if Assigned(FOnChange) then
  422. FOnChange(Self);
  423. end;
  424. procedure TDTNeedleSettings.SetCapEdgeColor(AValue: TColor);
  425. begin
  426. if FCapEdgeColor = AValue then
  427. Exit;
  428. FCapEdgeColor := AValue;
  429. if Assigned(FOnChange) then
  430. FOnChange(Self);
  431. end;
  432. procedure TDTNeedleSettings.SetCapRadius(AValue: integer);
  433. begin
  434. if FCapRadius = AValue then
  435. Exit;
  436. FCapRadius := AValue;
  437. if Assigned(FOnChange) then
  438. FOnChange(Self);
  439. end;
  440. procedure TDTNeedleSettings.SetNeedleColor(AValue: TColor);
  441. begin
  442. if FNeedleColor = AValue then
  443. Exit;
  444. FNeedleColor := AValue;
  445. if Assigned(FOnChange) then
  446. FOnChange(Self);
  447. end;
  448. procedure TDTNeedleSettings.SetNeedleLength(AValue: integer);
  449. begin
  450. if FNeedleLength = AValue then
  451. Exit;
  452. FNeedleLength := AValue;
  453. if Assigned(FOnChange) then
  454. FOnChange(Self);
  455. end;
  456. procedure TDTNeedleSettings.SetNeedleStyle(AValue: TDTNeedleStyle);
  457. begin
  458. if FNeedleStyle = AValue then
  459. Exit;
  460. FNeedleStyle := AValue;
  461. if Assigned(FOnChange) then
  462. FOnChange(Self);
  463. end;
  464. procedure TDTNeedleSettings.SetOnChange(AValue: TNotifyEvent);
  465. begin
  466. if FOnChange = AValue then
  467. Exit;
  468. FOnChange := AValue;
  469. if Assigned(FOnChange) then
  470. FOnChange(Self);
  471. end;
  472. constructor TDTNeedleSettings.Create;
  473. begin
  474. FCapColor := BGRA(63, 63, 63);
  475. FCapEdgeColor := BGRA(220, 220, 204);
  476. FCapRadius := 10;
  477. FNeedleStyle := nsLine;
  478. FNeedleColor := BGRA(255, 81, 81);
  479. FNeedleLength := 100;
  480. end;
  481. destructor TDTNeedleSettings.Destroy;
  482. begin
  483. inherited Destroy;
  484. end;
  485. { TDTScaleSettings }
  486. constructor TDTScaleSettings.Create;
  487. begin
  488. FTickColor := bgra(223, 196, 125);
  489. FTextColor := bgra(140, 208, 211);
  490. FTextFont := 'Calibri';
  491. FTextSize := 15;
  492. FEnableMainTicks := True;
  493. FEnableSubTicks := True;
  494. FEnableScaleText := True;
  495. FMainTickCount := 10;
  496. FSubTickCount := 5;
  497. FMaximum := 100;
  498. FMinimum := 0;
  499. FLengthMainTick := 15;
  500. FLengthSubTick := 8;
  501. FThicknessMainTick := 3;
  502. FThicknessSubTick := 1;
  503. FAngle := 300;
  504. FEnableRangeIndicator := True;
  505. end;
  506. destructor TDTScaleSettings.Destroy;
  507. begin
  508. inherited Destroy;
  509. end;
  510. procedure TDTScaleSettings.SetTextFont(AValue: string);
  511. begin
  512. if FTextFont = AValue then
  513. Exit;
  514. FTextFont := AValue;
  515. if Assigned(FOnChange) then
  516. FOnChange(Self);
  517. end;
  518. procedure TDTScaleSettings.SetEnableScaleText(AValue: boolean);
  519. begin
  520. if FEnableScaleText = AValue then
  521. Exit;
  522. FEnableScaleText := AValue;
  523. if Assigned(FOnChange) then
  524. FOnChange(Self);
  525. end;
  526. procedure TDTScaleSettings.SetFAngle(AValue: integer);
  527. begin
  528. if FAngle=AValue then Exit;
  529. FAngle:=AValue;
  530. end;
  531. procedure TDTScaleSettings.SetMaximum(AValue: integer);
  532. begin
  533. if FMaximum = AValue then
  534. Exit;
  535. FMaximum := AValue;
  536. if Assigned(FOnChange) then
  537. FOnChange(Self);
  538. end;
  539. procedure TDTScaleSettings.SetTesting(AValue: boolean);
  540. begin
  541. if FTesting = AValue then
  542. Exit;
  543. FTesting := AValue;
  544. if Assigned(FOnChange) then
  545. FOnChange(Self);
  546. end;
  547. procedure TDTScaleSettings.SetTextRadius(AValue: integer);
  548. begin
  549. if FTextRadius = AValue then
  550. Exit;
  551. FTextRadius := AValue;
  552. if Assigned(FOnChange) then
  553. FOnChange(Self);
  554. end;
  555. procedure TDTScaleSettings.SetTextSize(AValue: integer);
  556. begin
  557. if FTextSize = AValue then
  558. Exit;
  559. FTextSize := AValue;
  560. if Assigned(FOnChange) then
  561. FOnChange(Self);
  562. end;
  563. procedure TDTScaleSettings.SetTickColor(AValue: TColor);
  564. begin
  565. if FTickColor = AValue then
  566. Exit;
  567. FTickColor := AValue;
  568. if Assigned(FOnChange) then
  569. FOnChange(Self);
  570. end;
  571. procedure TDTScaleSettings.SetEnableMainTicks(AValue: boolean);
  572. begin
  573. if FEnableMainTicks = AValue then
  574. Exit;
  575. FEnableMainTicks := AValue;
  576. if Assigned(FOnChange) then
  577. FOnChange(Self);
  578. end;
  579. procedure TDTScaleSettings.SetEnableRangeIndicator(AValue: boolean);
  580. begin
  581. if FEnableRangeIndicator = AValue then
  582. Exit;
  583. FEnableRangeIndicator := AValue;
  584. if Assigned(FOnChange) then
  585. FOnChange(Self);
  586. end;
  587. procedure TDTScaleSettings.SetEnableSubTicks(AValue: boolean);
  588. begin
  589. if FEnableSubTicks = AValue then
  590. Exit;
  591. FEnableSubTicks := AValue;
  592. if Assigned(FOnChange) then
  593. FOnChange(Self);
  594. end;
  595. procedure TDTScaleSettings.SetLengthMainTick(AValue: integer);
  596. begin
  597. if FLengthMainTick = AValue then
  598. Exit;
  599. FLengthMainTick := AValue;
  600. if Assigned(FOnChange) then
  601. FOnChange(Self);
  602. end;
  603. procedure TDTScaleSettings.SetLengthSubTick(AValue: integer);
  604. begin
  605. if FLengthSubTick = AValue then
  606. Exit;
  607. FLengthSubTick := AValue;
  608. if Assigned(FOnChange) then
  609. FOnChange(Self);
  610. end;
  611. procedure TDTScaleSettings.SetMainTickCount(AValue: integer);
  612. begin
  613. if FMainTickCount = AValue then
  614. Exit;
  615. FMainTickCount := AValue;
  616. if Assigned(FOnChange) then
  617. FOnChange(Self);
  618. end;
  619. procedure TDTScaleSettings.SetOnChange(AValue: TNotifyEvent);
  620. begin
  621. if FOnChange = AValue then
  622. Exit;
  623. FOnChange := AValue;
  624. if Assigned(FOnChange) then
  625. FOnChange(Self);
  626. end;
  627. procedure TDTScaleSettings.SetSubTickCount(AValue: integer);
  628. begin
  629. if FSubTickCount = AValue then
  630. Exit;
  631. FSubTickCount := AValue;
  632. if Assigned(FOnChange) then
  633. FOnChange(Self);
  634. end;
  635. procedure TDTScaleSettings.SetTextColor(AValue: TColor);
  636. begin
  637. if FTextColor = AValue then
  638. Exit;
  639. FTextColor := AValue;
  640. if Assigned(FOnChange) then
  641. FOnChange(Self);
  642. end;
  643. procedure TDTScaleSettings.SetThicknessMainTick(AValue: integer);
  644. begin
  645. if FThicknessMainTick = AValue then
  646. Exit;
  647. FThicknessMainTick := AValue;
  648. if Assigned(FOnChange) then
  649. FOnChange(Self);
  650. end;
  651. procedure TDTScaleSettings.SetThicknessSubTick(AValue: integer);
  652. begin
  653. if FThicknessSubTick = AValue then
  654. Exit;
  655. FThicknessSubTick := AValue;
  656. if Assigned(FOnChange) then
  657. FOnChange(Self);
  658. end;
  659. { TDTFaceSettings }
  660. constructor TDTFaceSettings.Create;
  661. begin
  662. FColorFrame := BGRA(35, 35, 35);
  663. FColorStart := BGRA(63, 63, 63);
  664. FColorEnd := BGRA(93, 93, 93);
  665. FFillStyle := fsGradient;
  666. end;
  667. destructor TDTFaceSettings.Destroy;
  668. begin
  669. inherited Destroy;
  670. end;
  671. procedure TDTFaceSettings.SetColorEnd(AValue: TColor);
  672. begin
  673. if FColorEnd = AValue then
  674. Exit;
  675. FColorEnd := AValue;
  676. if Assigned(FOnChange) then
  677. FOnChange(Self);
  678. end;
  679. procedure TDTFaceSettings.SetColorFrame(AValue: TColor);
  680. begin
  681. if FColorFrame = AValue then
  682. Exit;
  683. FColorFrame := AValue;
  684. if Assigned(FOnChange) then
  685. FOnChange(Self);
  686. end;
  687. procedure TDTFaceSettings.SetColorStart(AValue: TColor);
  688. begin
  689. if FColorStart = AValue then
  690. Exit;
  691. FColorStart := AValue;
  692. if Assigned(FOnChange) then
  693. FOnChange(Self);
  694. end;
  695. procedure TDTFaceSettings.SetFillStyle(AValue: TDTFillStyle);
  696. begin
  697. if FFillStyle = AValue then
  698. Exit;
  699. FFillStyle := AValue;
  700. if Assigned(FOnChange) then
  701. FOnChange(Self);
  702. end;
  703. procedure TDTFaceSettings.SetOnChange(AValue: TNotifyEvent);
  704. begin
  705. if FOnChange = AValue then
  706. Exit;
  707. FOnChange := AValue;
  708. if Assigned(FOnChange) then
  709. FOnChange(Self);
  710. end;
  711. { TDTBackGround }
  712. end.