466 lines
11 KiB
ObjectPascal
466 lines
11 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
|
|
}
|
|
|
|
unit DTAnalogGauge;
|
|
|
|
{$mode objfpc}{$H+}
|
|
|
|
interface
|
|
|
|
uses
|
|
Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, DTAnalogCommon,
|
|
BGRABitmap, BGRABitmapTypes;
|
|
|
|
type
|
|
|
|
TDTGaugeStyle = (gsCustom, gsDark, gsLight);
|
|
|
|
|
|
{ TDTCustomAnalogGauge }
|
|
|
|
TDTCustomAnalogGauge = class(TGraphicControl)
|
|
private
|
|
FFaceSettings: TDTFaceSettings;
|
|
FGaugeStyle: TDTGaugeStyle;
|
|
FNeedleSettings: TDTNeedleSettings;
|
|
FPosition: integer;
|
|
FResized: boolean;
|
|
FGaugeBitmap: TBGRABitmap;
|
|
FGaugeBodyBitmap: TBGRABitmap;
|
|
FGaugeScaleBitmap: TBGRABitmap;
|
|
FGaugeNeedleBitmap: TBGRABitmap;
|
|
FScaleSettings: TDTScaleSettings;
|
|
procedure SetFaceSettings(AValue: TDTFaceSettings);
|
|
procedure DoChange({%H-}Sender: TObject);
|
|
procedure SetGaugeStyle(AValue: TDTGaugeStyle);
|
|
procedure SetNeedleSettings(AValue: TDTNeedleSettings);
|
|
procedure SetPosition(AValue: integer);
|
|
procedure SetScaleSettings(AValue: TDTScaleSettings);
|
|
{ Private declarations }
|
|
protected
|
|
{ Protected declarations }
|
|
procedure ResizeEvent({%H-}Sender: TObject);
|
|
procedure ClearBitMap(var BitMap: TBGRABitmap);
|
|
public
|
|
{ Public declarations }
|
|
constructor Create(AOwner: TComponent); override;
|
|
destructor Destroy; override;
|
|
procedure Paint; override;
|
|
procedure DrawGauge; virtual;
|
|
procedure DrawGaugeBody; virtual;
|
|
procedure DrawGaugeRange; virtual;
|
|
procedure DrawGaugeFace; virtual;
|
|
procedure DrawGaugeScale; virtual;
|
|
procedure DrawGaugeNeedle; virtual;
|
|
published
|
|
{ Published declarations }
|
|
property Position: integer read FPosition write SetPosition;
|
|
property FaceSettings: TDTFaceSettings read FFaceSettings write SetFaceSettings;
|
|
property ScaleSettings: TDTScaleSettings read FScaleSettings write SetScaleSettings;
|
|
property NeedleSettings: TDTNeedleSettings read FNeedleSettings write SetNeedleSettings;
|
|
//property GaugeStyle: TDTGaugeStyle read FGaugeStyle write SetGaugeStyle;
|
|
end;
|
|
|
|
{ TDTAnalogGauge }
|
|
|
|
TDTAnalogGauge = class(TDTCustomAnalogGauge)
|
|
private
|
|
{ Private declarations }
|
|
protected
|
|
{ Protected declarations }
|
|
public
|
|
{ Public declarations }
|
|
published
|
|
{ Published declarations }
|
|
property FaceSettings;
|
|
property ScaleSettings;
|
|
property NeedleSettings;
|
|
end;
|
|
|
|
procedure Register;
|
|
|
|
implementation
|
|
|
|
procedure Register;
|
|
begin
|
|
//{$I icons\dtanaloggauge_icon.lrs}
|
|
RegisterComponents('BGRA Controls', [TDTAnalogGauge]);
|
|
end;
|
|
|
|
{ TDTCustomAnalogGauge }
|
|
|
|
procedure TDTCustomAnalogGauge.ClearBitMap(var BitMap: TBGRABitmap);
|
|
begin
|
|
BitMap.Fill(BGRA(0, 0, 0, 0));
|
|
end;
|
|
|
|
constructor TDTCustomAnalogGauge.Create(AOwner: TComponent);
|
|
begin
|
|
inherited Create(AOwner);
|
|
|
|
Width := 240;
|
|
Height := 240;
|
|
|
|
FScaleSettings := TDTScaleSettings.Create;
|
|
ScaleSettings.OnChange := @DoChange;
|
|
|
|
FFaceSettings := TDTFaceSettings.Create;
|
|
FaceSettings.OnChange := @DoChange;
|
|
|
|
FNeedleSettings := TDTNeedleSettings.Create;
|
|
NeedleSettings.OnChange := @DoChange;
|
|
|
|
FGaugeBitmap := TBGRABitmap.Create(Width, Height);
|
|
FGaugeBodyBitmap := TBGRABitmap.Create(Width, Height);
|
|
FGaugeScaleBitmap := TBGRABitmap.Create(Width, Height);
|
|
FGaugeNeedleBitmap := TBGRABitmap.Create(Width, Height);
|
|
|
|
end;
|
|
|
|
destructor TDTCustomAnalogGauge.Destroy;
|
|
begin
|
|
FScaleSettings.OnChange:=nil;
|
|
FScaleSettings.Free;
|
|
FFaceSettings.OnChange:=nil;
|
|
FFaceSettings.Free;
|
|
FGaugeBitmap.Free;
|
|
FGaugeBodyBitmap.Free;
|
|
FGaugeScaleBitmap.Free;
|
|
FGaugeNeedleBitmap.Free;
|
|
FNeedleSettings.OnChange:=nil;
|
|
FNeedleSettings.Free;
|
|
inherited Destroy;
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.DoChange(Sender: TObject);
|
|
begin
|
|
Invalidate;
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.SetGaugeStyle(AValue: TDTGaugeStyle);
|
|
begin
|
|
if FGaugeStyle = AValue then
|
|
Exit;
|
|
FGaugeStyle := AValue;
|
|
|
|
DoChange(self);
|
|
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.SetNeedleSettings(AValue: TDTNeedleSettings);
|
|
begin
|
|
if FNeedleSettings = AValue then
|
|
Exit;
|
|
FNeedleSettings := AValue;
|
|
|
|
DoChange(self);
|
|
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.DrawGauge;
|
|
begin
|
|
DrawGaugeBody;
|
|
DrawGaugeFace;
|
|
|
|
if FScaleSettings.EnableRangeIndicator then
|
|
DrawGaugeRange;
|
|
|
|
DrawGaugeScale;
|
|
DrawGaugeNeedle;
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.DrawGaugeBody;
|
|
var
|
|
r: integer;
|
|
origin: TDTOrigin;
|
|
begin
|
|
|
|
origin := Initializebitmap(FGaugeBodyBitmap, Width, Height);
|
|
|
|
//// Keep circle insde frame
|
|
r := round(origin.Radius * 0.95);
|
|
|
|
// Draw Bitmap frame
|
|
FGaugeBodyBitmap.FillEllipseAntialias(origin.CenterPoint.x,
|
|
origin.CenterPoint.y,
|
|
r, r, FFaceSettings.ColorFrame);
|
|
|
|
// Draw thin antialiased border to smooth against background
|
|
FGaugeBodyBitmap.EllipseAntialias(origin.CenterPoint.x,
|
|
origin.CenterPoint.y,
|
|
r, r, ColorToBGRA(clBlack, 120), 1);
|
|
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.DrawGaugeRange;
|
|
var
|
|
{%H-}r, w, h, Xo, Yo: integer;
|
|
begin
|
|
|
|
ClearBitMap(FGaugeScaleBitmap);
|
|
|
|
w := Width;
|
|
h := Height;
|
|
|
|
FGaugeScaleBitmap.SetSize(w, h);
|
|
|
|
{ Set center point }
|
|
Xo := w div 2;
|
|
Yo := h div 2;
|
|
|
|
// Determine radius. If canvas is rectangular then r = shortest length w or h
|
|
r := yo;
|
|
|
|
if xo > yo then
|
|
r := yo;
|
|
|
|
if xo < yo then
|
|
r := xo;
|
|
|
|
//j := (180 - FScaleSettings.Angle) / 2;
|
|
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.DrawGaugeFace;
|
|
var
|
|
w, h, r, Xo, Yo: integer;
|
|
begin
|
|
ClearBitMap(FGaugeScaleBitmap);
|
|
|
|
w := Width;
|
|
h := Height;
|
|
|
|
FGaugeBodyBitmap.SetSize(w, h);
|
|
|
|
//{ Set center point }
|
|
Xo := w div 2;
|
|
Yo := h div 2;
|
|
|
|
// // Determine radius. If canvas is rectangular then r = shortest length w or h
|
|
r := yo;
|
|
|
|
if xo > yo then
|
|
r := yo;
|
|
|
|
if xo < yo then
|
|
r := xo;
|
|
|
|
// Keep circle insde frame
|
|
r := round(r * 0.95) - 5;
|
|
|
|
// Draw face background
|
|
case FFaceSettings.FillStyle of
|
|
fsGradient:
|
|
FGaugeBodyBitmap.FillEllipseLinearColorAntialias(Xo, Yo, r, r, FFaceSettings.ColorStart, ColorToBGRA(FFaceSettings.ColorEnd));
|
|
fsnone:
|
|
FGaugeBodyBitmap.FillEllipseAntialias(Xo, Yo, r, r, FFaceSettings.ColorStart);
|
|
end;
|
|
|
|
|
|
//origin := Initializebitmap(FGaugeBodyBitmap, Width, Height);
|
|
|
|
//// Keep circle insde frame
|
|
//r := round(origin.Radius * 0.95) - 5;
|
|
|
|
//// Draw face background
|
|
//case FFaceSettings.FillStyle of
|
|
// fsGradient:
|
|
// FGaugeBodyBitmap.FillEllipseLinearColorAntialias(origin.CenterPoint.x, origin.CenterPoint.y, r, r, ColorToBGRA(FFaceSettings.ColorStart), ColorToBGRA(FFaceSettings.ColorEnd));
|
|
// fsnone:
|
|
// FGaugeBodyBitmap.FillEllipseAntialias(origin.CenterPoint.x, origin.CenterPoint.y, r, r, ColorToBGRA(FFaceSettings.ColorStart));
|
|
//end;
|
|
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.DrawGaugeScale;
|
|
var
|
|
w, h, r, Xo, Yo, X, Y, Xt, Yt: integer;
|
|
i, n: integer;
|
|
j: single;
|
|
begin
|
|
|
|
w := Width;
|
|
h := Height;
|
|
|
|
FGaugeScaleBitmap.SetSize(w, h);
|
|
|
|
ClearBitMap(FGaugeScaleBitmap);
|
|
|
|
{ Set center point }
|
|
Xo := w div 2;
|
|
Yo := h div 2;
|
|
|
|
// Determine radius. If canvas is rectangular then r = shortest length w or h
|
|
r := yo;
|
|
|
|
if xo > yo then
|
|
r := yo;
|
|
|
|
if xo < yo then
|
|
r := xo;
|
|
|
|
j := (180 - FScaleSettings.Angle) / 2;
|
|
|
|
// Draw SubTicks
|
|
if FScaleSettings.EnableSubTicks then
|
|
begin
|
|
|
|
n := FScaleSettings.MainTickCount * FScaleSettings.SubTickCount;
|
|
|
|
for i := 0 to n do
|
|
begin
|
|
// Calculate draw from point
|
|
X := xo - Round(r * 0.85 * cos((j + i * FScaleSettings.Angle / n) * Pi / 180));
|
|
Y := yo - Round(r * 0.85 * sin((j + i * FScaleSettings.Angle / n) * Pi / 180));
|
|
|
|
// Calculate draw to point
|
|
Xt := xo - Round(((r * 0.85) - FScaleSettings.LengthSubTick) * cos((j + i * FScaleSettings.Angle / n) * Pi / 180));
|
|
Yt := yo - Round(((r * 0.85) - FScaleSettings.LengthSubTick) * sin((j + i * FScaleSettings.Angle / n) * Pi / 180));
|
|
|
|
FGaugeScaleBitmap.DrawLineAntialias(x, y, xt, yt, FScaleSettings.TickColor, FScaleSettings.ThicknessSubTick);
|
|
|
|
end;
|
|
end;
|
|
|
|
if FScaleSettings.EnableMainTicks then
|
|
begin
|
|
|
|
FGaugeScaleBitmap.FontName := FScaleSettings.TextFont;
|
|
FGaugeScaleBitmap.FontHeight := FScaleSettings.TextSize;
|
|
FGaugeScaleBitmap.FontQuality := fqFineAntialiasing;
|
|
|
|
n := FScaleSettings.MainTickCount;
|
|
|
|
for i := 0 to n do
|
|
begin
|
|
// Draw main ticks
|
|
// Calculate draw from point
|
|
X := xo - Round(r * 0.85 * cos((j + i * FScaleSettings.Angle / n) * Pi / 180));
|
|
Y := yo - Round(r * 0.85 * sin((j + i * FScaleSettings.Angle / n) * Pi / 180));
|
|
|
|
// Calculate draw to point
|
|
Xt := xo - Round(((r * 0.85) - FScaleSettings.LengthMainTick) * cos((j + i * FScaleSettings.Angle / n) * Pi / 180));
|
|
Yt := yo - Round(((r * 0.85) - FScaleSettings.LengthMainTick) * sin((j + i * FScaleSettings.Angle / n) * Pi / 180));
|
|
|
|
FGaugeScaleBitmap.DrawLineAntialias(x, y, xt, yt, FScaleSettings.TickColor, FScaleSettings.ThicknessMainTick);
|
|
|
|
// Draw text for main ticks
|
|
Xt := xo - Round((r - FScaleSettings.LengthMainTick) * 0.7 * cos((j + i * FScaleSettings.Angle / n) * Pi / 180));
|
|
Yt := yo - Round((r - FScaleSettings.LengthMainTick) * 0.7 * sin((j + i * FScaleSettings.Angle / n) * Pi / 180));
|
|
|
|
FGaugeScaleBitmap.TextOut(Xt, Yt - (FGaugeScaleBitmap.FontHeight / 1.7),
|
|
IntToStr(i * FScaleSettings.Maximum div FScaleSettings.MainTickCount),
|
|
//ColorToBGRA(FScaleSettings.TickColor),
|
|
FScaleSettings.TextColor,
|
|
taCenter);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.DrawGaugeNeedle;
|
|
var
|
|
w, h, Xo, Yo, X, Y: integer;
|
|
j: single;
|
|
begin
|
|
|
|
ClearBitMap(FGaugeNeedleBitmap);
|
|
|
|
w := Width;
|
|
h := Height;
|
|
|
|
FGaugeNeedleBitmap.SetSize(w, h);
|
|
|
|
{ Set center point }
|
|
Xo := w div 2;
|
|
Yo := h div 2;
|
|
|
|
j := (180 - FScaleSettings.Angle) / 2;
|
|
|
|
// Draw needle
|
|
case FNeedleSettings.NeedleStyle of
|
|
nsLine:
|
|
begin
|
|
|
|
X := xo - Round(FNeedleSettings.NeedleLength * cos((j + Position * FScaleSettings.Angle / FScaleSettings.Maximum) * Pi / 180));
|
|
Y := yo - Round(FNeedleSettings.NeedleLength * sin((j + Position * FScaleSettings.Angle / FScaleSettings.Maximum) * Pi / 180));
|
|
|
|
FGaugeNeedleBitmap.DrawLineAntialias(xo, yo, x, y,
|
|
FNeedleSettings.NeedleColor,
|
|
FScaleSettings.ThicknessMainTick);
|
|
end;
|
|
nsTriangle:
|
|
begin
|
|
|
|
end;
|
|
end;
|
|
|
|
// Draw cap over needle
|
|
FGaugeNeedleBitmap.EllipseAntialias(Xo, Yo, FNeedleSettings.CapRadius,
|
|
FNeedleSettings.CapRadius,
|
|
FNeedleSettings.CapEdgeColor,
|
|
2, FNeedleSettings.CapColor);
|
|
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.SetFaceSettings(AValue: TDTFaceSettings);
|
|
begin
|
|
if FFaceSettings = AValue then
|
|
Exit;
|
|
FFaceSettings := AValue;
|
|
|
|
DoChange(self);
|
|
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.SetPosition(AValue: integer);
|
|
begin
|
|
if FPosition = AValue then
|
|
Exit;
|
|
FPosition := AValue;
|
|
|
|
DoChange(self);
|
|
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.SetScaleSettings(AValue: TDTScaleSettings);
|
|
begin
|
|
if FScaleSettings = AValue then
|
|
Exit;
|
|
FScaleSettings := AValue;
|
|
|
|
DoChange(self);
|
|
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.ResizeEvent(Sender: TObject);
|
|
begin
|
|
FResized := True;
|
|
end;
|
|
|
|
procedure TDTCustomAnalogGauge.Paint;
|
|
begin
|
|
inherited Paint;
|
|
|
|
ClearBitMap(FGaugeBitmap);
|
|
|
|
FGaugeBitmap.SetSize(Width, Height);
|
|
|
|
DrawGauge;
|
|
|
|
FGaugeBitmap.BlendImage(0, 0, FGaugeBodyBitmap, boLinearBlend);
|
|
FGaugeBitmap.BlendImage(0, 0, FGaugeScaleBitmap, boLinearBlend);
|
|
FGaugeBitmap.BlendImage(0, 0, FGaugeNeedleBitmap, boLinearBlend);
|
|
|
|
FGaugeBitmap.Draw(Canvas, 0, 0, False);
|
|
|
|
end;
|
|
|
|
end.
|