Unfinished component up for grabs - in hopes someone will finish it 1

djjd47130 · Jun 26, 2011

I have an old project I started a while back, it's a Needle Gauge. For the most part, it does work, except I have a problem with the TCollection implementation. You see, it's capable of numerous Needles, each can be positioned in different area's of the control's canvas. Each needle can also have many different ranges of tick marks. My goal was to be able to make like a dashboard style needle gauge. Now each needle is created in a TCollection called TNeedles, with a number of TNeedle items. The problem I had was trying to put another TCollection within the TCollectionItem, that is, putting a collection of TTickMarks into the TNeedle item. In design time, when you try to access this TTickMarks collection, it does not work. I'm sure it has to be a simple solution which I don't see. Now the code's a little all over the place still, and there's some things which are used from other units... I'll try my best to get it all...

You will also need to add this to a package to install the component to your palette of course.

Function In Unit JDGraphics.pas:

Code:

////////////////////////////////////////////////////////////////////////////////
//  function NewPosition(Center: TPoint; Distance: Integer; Degrees: Integer): TPoint;
//  Identifies a new TPoint in a circle around a central TPoint
//    Center: TPoint = Center point to base the calculation from (X, Y)
//    Distance: Integer = Distance from Center Point (Pixels)
//    Degrees: Integer = Angle around Center Point (Degrees)
//    Result: TPoint = New position based on calculation
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 In Unit JDCommon.pas:

Code:

//Keeps an integer within a given range of possible values
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;

(You won't have the DCR file which has the icon, so I attached it)
Unit JDNeedleGauge.pas:

Code:

unit JDNeedleGauge;

interface
         
uses
  Classes, Controls, SysUtils, Windows, StdCtrls, ExtCtrls, Graphics, StrUtils,
  JPEG, Messages, Variants, Forms, ComCtrls
  , JDGraphics
  , JDCommon
  ;

////////////////////////////////////////////////////////////////////////////////
//                                TJDNeedleGauge
//                         Custom needle gauge component
////////////////////////////////////////////////////////////////////////////////

type
  TJDNeedleGauge = class;
  TNeedles = class;
  TNeedle = class;
  TTickMarks = class;
  TTickMark = class;
  THotspots = class;

  TPoints = array of TPoint;
        
  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, gtsCircle, gtsBall, gtsLine);
  TJDGNeedleStyle = (gnsLine, gnsImage);
  TJDGNeedleSizing = (gnsAuto, gnsPixels, gnsPercent);

  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 GetItems(Index: Integer): TTickMark;
    procedure SetItems(Index: Integer; Value: TTickMark);

    function GetOwner: TPersistent; override;
    procedure GaugeEvent(Sender: TObject);
  public
    constructor Create(AOwner: TPersistent);
    function Add: TTickMark;
    property OnEvent: TJDGEvent read fEvent write fEvent; 
    property Items[Index: Integer]: TTickMark read GetItems write SetItems;
  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;    
    procedure Assign(source:TPersistent); 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(AOwner: TJDNeedleGauge);
    function Add: TNeedle; 
    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;
    fStyle: TJDGNeedleStyle;
    fCursor: TCursor;
    fPosition: Integer;
    fCanClick: Bool;
    fMin: Integer;
    fMax: Integer;
    fDegreeStart: Integer;
    fDegreeStop: Integer;
    fSizing: TJDGNeedleSizing;

    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 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);
    procedure SetSizing(Value: TJDGNeedleSizing);

  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 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;
    property Sizing: TJDGNeedleSizing read fSizing write SetSizing;
  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;
    fFadeStep: Single;
    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 SetFadeStep(Value: Single);

    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 write fPicture;
    property FadeStep: Single read fFadeStep write SetFadeStep;

    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;


////////////////////////////////////////////////////////////////////////////////
procedure Register;

implementation
        
{$R JDNeedleGauge.dcr}

procedure Register;
begin
  RegisterComponents('JD Custom', [TJDNeedleGauge]);
end;        
////////////////////////////////////////////////////////////////////////////////


{ THotspots }

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
          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 XXX.AddHotspot(Position: TPoint; Value: String);
begin
  if not IsHotspot(Position) then
    fHotspots:= fHotspots +
      IntToStr(Position.X)+'x'+IntToStr(Position.Y)+'='+Value;
end;

function XXX.IsHotspot(Position: TPoint): Bool;
begin
  if pos(IntToStr(Position.X)+'x'+IntToStr(Position.Y)+'=', Self.fHotspots) > 0 then
    Result:= True else Result:= False;
end;

function XXX.HotspotValue(Position: TPoint): String;
var
  P, St, Sp: Integer;
  V: String;
begin
  P:= pos(IntToStr(Position.X)+'x'+IntToStr(Position.Y)+'=', Self.fHotspots);
  if P > 0 then
  begin
    V:= Self.fHotspots;
    Delete(V,1,P);
    St:= pos('=', V);
    Sp:= pos(';', V);
    Result:= Copy(V, St+1, Sp-St);
  end else begin
    Result:= '';
  end;
end;

 }



{ TNeedles }

constructor TNeedles.Create(AOwner: TJDNeedleGauge);
begin
  inherited Create(TNeedle);
  fOwner:= TJDNeedleGauge(AOwner);
end;

