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