Delphi: Master of Object Oriented Programming 1

[djjd47130]

Dear All,

I'm not quite sure whether to consider this a recommendation, reminder, or just an annoyance when I observe much of the code I find for Delphi. Obviously, Delphi has been made so you can build powerful apps in an easy pascal language. However, all Delphi users must keep in mind the overall purpose of Object Oriented Pascal.

By default, you create a new application, and maybe 80% of the time you would immediately start dropping components onto the main form. You would be surprised how many people don't understand how the form is really created behind the scenes. Now I'm sure we all know what objects are, of course. A form is an object. You declare it at the top, and implement it (if any) at the bottom. This applies literally for ALL components out there.

Now for making very simple applications and small examples, no biggie to throw a few controls on a form and work directly with those controls from wherever, even other units. I, however, absolutely hate storing variables basically wherever, whether in the form's private, public, or even outside the form component. 98% of the time, I create an object for every conceivable set of similar information before I ever drop any components onto a form, and I do so in a unit of its own.

For those who are going 'huh?'... take this example of storing DB connection info:

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB;

type
  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    ServerName: String;
    DatabaseName: String;
    LoginName: String;
    Password: String;
    Provider: String;
    Persist: Boolean;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  ServerName:= 'MyServerName\Instance';
  DatabaseName:= 'MyDatabaseName';
  LoginName:= 'sa';
  Password:= 'yourpasswordhere';
  Provider:= 'SQLOLEDB.1';
  Persist:= False;

  ADOConnection1.ConnectionString:=
    'Provider=' + Provider +
    ';Password=' + Password +
    ';Persist Security Info=';
  if Persist then
    ADOConnection1.ConnectionString:= ADOConnection1.ConnectionString + 'True'
  else
    ADOConnection1.ConnectionString:= ADOConnection1.ConnectionString + 'False';
  ADOConnection1.ConnectionString:= ADOConnection1.ConnectionString +
    ';User ID=' + LoginName +
    ';Initial Catalog=' + DatabaseName +
    ';Data Source=' + ServerName;
end;

end.

Now how would I go about this? Simple..

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, DB, ADODB;

type

  TDBProvider = (dpSQLOLEDB, dpSQLNCLI);

  TDBConnection = class(TObject)
    private
      fServer: String;
      fDatabase: String;
      fLogin: String;
      fPassword: String;
      fProvider: TDBProvider;
      fPersist: Boolean;
      function GetConnectionString: String;
    public
      constructor Create; override;
      constructor Create(Server: String; Database: String; Login: String;
        Password: String; Provider: TDBProvider; Persist: Boolean); override;
      property Server: String read fServer write fServer;
      property Database: String read fDatabase write fDatabase;
      property Login: String read fLogin write fLogin;
      property Password: String read fPassword write fPassword;
      property Provider: TDBProvider read fProvider write fProvider;
      property Persist: Boolean read fPersist write fPersist;
      property ConnectionString: String read GetConnectionString;
  end;


  TForm1 = class(TForm)
    ADOConnection1: TADOConnection;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    Connection: TDBConnection;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.FormCreate(Sender: TObject);
begin
  Connection.Server:= 'MyServerName\Instance';
  Connection.Database:= 'MyDatabaseName';
  Connection.Login:= 'sa';
  Connection.Password:= 'yourpasswordhere';
  Connection.Provider:= dpSQLOLEDB;
  Connection.Persist:= False;
  ADOConnection1.ConnectionString:= Connection.ConnectionString;
end;

function TDBConnection.GetConnectionString: String;
var
  Pers, Prov: String;
begin
  //I would normally do more error checking here
  if Self.fPersist then
    Pers:= 'True'
  else
    Pers:= 'False';
  case Self.fProvider of
    dpSQLOLEDB: Prov:= 'SQLOLEDB.1';
    dpSQLNCLI: Prov:= 'SQLNCLI';
  end;
  Result:=
    'Provider=' + Prov +
    ';Password=' + Password +
    ';Persist Security Info=' + Pers +
    ';User ID=' + LoginName +
    ';Initial Catalog=' + DatabaseName +
    ';Data Source=' + ServerName;
end;

