{------------------------------------------------------------------------------}
{
   Unit Name: kRndled
   Purpose  : TkRoundLed component
   Author   : Martyn Dowsett CIS 100676,1560
   Date     : 1995
   Changed  : 10.1.1997/Vesa Lappalainen
       + more colors
       + LedOn
       + save colors to inifile

   ToDo     :
}
{------------------------------------------------------------------------------}

{---------------------------------------------------------------}
{	        TRoundLed component v1.1 copyright 1995		}
{	            Martyn Dowsett CIS 100676,1560              }
{	Please feel free to use this component as you see fit.  }
{                                                               )
(	Any comments or suggestions for other components are    }
{	greatfully received.					}
{                                                               }
{	NOTE: Please see roundled.txt and about.txt for         }
{	      more information. 				}
{---------------------------------------------------------------}


unit kRndled;
{$R RNDLED.RES}
interface

uses
  SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  Forms, Dialogs, ExtCtrls,
//  DsgnIntf,
  IniName;

const MAXLCCOLOR = 7;

type
	TLedStatus    = (lsOff, lsOn, lsBlink);

	TLedOnColors  = (lcSilver, lcRed,    lcLime, lcYellow,
					 lcBlue,   lcFuchsia, lcAqua, lcWhite);

	TLedOffColors = (lcBlack, lcMaroon, lcGreen, lcOlive,
					 lcNavy,  lcPurple, lcTeal, lcGray);

	TActualColors = array[0..MAXLCCOLOR] of TColor;

const
	ActualOnColors: TActualColors = (clSilver, clRed, clLime, clYellow,
									 clBlue, clFuchsia, clAqua, clWhite);

	ActualOffColors: TActualColors = (clBlack, clMaroon, clGreen, clOlive,
									  clNavy, clPurple, clTeal, clGray);
type
  TkRndLed = class(TCustomControl)
  private
    { Private declarations }
    FLedPiccy: TBitmap;
    FLedTimer: TTimer;
    FLedIsOn: boolean;
    FLedRect: TRect;
    FLedBulbRect: TRect;
//	 FAbout: TAboutBox;

    FAutoSelectColor: boolean;
    FLedOnColor: TLedOnColors;
    FLedOffColor: TLedOffColors;
    FLedOnRealColor : TColor;
    FLedOffRealColor : TColor;
    FLedNegRealColor : TColor;
    FBlinkRate: word;
    FLedStatus: TLedStatus;
    FIniName : string;
    FIniSection : string;
    FBlinking : boolean;
    FValue : integer;
    FAllowEdit : boolean;

    procedure SetLedOffColor(value: TLedOffColors);
    procedure SetLedOnColor(value: TLedOnColors);
    procedure SetLedOffRealColor(value: TColor);
    procedure SetLedOnRealColor(value: TColor);
    procedure SetLedNegRealColor(value: TColor);
    procedure SetLedStatus(value: TLedStatus);
    procedure SetBlinkRate(value: word);
    procedure DrawColor;
    procedure SetColor;
    procedure WriteIniFile;
    function GetLedOn : boolean;
    procedure SetLedOn(value: boolean);
    procedure SetBlinking(value: boolean);
    procedure SetIntRate(value: integer);
    function GetIntRate : integer;
    procedure SetValue(value: integer);
    procedure CheckState;
  protected
    { Protected declarations }
    procedure Paint; override;
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
    procedure BlinkTimeLimit(Sender: TObject);
    procedure Loaded; override;
    procedure MouseUp(Button: TMouseButton; Shift: TShiftState;
               X, Y: Integer); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure ReadIniFile;
  published