function TNeedles.GetOwner: TPersistent;
begin
  Result:= inherited GetOwner;

end;

function TNeedles.Add: TNeedle;
begin
  Result:= Inherited Add as TNeedle;
  if assigned(Result) then begin
    Result.fOwner:= TJDNeedleGauge(fOwner);
    Result.OnEvent:= NeedleEvent;
    NeedleEvent(Self);
  end;
end;

procedure TNeedles.NeedleEvent(Sender: TObject);
begin
  if assigned(fEvent) then fEvent(Self);
end;


{ TNeedle }

constructor TNeedle.Create(AOwner: TCollection);
begin
  inherited Create(AOwner);
  Self.fOwner:= TJDNeedleGauge(TNeedles(AOwner).fOwner);  
  Self.fTickMarks:= TTickMarks.Create(AOwner.Owner);
  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.fSizing:= gnsAuto;
  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.DoEvent;
begin
  TJDNeedleGauge(Self.fOwner).DoRefresh(False);
  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:= TTickMarks(Value);
  Self.DoEvent;
end;

procedure TNeedle.SetSizing(Value: TJDGNeedleSizing);
begin
  fSizing:= Value;
  Self.DoEvent;
end;


{ TTickMarks }

constructor TTickMarks.Create(AOwner: TPersistent);
begin
  inherited Create(TTickMark);
  fOwner:= TJDNeedleGauge(AOwner);
end;

function TTickMarks.GetOwner: TPersistent;
begin
  Result:= inherited GetOwner;

end;

function TTickMarks.Add: TTickMark;
begin
  Result:= Inherited Add as TTickMark;
  if assigned(Result) then begin
    Result.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;

function TTickMarks.GetItems(Index: Integer): TTickMark;
begin
  Result:= TTickMark(Inherited GetItem(Index));
end;

procedure TTickMarks.SetItems(Index: Integer; Value: TTickMark);
begin
  Inherited SetItem(Index, Value);
end;


{ TTickMark }

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;

procedure TTickMark.Assign(Source: TPersistent);
begin
  inherited Assign(TPersistent(Source));
end;


{ TJDNeedleGauge }

const
  BitmapPixelFormat = pf32bit;

constructor TJDNeedleGauge.Create(AOwner: TComponent);
var
  N: TNeedle;
  T: TTickMark;
begin
  inherited Create(AOwner);
  //if (assigned(AOwner)) and (AOwner <> nil) then
    Self.Parent:= TWinControl(AOwner);

  fPicture:= TPicture.Create;
  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;  
  Self.fNeedles:= TNeedles.Create(Self);
    fNeedles.fOwner:= TJDNeedleGauge(Self);
    fNeedles.OnEvent:= Self.OnNeedleEvent;

  Self.Width:= 200;
  Self.Height:= 200;
  Self.fBackColor:= clBlack;
  Self.fForeColor:= clNavy;    
  Self.fFadeStep:= 1;
  Self.OnMouseDown:= Self.MouseDown;
  Self.OnMouseUp:= Self.MouseUp;
  Self.OnMouseMove:= Self.MouseMove;

  N:= TNeedle(fNeedles.Add);
    N.Min:= 0;
    N.Max:= 100;
    N.Position:= 0;
    T:= TTickMark(N.TickMarks.Add);
      T.Increment:= 10;

  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, S, X: Integer;
  Count: Integer;
  Stop: Single;
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:= 1;
  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(Trunc((Sz / 2) - 1), 1, 1000);   //Radius
    R:= ( fForeColor and $ff);                    //Red
    G:= ((fForeColor and $ff00) shr 8);           //Green
    B:= ((fForeColor and $ff0000) shr 16);        //Blue
    Count:= 0;                                    //Set count to 0
    Stop:= L / fFadeStep;
    fBackground.Canvas.Brush.Color:= fForeColor;
    fBackground.Canvas.Pen.Color:= fForeColor;
    for X:= 0 to L do begin
      if (Count * fFadeStep) >= Stop then begin  
        Count:= 0;
        S:= Trunc((X / L) * 70);
        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 else begin
        Count:= Count + 1;
      end;
    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);
  case ANeedle.fSizing of
    gnsAuto: begin
      L:= Trunc((Sz / 3) - 10);
    end;
    gnsPixels: begin
      L:= ANeedle.fLength;
    end;
    gnsPercent: begin
      L:= Trunc((Sz / 3) - (Sz * ANeedle.Length));
    end;
  end;

  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.SetFadeStep(Value: Single);
begin
  Self.fFadeStep:= Value;
  if Value < 0 then Value:= 1;
  if Value > 800 then Value:= 800;
  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.

JD Solutions

Glenn9999 · Jun 26, 2011

Thanks for sharing!

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

djjd47130 · Jun 26, 2011

No problem, I just got really stuck with implementing the tick marks, and gave up. If you can get it working right, I'd love to get the fixed code. Otherwise it became an old dead project of mine.

JD Solutions

Glenn9999 · Jun 26, 2011

It'll go on the pile to be looked at more eventually, for sure.

It is not possible for anyone to acknowledge truth when their salary depends on them not doing it.

Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

Unfinished component up for grabs - in hopes someone will finish it 1

djjd47130

Programmer

Glenn9999

Programmer

djjd47130

Programmer

Glenn9999

Programmer

Similar threads

Part and Inventory Search

Sponsor