constructor TDBConnection.Create;
begin
  //Default values
  Self.fServer:= '(local)';
  Self.fDatabase:= 'master';
  Self.fLogin:= 'sa';
  Self.fPassword:= '';
  Self.fProvider:= dpSQLOLEDB;
  Self.fPersist:= False;
end;

constructor TDBConnection.Create(Server: String; Database: String; Login: String;
  Password: String; Provider: TDBProvider; Persist: Boolean); 
begin
  Self.fServer:= Server;
  Self.fDatabase:= Database;
  Self.fLogin:= Login;
  Self.fPassword:= Password;
  Self.fProvider:= Provider;
  Self.fPersist:= Persist;
end;

end.

This way, everything which is related to each other is contained within its own object.

Now there are many other things you can do with this, like with this example, I could put a TADOConnection directly in this object, auto create/destroy it in the object's constructor/destructor methods, and direct the properties to automatically create the connection string upon connecting. This involves a lot more hands-on work, which I've already done (however very specific to my own needs so I'm not very willing to post everything I have).

To make a long story short, however, the point of using objects is to capture all commonly working code into one single place. This keeps you organized, flexible, and it's reusable. Of course my example above I made the object in the same unit, which it's recommended to put them in their own units.

Generally, almost all of delphi is already object oriented pascal, and it breaks my heart to see people not using its capabilities as they should. Most of you **should** know what I'm talking about, but this reminder goes out for those who don't seem to get it.

 

[djjd47130]

Adding on to that, you can also create a list of these objects, rather than an array of values. I personally hate arrays too, I always create a list of objects holding all the variables I need. The TDBConnection above (as mentioned) can be re-used over and over for different purposes.

Now the beauty of the properties is that you can tell it whether to read/write a value directly, or to use a procedure/function to read/write those values.I could have done...

  private
    fServer: String;

    procedure SetServer(Value: String);

    function GetServer: String;

  public

    property Server: String read GetServer write SetServer;



then read/write those values wherever they need to go/come from, as well as perform error checks and validation.

You can even go further with creating components with events using this same structure. For example, my current project is a set of components for viewing a remote desktop, as well as taking control. These components are huge, and structured the same way I described above. The client component, for example, has properties for the host, as well as has client sockets attached. When I set the Host property, it hits the SetHost(Value: String) procedure which a- validates the host name, b- checks if sockets are active, and c- sets the host values of all the sockets at once with the new value (if passed the tests).

Again, the overall purpose of objects is to gather everything related to the same thing into one place. I just wanted to share my pain with everyone, considering there's tons of people out there who can't seem to get a grip on objects and how they work, and what they're useful for.

 

[djjd47130]

oops forgot to put

[/code]

I typed that directly into there lol

 

[sggaunt]

Hmm not sure I get the point of this, are you the OOP police?
If its really so important why not programm in Eieffel, Smalltalk or Ruby? (Java ?)





Steve: N.M.N.F.
If something is popular, it must be wrong: Mark Twain

 

[djjd47130]

Well first of all, thanks for your opinion, it's always welcome.

You will notice that I like to share a lot of my opinions to try to help newcomers understand certain practices. I myself am a Delphi geek, and spend probably 80% of my time working with Delphi for the past 3 years, and I have taught myself everything I know (therefore I cannot consider myself any type of expert or genious).

Honestly, I don't see myself even working with any other language other than Delphi (and SQL). Please note this is the Delphi forums. I could have gone on and on and on about OOP but only covered the basics here.

Another point I was trying to make here was that Delphi is designed around the concept of Objects and Inheriting objects from existing ones, and has been optimized to make it as simple as possible, yet I see many people new to programming are not using its full potential. Sure, everyone's welcome to use it however they want; if it works, it works. However, when it comes to building much larger applications which become important to be carefully structured, it's a horrible practice to, for example, declare variables and methods directly in the unit rather than inside an object.

The use of objects has made my life so much easier and organized, and I'd like to share my opinion and recommend everyone at least consider this practice. Please keep in mind it may be a little tricky and difficult to understand them at first, but once you know how to work with them, everything becomes common sense and a second nature to always rely on a solid object structure.

Be expecting me to put more of my tips and opinions here; as long as these forums give you the ability to post your own tips and opinions, I plan to take advantage of that opportunity.

Take care, and happy coding

 

[DjangMan]

I appreciate the post. I consider myself an application developer and not a nuts and bolts programmer. I'm still learning stuff all the time. Although I understand the value of OOP I don't use it nearly enough. Everytime I create a new object I'm pretty happy that I did.

 

[roo0047]

... it's a horrible practice to, for example, declare variables and methods directly in the unit rather than inside an object.

Just curious, but does your version of Delphi include any of the RTL source?

Roo
Delphi Rules!

 

[whosrdaddy]

Come on guys,

he's got a point here....
It all boils down to design patterns.
I've done a lot a C# development lately and I'm becoming a big fan of that language ( delphi/oop was my first love and it will always stay that way).
It has affected me in such a way that I'm starting to introduce design patterns that are used widely in C# into my delphi projects.
Most important 5 design patters are called S.O.L.I.D.
more info here.

In the end the ultimate goal is to code easier and better...

/Daddy




-----------------------------------------------------
What You See Is What You Get
Never underestimate tha powah of tha google!

 

[djjd47130]

I would like to point out that I've been working with Delphi for about 3 years, and still learning. Prior to Delphi I knew a little VB, but have not touched VB at all since I learned Delphi. Therefore, you can consider me a beginner, considering I don't know many languages, been using Delphi for 3 years, and never had any official schooling. However, I do know what it takes to structure a project properly. However you define proper is up to you, but I consider proper as clean, to the point, organized, flexible, expandable, and easy to understand. In other words, it needs to be in a way where if you handed the project to someone else who knows nothing about it, and don't tell them how it works, they need to be able to figure everything out by themselves in the the shortest amount of time and without much struggle. Most of my development time goes to figuring out the most optimal solution to start with, instead of throwing something together and getting lost and having to re-do it down the road. Flexibility and organization are my two most important standards in designing and structuring a program.

 

[djjd47130]

Another funny point is that I never actually compiled and tested the above code, i just threw it together real quick, otherwise I would have caught the fact that I'm not creating or freeing this object at all...... another obviously important aspect of programming with objects....... I never even checked the syntax or anything. That is just a quick example of how the object needs to be made, not necessarily how it should be implemented

 

[djjd47130]

Though I'd share some code in here, although possibly pointless for use, it helps demonstrate real implementation of a component. This is an object I'm currently making to split an image into smaller pieces and put back together. I'm making it for a much larger remote desktop system I'm developing. Although not quite done yet, it does work. However, the performance needs to be tweaked a little.

unit JDRMImageSplitter;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, JPeg, StrUtils;

type

  TJDRMBit = class(TObject)
    private
      fBitmap: TBitmap;
      fPosition: TPoint;
      fDateTime: TDateTime;
      
    public
      constructor Create;
      destructor Destroy; override;
      property Position: TPoint read fPosition write fPosition;
      property DateTime: TDateTime read fDateTime write fDateTime;
      property Bitmap: TBitmap read fBitmap write fBitmap;

  end;


  TJDRMImageSplitter = class(TObject)
    private
      fBitmap: TBitmap;
      fHCount: Integer;
      fVCount: Integer;
      fWidth: Integer;
      fHeight: Integer;
      fBitWidth: Integer;
      fBitHeight: Integer;

      procedure SetBitmap(Value: TBitmap);
      function GetBitmap: TBitmap;
      procedure SetVCount(Value: Integer);
      procedure SetHCount(Value: Integer);

    public
      constructor Create;
      destructor Destroy; override;
      function GetBit(X, Y: Integer): TJDRMBit;
      procedure SetBit(X, Y: Integer; Value: TJDRMBit);
      procedure SetImage(Bitmap: TBitmap);
      property VCount: Integer read fVCount write SetVCount;
      property HCount: Integer read fHCount write SetHCount;
      property Bitmap: TBitmap read GetBitmap write SetBitmap;

  end;


implementation


constructor TJDRMBit.Create;
begin
  Self.fBitmap:= TBitmap.Create;
end;

destructor TJDRMBit.Destroy;
begin
  if assigned(Self.fBitmap) then
    Self.fBitmap.Free;
end;


constructor TJDRMImageSplitter.Create;
begin
  inherited Create;
  Self.fBitmap:= TBitmap.Create;
end;

destructor TJDRMImageSplitter.Destroy;
begin
  if assigned(Self.fBitmap) then Self.fBitmap.Free;
  inherited Destroy;
end;

procedure TJDRMImageSplitter.SetBitmap(Value: TBitmap);
begin
  Self.fBitmap:= Value;
  Self.fWidth:= fBitmap.Width;
  Self.fHeight:= fBitmap.Height;
end;

procedure  TJDRMImageSplitter.SetVCount(Value: Integer);
begin
  Self.fVCount:= Value;
  Self.fBitHeight:= Round(Self.fBitmap.Height / Self.fVCount);
end;

procedure  TJDRMImageSplitter.SetHCount(Value: Integer);
begin
  Self.fHCount:= Value;
  Self.fBitWidth:= Round(Self.fBitmap.Width / Self.fHCount);
end;

function TJDRMImageSplitter.GetBitmap: TBitmap;
begin
  Result:= Self.fBitmap;
end;

procedure TJDRMImageSplitter.SetImage(Bitmap: TBitmap);
begin
  Self.fBitmap.Assign(Bitmap);
  Self.fWidth:= Bitmap.Width;
  Self.fHeight:= Bitmap.Height;
end;

function TJDRMImageSplitter.GetBit(X, Y: Integer): TJDRMBit;
var
  R: TRect;
begin
  if (X >= 0) and (X < Self.fHCount) and
     (Y >= 0) and (Y < Self.fVCount) then
  begin
    Result:= TJDRMBit.Create;
    R.Left:= fBitWidth * X;
    R.Top:= fBitHeight * Y;
    R.Right:= fWidth - fBitWidth * (Self.fHCount - X - 1);
    R.Bottom:= fHeight - fBitHeight * (Self.fVCount - Y - 1);
    Result.fBitmap.Width:= fBitWidth;
    Result.fBitmap.Height:= fBitHeight;
    Result.fPosition:= Point(X,Y);
    Result.fDateTime:= Now;
    Result.fBitmap.Canvas.CopyRect(Rect(0,0,fBitWidth,fBitHeight), Self.fBitmap.Canvas, R);
  end else begin
    raise exception.Create('Bit index out of bounds ['+IntToStr(X)+','+IntToStr(Y)+']');
  end;
end;

procedure TJDRMImageSplitter.SetBit(X, Y: Integer; Value: TJDRMBit);
var
  R: TRect;
begin
  if (X >= 0) and (X < Self.fHCount) and
     (Y >= 0) and (Y < Self.fVCount) then
  begin
    if assigned(Value) then begin
      if (Value.fBitmap.Width = Self.fBitWidth) and (Value.fBitmap.Height = Self.fBitHeight) then
      begin
        R.Left:= fBitWidth * X;
        R.Top:= fBitHeight * Y;
        R.Right:= Self.fBitmap.Width - fBitWidth * (Self.fHCount - X - 1);
        R.Bottom:= Self.fBitmap.Height - fBitHeight * (Self.fVCount - Y - 1);
        Self.fBitmap.Canvas.CopyRect(R, Value.fBitmap.Canvas, Rect(0,0,fBitWidth,fBitHeight));
      end else begin
        raise exception.Create('Sizes do not match');
      end;
    end;
  end else begin
    raise exception.Create('Bit index out of bounds ['+IntToStr(X)+','+IntToStr(Y)+']');
  end;
end;

end.

 

[djjd47130]

I've come a long way since this previous code I've posted and have a much larger project now. The code above won't even necessarily work properly, I found a few things wrong with it. Unfortunately these units are too big and complex to post it all.

Delphi has worked wonders for me; ever since I learned it, I've never gone back to VB or picked up any other language. Anything you can build with most other languages you can do in Delphi, and it's much easier. It's especially handy how you can really do all sorts of things with objects, like inheriting from other objects or components, triggering events, and making your own components.

I've also found Delphi much easier to use with SQL. I do tons of work with SQL and the ADO components for Delphi really make it simple. Pascal in general really beats most other languages in my opinionl

 

[djjd47130]

Just another random code sharing...

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.

JD Solutions

 

[djjd47130]

The above component is a needle gauge. It is far from complete, and is in some in-between conversion stages. I just posted it to demonstrate another use of OOP. This is my latest project and should be done in the next couple weeks. You're welcome to use it for whatever. Most of the functionality works (even more was working before I started converting some things). I may post the final one here again when it's done.


JD Solutions