tiled.pas

Led (derived from TPanel) component with three colours: green,yellow,red

unit TILed;

interface

uses
  LedThread,Windows, SysUtils, Classes, Graphics, Controls,extctrls,Forms;

type
  TLedColor = (Green,Yellow,Red);
  TTILed = class(TPanel)
  private
    { Private declarations }
    fFadeSpeed : byte;
    fSmoothFlash : boolean;
    fDelayBeforeFade : integer;
    fIsLedOn : boolean;
    fLedColor : TLedColor;
  protected
    { Protected declarations }
    function GetLedStatus : boolean;
    procedure SetLedStatus (Enabled : boolean);
    function GetLedColor : TLedColor;
    procedure SetLedColor (LedColor : TLedColor);
    procedure SetColor;

    //procedure SetColor (Color : TColor);
    //function GetColor : TColor;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Flash;
  published
    { Published declarations }
    property LedFadeSpeed : byte read fFadeSpeed write fFadeSpeed;
    property LedSmoothFlash : boolean read fSmoothFlash write fSmoothFlash;
    property LedDelayBeforeFade : integer read fDelayBeforeFade write fDelayBeforeFade;
    property LedOn : boolean read GetLedStatus write SetLedStatus;
    property LedColor : TLedColor read GetLedColor write SetLedColor;
  end;

procedure Register;

implementation

constructor TTILed.Create(AOwner : TComponent);
begin
     inherited;
     Self.Height := 11;
     Self.Width := 28;
     Self.Caption := ' ';
     Self.Color := clGreen;
     fFadeSpeed := 20;
     fSmoothFlash := True;
     fDelayBeforeFade := 100;
     fLedColor := Green;
     LedOn := False;
end;

destructor TTILed.Destroy;
begin
     inherited;
end;

procedure TTILed.SetLedStatus (Enabled : boolean);
begin
     fIsLedOn := Enabled;
     SetColor;
end;

function TTILed.GetLedStatus : boolean;
begin
     Result := fIsLedOn;
end;


procedure TTiLed.SetLedColor (LedColor : TLedColor);
begin
     fLedColor := LedColor;
     SetColor;
end;

function TTILed.GetLedColor : TLedColor;
begin
     Result := fLedColor;
end;

procedure TTILed.SetColor;
var r,g,b : byte;
begin
     if fIsLedOn then
        begin
             //enabled led
             if LedColor = Green then
                Self.Color := clLime;
             if LedColor = Yellow then
                Self.Color := clYellow;
             if LedColor = Red then
                Self.Color := clRed;
        end
     else
         begin
              //disabled led
             if LedColor = Green then
                Self.Color := clGreen;
             if LedColor = Yellow then
                Self.Color := clOlive;
             if LedColor = Red then
                Self.Color := RGB(128,0,0);
         end;
end;

procedure TTiLed.Flash;
var TH : TLedThread;
begin
     TH := TLedThread.Create (Self);
     //TH.FreeOnTerminate := true;
     TH.Priority := tpNormal;
     //execute thread
     TH.Resume;
end;

procedure Register;
begin
  RegisterComponents('TI', [TTILed]);
end;

end.