//	 property About: TAboutBox read FAbout write FAbout;
    property AllowEdit : Boolean read FAllowEdit write FAllowEdit default True;
    property AutoSelectColor: boolean read FAutoSelectColor write FAutoSelectColor default True;
    property LedOnColor: TLedOnColors read FLedOnColor write SetLedOnColor default lcRed;
    property LedOffColor: TLedOffColors read FLedOffColor write SetLedOffColor default lcMaroon;
    property LedOnRealColor: TColor read FLedOnRealColor write SetLedOnRealColor;
    property LedOffRealColor: TColor read FLedOffRealColor write SetLedOffRealColor;
    property LedNegRealColor: TColor read FLedNegRealColor write SetLedNegRealColor;
    property BlinkRate: word read FBlinkRate write SetBlinkRate default 1000;
    property LedStatus: TLedStatus read FLedStatus write SetLedStatus default lsOff;
    property IniName : string read FIniName write FIniName;
    property IniSection : string read FIniSection write FIniSection;
    property LedOn : boolean read GetLedOn write SetLedOn default false;
    property Value : integer read FValue write SetValue default 0;
    property Blinking : boolean read FBlinking write SetBlinking default false;
    property IntBlinkRate : integer  read GetIntRate write SetIntRate;
    property OnClick;
    property OnMouseDown;
    property OnMouseUp;
    property OnDblClick;
    property Visible;
  end;

procedure Register;

implementation
uses IniFiles,kini,kstring,krndcol;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetIntRate(value: integer);
begin
  blinking := ( value > 0 );
  if blinking then BlinkRate := value else BlinkRate := -value;
//  BlinkRate := value;
end;


{------------------------------------------------------------------------------}
function TkRndLed.GetIntRate : integer;
begin
  Result  := BlinkRate;
  if ( Not Blinking ) then Result  := -Result;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.MouseUp(Button: TMouseButton; Shift: TShiftState;
  X, Y: Integer);
var f:TFormRndLedColor;
begin
  if (Button = mbRight) and AllowEdit then begin
    f := TFormRndLedColor.Create(NIL);
    f.EditColor(self);
    f.free;
    Abort;
  end;
  inherited MouseUp(Button, Shift, X, Y);
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetColor;
begin
  LedOnRealColor := ActualOnColors[ord(FLedOnColor)];
  LedOffRealColor := ActualOffColors[ord(FLedOffColor)];
end;

{------------------------------------------------------------------------------}
constructor TkRndLed.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FLedPiccy := TBitmap.Create;
  FLedPiccy.Handle := LoadBitmap(hInstance, 'GENERICLED');
  with FLedRect do
  begin
          Top := 0;
          Left := 0;
          Right := FLedPiccy.Width;
          Bottom := FLedPiccy.Height;
  end;
  {This TRect stores dimensions for 'filament' of LED}
  with FLedBulbRect do
  begin
          Top := 5;
          Left := 5;
          Right := 10;
          Bottom := 10;
  end;
  {Set defaults}
  FAutoSelectColor := True;
  FBlinkRate :=1000;
  Width := FLedPiccy.Width;
  FLedOffColor := lcMaroon;
  FLedOnColor := lcRed;
  FLedStatus := lsOff;
  FLedIsOn := false;
  FValue := 0;
  FBlinking := false;
  Height := FLedPiccy.Height;
  FIniName := '';
  FIniSection := 'Leds';
  FAllowEdit := True;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.ReadIniFile;
var  Ini:TIniFile; br : integer; st : string;
begin
  if ( IniName = '-' ) then exit;
  Ini := TIniFile.Create(GetIniName(IniName));
  if ( Ini = NIL ) then exit;
  st := Ini.ReadString(IniSection,Name,'');

  br := SeparateInt(st,',',-9999);
  if ( br <> -9999 ) then IntBlinkRate := br;

  FLedOnRealColor := SeparateInt(st,',',FLedOnRealColor);
  FLedOffRealColor := SeparateInt(st,',',FLedOffRealColor);
  FLedNegRealColor := SeparateInt(st,',',FLedNegRealColor);
  Invalidate;
  Ini.Free;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.WriteIniFile;
var Ini:TIniFile; var st:string;
begin
  if ( IniName = '-' ) then exit;
  Ini := TIniFile.Create(GetIniName(IniName));
  if ( Ini = NIL ) then exit;
  st := IntToStr(IntBlinkRate)     + ',' +
        HexSt(FLedOnRealColor,6)   + ',' +
        HexSt(FLedOffRealColor,6)  + ',' +
        HexSt(FLedNegRealColor,6);
  Ini.WriteString(IniSection,Name,st);
  Ini.Free;
