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