unit JDNeedleGauge;
interface
uses
Windows, SysUtils, Classes, Controls, ExtCtrls, Graphics, StrUtils, Forms,
Math;
type
TJDNeedleGauge = class;
TNeedles = class;
TNeedle = class;
TJDMouseEvent = procedure(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer) of object;
TJDMouseMoveEvent = procedure(Sender: TObject; Shift: TShiftState;
X, Y: Integer) of object;
TJDGEvent = procedure(Sender: TObject) of object;
TJDGTickStyle = (gtsNone, gtsMinor, gtsMajor, gtsBoth);
TJDGNeedleStyle = (gnsLine, gnsImage);
THotspot = record
Point: TPoint;
Size: Integer;
Active: Bool;
Value: String;
end;
THotspots = class(TPersistent)
private
fHotspots: String;
function GetHotspot(Point: TPoint): THotspot;
procedure SetHotspot(Point: TPoint; Hotspot: THotspot);
public
constructor Create;
destructor Destroy; override;
procedure Clear;
function InHotspot(APoint: TPoint): THotspot;
property Hotspot[Point: TPoint]: THotspot read GetHotspot write SetHotspot;
end;
TTickMarks = class(TCollection)
private
fOwner: TJDNeedleGauge;
fEvent: TJDGEvent;
function GetOwner: TPersistent; override;
procedure GaugeEvent(Sender: TObject);
public
constructor Create(ItemClass: TCollectionItemClass; AOwner: TJDNeedleGauge);
function Add: TCollectionItem; //override;
property OnEvent: TJDGEvent read fEvent write fEvent;
end;
TTickMark = class(TCollectionItem)
private
fHotspots: THotspots;
fOwner: TJDNeedleGauge;
fIncrement: Integer;
fSize: Integer;
fColor: TColor;
fCanClick: Bool;
fEvent: TJDGEvent;
procedure DoEvent;
procedure SetIncrement(Value: Integer);
procedure SetSize(Value: Integer);
procedure SetColor(Value: TColor);
procedure SetCanClick(Value: Bool);
public
constructor Create(AOwner: TCollection); override;
destructor Destroy; override;
published
property Increment: Integer read fIncrement write SetIncrement;
property Size: Integer read fSize write SetSize;
property Color: TColor read fColor write SetColor;
property CanClick: Bool read fCanClick write SetCanClick;
end;
TNeedles = class(TCollection)
private
fOwner: TJDNeedleGauge;
fEvent: TJDGEvent;
function GetOwner: TPersistent; override;
procedure NeedleEvent(Sender: TObject);
public
constructor Create(ItemClass: TCollectionItemClass; AOwner: TJDNeedleGauge);
function Add: TCollectionItem; //override;
property OnEvent: TJDGEvent read fEvent write fEvent;
end;
TNeedle = class(TCollectionItem)
private
fPicture: TPicture;
fHotspots: THotspots;
fTickMarks: TTickMarks;
fOwner: TJDNeedleGauge;
fLength: Integer;
fWidth: Integer;
fColor: TColor;
fTransparentColor: TColor;
fAutoLength: Bool;
fStyle: TJDGNeedleStyle;
fCursor: TCursor;
fPosition: Integer;
fCanClick: Bool;
fMin: Integer;
fMax: Integer;
fDegreeStart: Integer;
fDegreeStop: Integer;
fEvent: TJDGEvent;
procedure DoEvent;
procedure SetPicture(Value: TPicture);
procedure SetLength(Value: Integer);
procedure SetWidth(Value: Integer);
procedure SetColor(Value: TColor);
procedure SetTransparentColor(Value: TColor);
procedure SetAutoLength(Value: Bool);
procedure SetStyle(Value: TJDGNeedleStyle);
procedure SetCursor(Value: TCursor);
procedure SetPosition(Value: Integer);
procedure SetMin(Value: Integer);
procedure SetMax(Value: Integer);
procedure SetDegreeStart(Value: Integer);
procedure SetDegreeStop(Value: Integer);
procedure SetTickMarks(Value: TTickMarks);
public
constructor Create(AOwner: TCollection); override;
destructor Destroy; override;
property OnEvent: TJDGEvent read fEvent write fEvent;
published
property Picture: TPicture read fPicture write SetPicture;
property Length: Integer read fLength write SetLength;
property Width: Integer read fWidth write SetWidth;
property Color: TColor read fColor write SetColor;
property TransparentColor: TColor read fTransparentColor
write SetTransparentColor;
property AutoLength: Bool read fAutoLength write SetAutoLength;
property Style: TJDGNeedleStyle read fStyle write SetStyle;
property Cursor: TCursor read fCursor write SetCursor;
property Position: Integer read fPosition write SetPosition;
property CanClick: Bool read fCanClick write fCanClick;
property Min: Integer read fMin write SetMin;
property Max: Integer read fMax write SetMax;
property DegreeStart: Integer read fDegreeStart write SetDegreeStart;
property DegreeStop: Integer read fDegreeStop write SetDegreeStop;
property TickMarks: TTickMarks read fTickMarks write SetTickMarks;
end;
TJDNeedleGauge = class(TCustomControl)
private
fBmp: TBitmap;
fBackground: TBitmap;
fScale: TBitmap;
fNeedles: TNeedles;
fPicture: TPicture;
fBackColor: TColor;
fForeColor: TColor;
fLabelTop: String;
fLabelBottom: String;
fDoFade: Bool;
fShowCenter: Bool;
fCenterColor: TColor;
fCenterSize: Integer;
fMouseDown: TJDMouseEvent;
fMouseUp: TJDMouseEvent;
fMouseMove: TJDMouseMoveEvent;
fNeedleMouseDown: TJDMouseEvent;
fNeedleMouseUp: TJDMouseEvent;
fNeedleMouseMove: TJDMouseMoveEvent;
procedure CreateBackground;
procedure DrawScale;
procedure DrawNeedles;
procedure DrawNeedle(ANeedle: TNeedle);
procedure DrawCenter;
procedure DisplayGauge;
procedure SetBackColor(Value: TColor);
procedure SetForeColor(Value: TColor);
procedure SetDoFade(Value: Bool);
procedure SetShowCenter(Value: Bool);
procedure SetCenterColor(Value: TColor);
procedure SetCenterSize(Value: Integer);
procedure SetLabelTop(Value: String);
procedure SetLabelBottom(Value: String);
procedure OnNeedleEvent(Sender: TObject);
procedure MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
procedure NeedleMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure NeedleMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure NeedleMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure Paint; override;
procedure DoRefresh(DrawBackground: Bool);
published
property BackColor: TColor read fBackColor write SetBackColor;
property ForeColor: TColor read fForeColor write SetForeColor;
property DoFade: Bool read fDoFade write SetDoFade;
property ShowCenter: Bool read fShowCenter write SetShowCenter;
property CenterColor: TColor read fCenterColor write SetCenterColor;
property CenterSize: Integer read fCenterSize write SetCenterSize;
property LabelTop: String read fLabelTop write SetLabelTop;
property LabelBottom: String read fLabelBottom write SetLabelBottom;
property Needles: TNeedles read fNeedles write fNeedles;
property Picture: TPicture read fPicture;
property Anchors;
property Align;
property Visible;
property OnGMouseDown: TJDMouseEvent read fMouseDown write fMouseDown;
property OnGMouseUp: TJDMouseEvent read fMouseUp write fMouseUp;
property OnGMouseMove: TJDMouseMoveEvent read fMouseMove write fMouseMove;
property OnGNeedleMouseDown: TJDMouseEvent read fNeedleMouseDown write fNeedleMouseDown;
property OnGNeedleMouseUp: TJDMouseEvent read fNeedleMouseUp write fNeedleMouseUp;
property OnGNeedleMouseMove: TJDMouseMoveEvent read fNeedleMouseMove write fNeedleMouseMove;
property OnClick;
property OnDblClick;
end;
function IntRange(Value: Integer; Min: Integer; Max: Integer): Integer;
function NewPosition(Center: TPoint; Distance: Integer; Degrees: Integer): TPoint;
procedure Wait(msec: DWORD);
implementation
{$R JDNeedleGauge.dcr}
procedure Wait(msec: DWORD);
var tc: DWORD;
begin
tc:= GetTickCount;
while (GetTickCount<tc+msec) and (not Application.Terminated) do
Application.ProcessMessages;
end;
function IntRange(Value: Integer; Min: Integer; Max: Integer): Integer;
begin
Result:= Value;
if Value < Min then Result:= Min;
if Value > Max then Result:= Max;
end;
function NewPosition(Center: TPoint; Distance: Integer; Degrees: Integer): TPoint;
var
Radians: Real;
begin
//Convert angle from degrees to radians; Subtract 135 to bring position to 0 Degrees
Radians:= ((Degrees - 135) * Pi / 180.0);
Result.X:= Trunc(Distance*Cos(Radians)-Distance*Sin(Radians))+Center.X;
Result.Y:= Trunc(Distance*Sin(Radians)+Distance*Cos(Radians))+Center.Y;
end;
function THotspots.GetHotspot(Point: TPoint): THotspot;
var
H, D: String;
P, P2: Integer;
begin
D:= IntToStr(Point.X)+'x'+IntToStr(Point.Y)+',';
P:= Pos(D, fHotspots);
if P > 0 then begin
H:= fHotspots;
Result.Point:= Point;
Result.Active:= True;
Delete(H, 0, P+Length(D));
P2:= Pos(',', H);
Result.Size:= StrToIntDef(Copy(H, 0, P2), 0);
Delete(H, 0, P2+1);
P2:= Pos(';', H);
Result.Value:= Copy(H, 0, P2);
end else begin
Result.Point:= Point;
Result.Active:= False;
Result.Size:= 0;
Result.Value:= '';
end;
end;
procedure THotspots.SetHotspot(Point: TPoint; Hotspot: THotspot);
begin
if Self.GetHotspot(Point).Active = False then begin
Self.fHotspots:= Self.fHotspots + IntToStr(Point.X)+'x'+IntToStr(Point.Y)+
','+IntToStr(Hotspot.Size)+','+Hotspot.Value+';';
end;
end;
constructor THotspots.Create;
begin
Self.fHotspots:= '';
end;
destructor THotspots.Destroy;
begin
end;
procedure THotspots.Clear;
begin
fHotspots:= '';
end;
function THotspots.InHotspot(APoint: TPoint): THotspot;
var
Lst: TStringList;
X, P: Integer;
SX, SY, SS: String;
TX, TY, TS: Integer;
V: String;
begin
if Length(fHotspots) > 0 then begin
Lst:= TStringList.Create;
try
Lst.Delimiter:= ';';
Lst.DelimitedText:= fHotspots;
for X:= 0 to Lst.Count - 1 do begin
V:= Lst[X];
P:= Pos('x', V);
SX:= Copy(V, 1, P-1);
TX:= StrToIntDef(SX, 0);
Delete(V, 1, P);
P:= Pos(',', V);
SY:= Copy(V, 1, P-1);
TY:= StrToIntDef(SY, 0);
Delete(V, 1, P);
P:= Pos(',', V);
SS:= Copy(V, 1, P-1);
TS:= StrToIntDef(SS, 1);
if ( (APoint.X > (TX - (TS div 2)) - 1)
and (APoint.X < (TX + (TS div 2)) + 1)
and (APoint.Y > (TY - (TS div 2)) - 1)
and (APoint.Y < (TY + (TS div 2)) + 1) ) then
begin
//Within range
Result.Point:= Point(TX, TY);
Result.Size:= TS;
Result.Active:= True;
Delete(V, 1, P);
Result.Value:= Copy(V, P, Length(V));
end else begin
Result.Point:= APoint;
Result.Active:= False;
Result.Size:= 0;
Result.Value:= Lst[X];
end;
end;
finally
Lst.Free;
end;
end;
end;
{
procedure TJDGScale.AddMinorHotspot(Position: TPoint; Value: String);
begin
if not IsMinorHotspot(Position) then
fMinorHotspots:= fMinorHotspots +
IntToStr(Position.X)+'x'+IntToStr(Position.Y)+'='+Value;
end;
procedure TJDGScale.AddMajorHotspot(Position: TPoint; Value: String);
begin
if not IsMajorHotspot(Position) then
fMajorHotspots:= fMajorHotspots +
IntToStr(Position.X)+'x'+IntToStr(Position.Y)+'='+Value;
end;
function TJDGScale.IsMinorHotspot(Position: TPoint): Bool;
begin
if pos(IntToStr(Position.X)+'x'+IntToStr(Position.Y)+'=', Self.fMinorHotspots) > 0 then
Result:= True else Result:= False;
end;
function TJDGScale.IsMajorHotspot(Position: TPoint): Bool;
begin
if pos(IntToStr(Position.X)+'x'+IntToStr(Position.Y)+'=', Self.fMajorHotspots) > 0 then
Result:= True else Result:= False;
end;
function TJDGScale.MinorHotspotValue(Position: TPoint): String;
var
P, St, Sp: Integer;
V: String;
begin
P:= pos(IntToStr(Position.X)+'x'+IntToStr(Position.Y)+'=', fMinorHotspots);
if P > 0 then
begin
V:= fMinorHotspots;
Delete(V,1,P);
St:= pos('=', V);
Sp:= pos(';', V);
Result:= Copy(V, St+1, Sp-St);
end else begin
Result:= '';
end;
end;
function TJDGScale.MajorHotspotValue(Position: TPoint): String;
var
P, St, Sp: Integer;
V: String;
begin
P:= pos(IntToStr(Position.X)+'x'+IntToStr(Position.Y)+'=', fMajorHotspots);
if P > 0 then
begin
V:= fMajorHotspots;
Delete(V,1,P);
St:= pos('=', V);
Sp:= pos(';', V);
Result:= Copy(V, St+1, Sp-St);
end else begin
Result:= '';
end;
end;
}
constructor TNeedles.Create(ItemClass: TCollectionItemClass; AOwner: TJDNeedleGauge);
begin
inherited Create(ItemClass);
Self.fOwner:= TJDNeedleGauge(AOwner);
end;
function TNeedles.GetOwner: TPersistent;
begin
Result:= inherited GetOwner;
end;
function TNeedles.Add: TCollectionItem;
var
N: TNeedle;
begin
Result:= Inherited Add;
if assigned(Result) then begin
N:= TNeedle(Result);
N.fOwner:= TJDNeedleGauge(Self.fOwner);
N.OnEvent:= Self.NeedleEvent;
Self.NeedleEvent(Self);
end;
end;
procedure TNeedles.NeedleEvent(Sender: TObject);
begin
if assigned(fEvent) then fEvent(Self);
end;
constructor TNeedle.Create(AOwner: TCollection);
begin
inherited Create(AOwner);
Self.fOwner:= TJDNeedleGauge(TNeedles(AOwner).fOwner);
Self.fTickMarks:= TTickMarks.Create(TTickMark, Self.fOwner);
Self.fPicture:= TPicture.Create;
Self.fHotspots:= THotspots.Create;
Self.fLength:= 50;
Self.fWidth:= 3;
Self.fMin:= 0;
Self.fMax:= 100;
Self.fDegreeStart:= 0;
Self.fDegreeStop:= 360;
Self.fAutoLength:= True;
Self.fColor:= clBlue;
Self.fTransparentColor:= clRed;
Self.fPosition:= 0;
Self.fCanClick:= False;
Self.DoEvent;
end;
destructor TNeedle.Destroy;
begin
if assigned(Self.fPicture) then Self.fPicture.Free;
if assigned(Self.fHotspots) then Self.fHotspots.Free;
if assigned(fTickMarks) then fTickMarks.Free;
inherited Destroy;
end;
procedure TNeedle.SetPicture(Value: TPicture);
begin
fPicture:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetLength(Value: Integer);
begin
fLength:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetWidth(Value: Integer);
begin
fWidth:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetColor(Value: TColor);
begin
fColor:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetTransparentColor(Value: TColor);
begin
fTransparentColor:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetAutoLength(Value: Bool);
begin
fAutoLength:= Value;
Self.DoEvent;
end;
procedure TNeedle.DoEvent;
begin
if assigned(Self.fEvent) then Self.fEvent(Self);
end;
procedure TNeedle.SetStyle(Value: TJDGNeedleStyle);
begin
Self.fStyle:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetCursor(Value: TCursor);
begin
Self.fCursor:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetPosition(Value: Integer);
begin
Self.fPosition:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetMin(Value: Integer);
begin
Self.fMin:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetMax(Value: Integer);
begin
Self.fMax:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetDegreeStart(Value: Integer);
begin
Self.fDegreeStart:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetDegreeStop(Value: Integer);
begin
Self.fDegreeStop:= Value;
Self.DoEvent;
end;
procedure TNeedle.SetTickMarks(Value: TTickMarks);
begin
Self.fTickMarks:= Value;
Self.DoEvent;
end;
constructor TTickMarks.Create(ItemClass: TCollectionItemClass; AOwner: TJDNeedleGauge);
begin
inherited Create(ItemClass);
Self.fOwner:= TJDNeedleGauge(AOwner);
end;
function TTickMarks.GetOwner: TPersistent;
begin
Result:= inherited GetOwner;
end;
function TTickMarks.Add: TCollectionItem;
var
N: TTickMark;
begin
Result:= Inherited Add;
if assigned(Result) then begin
N:= TTickMark(Result);
N.fOwner:= TJDNeedleGauge(Self.fOwner);
//N.OnEvent:= Self.GaugeEvent;
Self.GaugeEvent(Self);
end;
end;
procedure TTickMarks.GaugeEvent(Sender: TObject);
begin
if assigned(fEvent) then fEvent(Self);
end;
constructor TTickMark.Create(AOwner: TCollection);
begin
inherited Create(AOwner);
Self.fHotspots:= THotspots.Create;
Self.fIncrement:= 5;
Self.fSize:= 5;
Self.fColor:= clGray;
Self.fCanClick:= False;
end;
destructor TTickMark.Destroy;
begin
if assigned(fHotspots) then fHotspots.Free;
inherited Destroy;
end;
procedure TTickMark.SetIncrement(Value: Integer);
begin
Self.fIncrement:= Value;
Self.DoEvent;
end;
procedure TTickMark.SetSize(Value: Integer);
begin
Self.fSize:= Value;
Self.DoEvent;
end;
procedure TTickMark.SetColor(Value: TColor);
begin
Self.fColor:= Value;
Self.DoEvent;
end;
procedure TTickMark.SetCanClick(Value: Bool);
begin
Self.fCanClick:= Value;
Self.DoEvent;
end;
procedure TTickMark.DoEvent;
begin
if assigned(Self.fEvent) then Self.fEvent(Self);
end;
const
BitmapPixelFormat = pf32bit;
constructor TJDNeedleGauge.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
Self.Parent:= TWinControl(AOwner);
fBmp:= TBitmap.Create;
fBmp.PixelFormat:= BitmapPixelFormat;
fBmp.TransparentColor:= clFuchsia;
fBmp.Transparent:= True;
fBackground:= TBitmap.Create;
fBackground.PixelFormat:= BitmapPixelFormat;
fBackground.TransparentColor:= clFuchsia;
fBackground.Transparent:= True;
fScale:= TBitmap.Create;
fScale.PixelFormat:= BitmapPixelFormat;
fScale.TransparentColor:= clFuchsia;
fScale.Transparent:= True;
fPicture:= TPicture.Create;
Self.fNeedles:= TNeedles.Create(TNeedle, TJDNeedleGauge(Self));
fNeedles.fOwner:= TJDNeedleGauge(Self);
fNeedles.OnEvent:= Self.OnNeedleEvent;
Self.Width:= 200;
Self.Height:= 200;
Self.fBackColor:= clBlack;
Self.fForeColor:= clNavy;
Self.OnMouseDown:= Self.MouseDown;
Self.OnMouseUp:= Self.MouseUp;
Self.OnMouseMove:= Self.MouseMove;
Self.DoRefresh(True);
end;
destructor TJDNeedleGauge.Destroy;
begin
if assigned(fNeedles) then fNeedles.Free;
if assigned(fBmp) then fBmp.Free;
if assigned(fBackground) then fBackground.Free;
if assigned(fScale) then fScale.Free;
if assigned(fPicture) then fPicture.Free;
inherited Destroy;
end;
procedure TJDNeedleGauge.DoRefresh(DrawBackground: Bool);
begin
//Refresh entire gauge
if DrawBackground then begin
CreateBackground;
DrawScale;
end;
DisplayGauge;
end;
procedure TJDNeedleGauge.DisplayGauge;
begin
if fBmp.Width <> Width then
fBmp.Width:= Width;
if fBmp.Height <> Height then
fBmp.Height:= Height;
fBmp.Canvas.Brush.Color:= Self.fBackColor;
fBmp.Canvas.FillRect(Rect(0,0,Width,Height));//clFuchsia
fBmp.Canvas.Draw(0,0,fBackground);
fBmp.Canvas.Draw(0,0,fScale);
DrawNeedles;
if Self.fShowCenter then DrawCenter;
Canvas.Draw(0,0,fBmp);
end;
procedure TJDNeedleGauge.CreateBackground;
var
R, G, B, TR, TG, TB: Integer;
W, H, Sz, L, D, S, X: Integer;
begin
//Create background image (fBackground)
W:= Self.Width;
H:= Self.Height;
if W > H then Sz:= H else Sz:= W;
fBackground.Width:= Sz;
fBackground.Height:= Sz;
fBackground.Canvas.Pen.Width:= 5;
fBackground.Canvas.Brush.Color:= fBackColor;
fBackground.Canvas.Pen.Color:= fBackColor;
fBackground.Canvas.FillRect(Rect(0,0,W,H));
if Self.fDoFade then begin
L:= IntRange((Sz div 2) - 1, 1, 500);
R:= (fForeColor and $ff);
G:= ((fForeColor and $ff00) shr 8);
B:= ((fForeColor and $ff0000) shr 16);
for X:= 0 to L do begin
S:= StrToIntDef(FormatFloat('0',(X / L) * 70), 0);
D:= L - X;
TR:= IntRange(R + S, 0, 255);
TG:= IntRange(G + S, 0, 255);
TB:= IntRange(B + S, 0, 255);
fBackground.Canvas.Brush.Color:= RGB(TR,TG,TB);
fBackground.Canvas.Pen.Color:= RGB(TR,TG,TB);
fBackground.Canvas.Ellipse(5 + X, 5 + X, Sz - 5 - X, Sz - 5 - X);
end;
end else begin
fBackground.Canvas.Brush.Color:= fForeColor;
fBackground.Canvas.Pen.Color:= fForeColor;
fBackground.Canvas.Ellipse(5, 5, Sz - 5, Sz - 5);
end;
end;
procedure TJDNeedleGauge.DrawScale;
var
Center, NewPos: TPoint;
D, G, C: Single;
X, Y, Z, Sz, SSize, LSize, TickCount, I, J: Integer;
N: TNeedle;
T: TTickMark;
H: THotspot;
begin
//Draw scale around circle (fScale)
if Width >= Height then Sz:= Height else Sz:= Width;
Center.X:= Sz div 2;
Center.Y:= Sz div 2;
for I:= 0 to fNeedles.Count - 1 do begin
N:= TNeedle(fNeedles.Items[I]);
for J:= 0 to N.fTickMarks.Count - 1 do begin
T:= TTickMark(N.fTickMarks.Items[J]);
T.fHotspots.Clear;
TickCount:= (N.fMax - N.fMin) div T.fIncrement;
D:= (Sz / 3) - (T.Size / 2) - 1;
G:= N.fDegreeStart;
fScale.Canvas.Brush.Color:= T.Color;
C:= (N.DegreeStop - N.DegreeStart) / TickCount;
for Z:= 0 to TickCount do begin
NewPos:= NewPosition(Center, Trunc(D), Trunc(G));
fScale.Canvas.Ellipse(
NewPos.X - (T.fSize div 2), NewPos.Y - (T.fSize div 2),
NewPos.X + (T.fSize div 2) + 1, NewPos.Y + (T.fSize div 2) + 1);
if T.fCanClick then begin
for X:= (NewPos.X - (T.fSize div 2)) to (NewPos.X + (T.fSize div 2)) do begin
for Y:= (NewPos.Y - (T.fSize div 2)) to (NewPos.Y + (T.fSize div 2)) do begin
H.Point:= Point(X,Y);
H.Size:= 1;
H.Active:= True;
H.Value:= IntToStr(Z);
T.fHotspots.Hotspot[Point(X,Y)]:= H;
end;
end;
end;
G:= G + C;
end;
end;
end;
{
if Self.fScale.fTickStyle <> gtsNone then begin
if Width >= Height then Sz:= Height else Sz:= Width;
Center.X:= Sz div 2;
Center.Y:= Sz div 2;
LSize:= 6;
SSize:= 2;
MajorCount:= (fScale.fMax - fScale.fMin) div fScale.MajorInc;
MinorCount:= (fScale.fMax - fScale.fMin) div fScale.MinorInc;
D:= (Sz / 3) - (LSize / 2) - 1;
end;
if Self.fScale.fTickStyle in [gtsMinor, gtsBoth] then begin
G:= fScale.DegreeStart;
fBackground.Canvas.Brush.Color:= fScale.fMinorColor;
fBackground.Canvas.Pen.Color:= fScale.fMinorColor;
C:= (fScale.DegreeStop - fScale.DegreeStart) / MinorCount;
for Z:= 0 to MinorCount do begin
NewPos:= NewPosition(Center, Trunc(D), Trunc(G));
fBackground.Canvas.Ellipse(
NewPos.X - (SSize div 2), NewPos.Y - (SSize div 2),
NewPos.X + (SSize div 2) + 1, NewPos.Y + (SSize div 2) + 1);
if fScale.fCanClickMinor then begin
for X:= (NewPos.X - (LSize div 2)) to (NewPos.X + (LSize div 2)) do begin
for Y:= (NewPos.Y - (LSize div 2)) to (NewPos.Y + (LSize div 2)) do begin
fScale.AddMinorHotspot(Point(X,Y), IntToStr(Z));
end;
end;
end;
G:= G + C;
end;
end;
if Self.fScale.fTickStyle in [gtsMajor, gtsBoth] then begin
G:= fScale.DegreeStart;
fBackground.Canvas.Brush.Color:= fScale.fMajorColor;
fBackground.Canvas.Pen.Color:= fScale.fMajorColor;
C:= (fScale.DegreeStop - fScale.DegreeStart) / MajorCount;
for Z:= 0 to MajorCount do begin
if (fScale.fDegreeStop <> 360)
or ((fScale.fDegreeStop = 360) and (Z < MajorCount)) then
begin
NewPos:= NewPosition(Center, Trunc(D), Trunc(G));
fBackground.Canvas.Ellipse(
NewPos.X - (LSize div 2), NewPos.Y - (LSize div 2),
NewPos.X + (LSize div 2), NewPos.Y + (LSize div 2));
if fScale.fCanClickMajor then begin
for X:= (NewPos.X - (SSize div 2)) to (NewPos.X + (SSize div 2)) do begin
for Y:= (NewPos.Y - (SSize div 2)) to (NewPos.Y + (SSize div 2)) do begin
fScale.AddMajorHotspot(Point(X,Y), IntToStr(Z));
end;
end;
end;
end;
G:= G + C;
end;
end; }
end;
procedure TJDNeedleGauge.DrawNeedles;
var
X: Integer;
begin
for X:= 0 to fNeedles.Count - 1 do
DrawNeedle(TNeedle(fNeedles.Items[X]));
end;
procedure TJDNeedleGauge.DrawNeedle(ANeedle: TNeedle);
var
Center, NewPos, P: TPoint;
C: Single;
Sz, Deg, L, X, Y, Z: Integer;
N: TBitmap;
H: THotspot;
begin
//Draw needle pointing in proper position (fBmp)
if Self.Width >= Self.Height then Sz:= Self.Height else Sz:= Self.Width;
Center.X:= Sz div 2;
Center.Y:= Sz div 2;
Deg:= Trunc((ANeedle.DegreeStop - ANeedle.DegreeStart) *
(ANeedle.Position / (ANeedle.Max - ANeedle.Min)));
C:= (ANeedle.DegreeStop - ANeedle.DegreeStart);
if (ANeedle.fAutoLength = true) then
L:= trunc((Sz / 3) - 10)
else
L:= ANeedle.fLength;
NewPos:= NewPosition(Center, L, Deg);
fBmp.Canvas.Pen.Width:= ANeedle.fWidth;
fBmp.Canvas.Pen.Color:= ANeedle.fColor;
case ANeedle.fStyle of
gnsLine: begin
//Draw actual line
fBmp.Canvas.MoveTo(Center.X, Center.Y);
fBmp.Canvas.LineTo(NewPos.X, NewPos.Y);
//Create hotspots (Low Performance - Need to tweak)
if ANeedle.fCanClick then begin
ANeedle.fHotspots.Clear;
for Z:= 0 to L - 1 do begin
P:= NewPosition(Center, Z, Deg);
for X:= P.X - (ANeedle.Width div 2) to
P.X + (ANeedle.Width div 2) do
begin
for Y:= P.Y - (ANeedle.Width div 2) to
P.Y + (ANeedle.Width div 2) do
begin
H.Point:= Point(X,Y);
H.Size:= ANeedle.fWidth;
H.Active:= True;
H.Value:= IntToStr(Z);
ANeedle.fHotspots.Hotspot[Point(X,Y)]:= H;
end;
end;
end;
end;
end;
gnsImage: begin
if assigned(ANeedle.fPicture) then begin
N:= TBitmap.Create;
try
//Assign picture to bitmap
finally
N.Free;
end;
end;
end;
end;
end;
procedure TJDNeedleGauge.DrawCenter;
var
R, G, B, TR, TG, TB: Integer;
W, H, L, D, S, X: Integer;
Sz: Integer;
begin
W:= Self.Width;
H:= Self.Height;
if W > H then Sz:= H else Sz:= W;
//Create center piece image (fBmp)
L:= IntRange(Trunc((fCenterSize / 2) - 1), 1, 500);
R:= (fCenterColor and $ff);
G:= ((fCenterColor and $ff00) shr 8);
B:= ((fCenterColor and $ff0000) shr 16);
for X:= ((Sz div 2) - (fCenterSize div 2)) downto L do begin
S:= Trunc((X / L) * 70);
D:= L - X;
TR:= IntRange(R + S, 0, 255);
TG:= IntRange(G + S, 0, 255);
TB:= IntRange(B + S, 0, 255);
fBmp.Canvas.Brush.Color:= RGB(TR,TG,TB);
fBmp.Canvas.Pen.Color:= RGB(TR,TG,TB);
fBmp.Canvas.Ellipse(
(Sz div 2) - fCenterSize + 5 + X,
(Sz div 2) - fCenterSize + 5 + X,
fCenterSize - 5 - X,
fCenterSize - 5 - X);
end;
end;
procedure TJDNeedleGauge.Paint;
begin
inherited Paint;
DoRefresh(True);
end;
procedure TJDNeedleGauge.SetBackColor(Value: TColor);
begin
fBackColor:= Value;
DoRefresh(True);
end;
procedure TJDNeedleGauge.SetForeColor(Value: TColor);
begin
fForeColor:= Value;
DoRefresh(True);
end;
procedure TJDNeedleGauge.SetShowCenter(Value: Bool);
begin
Self.fShowCenter:= Value;
DoRefresh(False);
end;
procedure TJDNeedleGauge.SetCenterColor(Value: TColor);
begin
Self.fCenterColor:= Value;
if Self.fShowCenter then DoRefresh(False);
end;
procedure TJDNeedleGauge.SetCenterSize(Value: Integer);
begin
Self.fCenterSize:= Value;
if Self.fShowCenter then DoRefresh(False);
end;
procedure TJDNeedleGauge.SetLabelTop(Value: String);
begin
Self.fLabelTop:= Value;
Self.DoRefresh(True);
end;
procedure TJDNeedleGauge.SetLabelBottom(Value: String);
begin
Self.fLabelBottom:= Value;
Self.DoRefresh(True);
end;
procedure TJDNeedleGauge.OnNeedleEvent(Sender: TObject);
begin
DoRefresh(False);
end;
procedure TJDNeedleGauge.MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
I: Integer;
N: TNeedle;
D: Bool;
begin
//Check for hotspots
D:= False;
for I:= 0 to fNeedles.Count - 1 do begin
N:= TNeedle(fNeedles.Items[I]);
if N.fCanClick then begin
if N.fHotspots.InHotspot(Point(X,Y)).Active then begin
D:= True;
if assigned(Self.fNeedleMouseDown) then
Self.fNeedleMouseDown(Sender, Button, Shift, X, Y);
end;
end;
end;
if not D then
if assigned(Self.fMouseDown) then
Self.fMouseDown(Sender, Button, Shift, X, Y);
end;
procedure TJDNeedleGauge.MouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var
I: Integer;
N: TNeedle;
D: Bool;
begin
//Check for hotspots
D:= False;
for I:= 0 to fNeedles.Count - 1 do begin
N:= TNeedle(fNeedles.Items[I]);
if N.fCanClick then begin
if N.fHotspots.InHotspot(Point(X,Y)).Active then begin
D:= True;
if assigned(Self.fNeedleMouseUp) then
Self.fNeedleMouseUp(Sender, Button, Shift, X, Y);
end;
end;
end;
if not D then
if assigned(Self.fMouseUp) then
Self.fMouseUp(Sender, Button, Shift, X, Y);
end;
procedure TJDNeedleGauge.MouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
var
I: Integer;
N: TNeedle;
D: Bool;
begin
//Check for hotspots
D:= False;
for I:= 0 to fNeedles.Count - 1 do begin
N:= TNeedle(fNeedles.Items[I]);
if N.fCanClick then begin
if N.fHotspots.InHotspot(Point(X,Y)).Active then begin
D:= True;
if assigned(Self.fNeedleMouseMove) then
Self.fNeedleMouseMove(Sender, Shift, X, Y);
end;
end;
end;
if not D then
if assigned(Self.fMouseMove) then
Self.fMouseMove(Sender, Shift, X, Y);
end;
procedure TJDNeedleGauge.NeedleMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if assigned(Self.fNeedleMouseDown) then
Self.fNeedleMouseDown(Sender, Button, Shift, X, Y);
end;
procedure TJDNeedleGauge.NeedleMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if assigned(Self.fNeedleMouseUp) then
Self.fNeedleMouseUp(Sender, Button, Shift, X, Y);
end;
procedure TJDNeedleGauge.NeedleMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if assigned(Self.fNeedleMouseMove) then
Self.fNeedleMouseMove(Sender, Shift, X, Y);
end;
procedure TJDNeedleGauge.SetDoFade(Value: Bool);
begin
Self.fDoFade:= Value;
Self.DoRefresh(True);
end;
end.