end;


{------------------------------------------------------------------------------}
procedure TkRndLed.Loaded;
begin
  inherited Loaded;
  ReadIniFile;
end;

{------------------------------------------------------------------------------}
destructor TkRndLed.Destroy;
begin
  FLedPiccy.Free;
  if assigned(FLedTimer) then FLedTimer.Free;
  inherited Destroy;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.DrawColor;
begin
  with Canvas do begin
    {Draw colored section of led}
    if FLedIsOn then
      if ( value > 0 ) then Brush.Color := LedOnRealColor
      else                  Brush.Color := LedNegRealColor
    else                    Brush.Color := LedOffRealColor;
    BrushCopy(FLedBulbRect,FLedPiccy, FLedBulbRect, clMaroon);
  end;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.Paint;
begin
  Canvas.Brush.Color := (Parent as TWinControl).Brush.Color;
  Canvas.BrushCopy(FLedRect,FLedPiccy, FLedRect, clOlive);
  DrawColor;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.WMSize(var Message: TWMSize);
begin
  {Keep control the same size as the LED bitmap}
  inherited;
  Width := FLedPiccy.Width;
  Height := FLedPiccy.Height;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetLedOffColor(value: TLedOffColors);
begin
  FLedOffColor := value;
  if FAutoSelectColor then FLedOnColor := TLedOnColors(FLedOffColor);
  SetColor;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetLedOnColor(value: TLedOnColors);
begin
  FLedOnColor := value;
  if FAutoSelectColor then FLedOffColor:= TLedOffColors(FLedOnColor);
  SetColor;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetLedNegRealColor(value: TColor);
begin
  if ( FLedNegRealColor = value ) then exit;
  FLedNegRealColor := value;
  if ( not (csLoading in ComponentState) ) then  WriteIniFile;
  Invalidate;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetLedOffRealColor(value: TColor);
begin
  if ( FLedOffRealColor = value ) then exit;
  FLedOffRealColor := value;
  if ( not (csLoading in ComponentState) ) then  WriteIniFile;
  Invalidate;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetLedOnRealColor(value: TColor);
begin
  if ( FLedOnRealColor = value ) then exit;
  FLedOnRealColor := value;
  if ( not (csLoading in ComponentState) ) then  WriteIniFile;
  Invalidate;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetLedStatus(value: TLedStatus);
begin
  if value <> FLedStatus then begin
    if assigned(FLedTimer) then begin
      FLedTimer.Free;
      FLedTimer := nil;
    end;
    FLedStatus := value;
    case FLedStatus of
      lsOff:   FLedIsOn := false;
      lsOn:    FLedIsOn := true;
      lsBlink: begin
                 FLedIsOn := true;
                 FLedTimer := TTimer.Create(Self);
                 FLedTimer.OnTimer := BlinkTimeLimit;
                 FLedTimer.Interval := FBlinkRate;
                 FLedTimer.Enabled := true;
               end;
    end;
    Invalidate;
  end;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.BlinkTimeLimit(Sender: TObject);
begin
  {This routine is called when the BlinkTime counter has been reached}
  FLedIsOn := not FLedIsOn;
  DrawColor;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetBlinkRate(value: word);
begin
  if value <> FBlinkRate then begin
    FBlinkRate := value;
    if assigned(FLedTimer) then FLedTimer.Interval := FBlinkRate;
  end;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.CheckState;
begin
  if ( Blinking and LedOn ) then LedStatus := lsBlink
  else if ( LedOn ) then LedStatus := lsOn
  else LedStatus := lsOff;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetLedOn(value: boolean);
begin
  FValue := ord(value);
  CheckState;
end;

{------------------------------------------------------------------------------}
function TkRndLed.GetLedOn : boolean;
begin
  Result := Value <> 0;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetBlinking(value: boolean);
begin
  FBlinking := value;
  CheckState;
end;

{------------------------------------------------------------------------------}
procedure TkRndLed.SetValue(value: integer);
begin
  FValue := value;
  CheckState;
end;

procedure Register;
begin
  RegisterComponents('Kave2000', [TkRndLed]);
end;


end.