{********************************************************************}
{                                                                    }
{ written by TMS Software                                            }
{            copyright © 2013                                        }
{            Email : info@tmssoftware.com                            }
{            Web : http://www.tmssoftware.com                        }
{                                                                    }
{ The source code is given as is. The author is not responsible      }
{ for any possible damage done due to the use of this code.          }
{ The complete source code remains property of the author and may    }
{ not be distributed, published, given or sold in any form as such.  }
{ No parts of the source code can be included in any other component }
{ or application without written authorization of the author.        }
{********************************************************************}

unit FMX.TMSLed;

interface

{$I TMSDEFS.INC}

uses
  FMX.Types, FMX.Objects, Classes, SysUtils, Types,
  UITypes, FMX.TMSBasecontrol, UIConsts, FMX.Styles
  {$IFDEF DELPHIXE5_LVL}
  , FMX.Graphics
  {$ENDIF}
  ;

const
  MAJ_VER = 1; // Major version nr.
  MIN_VER = 5; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 0; // Build nr.

  // version history
  // v1.0.0.0 : first release
  // v1.0.4.2 : Reorganized packages
  // v1.0.5.0 : New : support for update 4
  // v1.0.5.1 : Improved : TMSIOS define
  // v1.0.5.2 : New : support for update 4 hotfix 1
  // v1.0.5.3 : Fixed : Issue with memoryleak
  // v1.0.5.4 : Fixed : Issue with absoluteopacity
  // v1.5.0.0 : New : support for XE4

type
  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXLED = class(TTMSFMXBaseShape)
  private
    FBaseColor: TAlphaColor;
    FOffColor: TAlphaColor;
    FOnColor: TAlphaColor;
    FState: Boolean;
    procedure SetBaseColor(const Value: TAlphaColor);
    procedure SetOffColor(const Value: TAlphaColor);
    procedure SetOnColor(const Value: TAlphaColor);
    procedure SetState(const Value: Boolean);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Draw(ACanvas: TCanvas; R, RB: TRectF; ARotationAngle: Single);
    procedure Paint; override;
    procedure Toggle;
  published
    property BaseColor: TAlphaColor read FBaseColor write SetBaseColor default claRed;
    property OnColor: TAlphaColor read FOnColor write SetOnColor;
    property OffColor: TAlphaColor read FOffColor write SetOffColor;
    property State: Boolean read FState write SetState default False;
  end;

  TTMSFMXLEDBar = class;

  TTMSFMXLEDItem = class(TCollectionItem)
  private
    FLed: TTMSFMXLED;
    FOwner: TTMSFMXLEDBar;
    function GetBaseColor: TAlphaColor;
    function GetOffColor: TAlphaColor;
    function GetOnColor: TAlphaColor;
    function GetState: Boolean;
    procedure SetBaseColor(const Value: TAlphaColor);
    procedure SetOffColor(const Value: TAlphaColor);
    procedure SetOnColor(const Value: TAlphaColor);
    procedure SetState(const Value: Boolean);
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property BaseColor: TAlphaColor read GetBaseColor write SetBaseColor;
    property OnColor: TAlphaColor read GetOnColor write SetOnColor;
    property OffColor: TAlphaColor read GetOffColor write SetOffColor;
    property State: Boolean read GetState write SetState;
  end;

  TTMSFMXLEDs = class(TTMSFMXBaseCollection)
  private
    FOwner: TTMSFMXLEDBar;
    function GetItem(Index: Integer): TTMSFMXLEDItem;
    procedure SetItem(Index: Integer; const Value: TTMSFMXLEDItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TTMSFMXLEDBar);
    function Add: TTMSFMXLEDItem;
    function Insert(Index: Integer): TTMSFMXLEDItem;
    property Items[Index: Integer]: TTMSFMXLEDItem read GetItem write SetItem; default;
  end;

  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXLEDBar = class(TTMSFMXBaseControl)
  private
    FValue: Integer;
    FLeds: TTMSFMXLEDs;
    FSpacing: Integer;
    procedure SetCount(const Value: Integer);
    procedure SetLeds(const Value: TTMSFMXLEDs);
    procedure SetValue(const Value: Integer);
    function GetCount: Integer;
    procedure SetSpacing(const Value: Integer);
    function GetVersion: String;
    function GetVersionNr: Integer;
  protected
    function GetInstance: NativeUInt; override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
    destructor Destroy; override;
  published
    property Fill;
    property Stroke;
    property StrokeThickness;
    property StrokeCap;
    property StrokeDash;
    property StrokeJoin;

    property Version: String read GetVersion;
    property Leds: TTMSFMXLEDs read FLeds write SetLeds;
    property Count: Integer read GetCount write SetCount default 6;
    property Value: Integer read FValue write SetValue default 0;
    property Spacing: Integer read FSpacing write SetSpacing default 5;
  end;

implementation

uses
  Math;

{ TTMSFMXLED }

constructor TTMSFMXLED.Create(AOwner: TComponent);
var
  H, S, L: Single;
begin
  inherited;
  Width := 25;
  Height := 25;
  FBaseColor := claRed;
  RGBtoHSL(FBaseColor, H, S, L);
  FOnColor := FBaseColor;
  FOffColor := HSLtoRGB(H, S, L * 0.5);
end;

procedure TTMSFMXLED.Draw(ACanvas: TCanvas; R, RB: TRectF; ARotationAngle: Single);
var
  pt: TGradientPoint;
begin
  {$IFDEF DELPHIXE6_LVL}
  ACanvas.Fill.Kind := TBrushKind.Solid;
  {$ELSE}
  ACanvas.Fill.Kind := TBrushKind.bkSolid;
  {$ENDIF}
  if State then
    ACanvas.Fill.Color := OnColor
  else
    ACanvas.Fill.Color := OffColor;

  ACanvas.FillEllipse(R, AbsoluteOpacity);

  ACanvas.Stroke.Color := claGray;
  ACanvas.DrawEllipse(R, AbsoluteOpacity);

  {$IFDEF DELPHIXE6_LVL}
  ACanvas.Fill.Kind := TBrushKind.Gradient;
  {$ELSE}
  ACanvas.Fill.Kind := TBrushKind.bkGradient;
  {$ENDIF}
  ACanvas.Fill.Gradient.Points.Clear;

  pt := (ACanvas.Fill.Gradient.Points.Add as TGradientPoint);
  pt.Color := MakeColor(claWhite, 0.65);
  pt.Offset := 0;
  pt := (ACanvas.Fill.Gradient.Points.Add as TGradientPoint);
  pt.Color := MakeColor(claWhite, 0.1);
  pt.Offset := 1;
  ACanvas.FillRect(RectF(R.Left + R.Width * 0.2,R.Top + R.Height * 0.05, R.Left + R.Width * 0.8, R.Top + R.Height * 0.40), r.Width / 2, r.Height / 2, AllCorners, AbsoluteOpacity);

  ACanvas.Fill.Gradient.Points.Clear;
  pt := (ACanvas.Fill.Gradient.Points.Add as TGradientPoint);
  pt.Color := MakeColor(claWhite, 0);
  pt.Offset := 0.6;
  pt := (ACanvas.Fill.Gradient.Points.Add as TGradientPoint);
  pt.Color := MakeColor(claWhite, 0.65);
  pt.Offset := 1;

  ACanvas.FillRect(RectF(R.Left + R.Width * 0.05, R.Top + R.Height * 0.05, R.Left + R.Width * 0.95, R.Top + R.Height * 0.95), R.Width / 2, r.Height / 2, AllCorners, AbsoluteOpacity);
end;

procedure TTMSFMXLED.Paint;
var
  R: TRectF;
begin
  inherited;
  R := BoundsRect;
  Draw(Canvas, R, R, RotationAngle);
end;

procedure TTMSFMXLED.SetBaseColor(const Value: TAlphaColor);
var
  H, S, L: Single;
begin
  FBaseColor := Value;
  if not (csloading in ComponentState) then
  begin
    RGBtoHSL(FBaseColor, H, S, L);
    FOnColor := FBaseColor;
    FOffColor := HSLtoRGB(H, S, L * 0.5);
  end;
  Repaint;
end;

procedure TTMSFMXLED.SetOffColor(const Value: TAlphaColor);
begin
  if FOffColor <> Value then
  begin
    FOffColor := Value;
    Repaint;
  end;
end;

procedure TTMSFMXLED.SetOnColor(const Value: TAlphaColor);
begin
  if FOnColor <> Value then
  begin
    FOnColor := Value;
    Repaint;
  end;
end;

procedure TTMSFMXLED.SetState(const Value: Boolean);
begin
  if FState <> Value then
  begin
    FState := Value;
    Repaint;
  end;
end;

procedure TTMSFMXLED.Toggle;
begin
  State := not State;
end;

{ TTMSFMXLEDItem }

constructor TTMSFMXLEDItem.Create(Collection: TCollection);
begin
  inherited;
  FOwner := (Collection as TTMSFMXLEDs).FOwner;
  FLed := TTMSFMXLED.Create(FOwner);
  FOwner.Value := FOwner.Value;
end;

destructor TTMSFMXLEDItem.Destroy;
begin
  if Assigned(FLed) then
    FLed.Free;
  inherited;
  FOwner.Value := FOwner.Value;
end;

function TTMSFMXLEDItem.GetBaseColor: TAlphaColor;
begin
  Result := FLed.BaseColor;
end;

function TTMSFMXLEDItem.GetOffColor: TAlphaColor;
begin
  Result := FLed.OffColor;
end;

function TTMSFMXLEDItem.GetOnColor: TAlphaColor;
begin
  Result := FLed.OnColor;
end;

function TTMSFMXLEDItem.GetState: Boolean;
begin
  Result := FLed.State;
end;

procedure TTMSFMXLEDItem.SetBaseColor(const Value: TAlphaColor);
begin
  FLed.BaseColor := Value;
  FOwner.Repaint;
end;

procedure TTMSFMXLEDItem.SetOffColor(const Value: TAlphaColor);
begin
  FLed.OffColor := Value;
  FOwner.Repaint;
end;

procedure TTMSFMXLEDItem.SetOnColor(const Value: TAlphaColor);
begin
  FLed.OnColor := Value;
  FOwner.Repaint;
end;

procedure TTMSFMXLEDItem.SetState(const Value: Boolean);
begin
  FLed.State := Value;
  FOwner.Repaint;
end;

{ TTMSFMXLEDs }

function TTMSFMXLEDs.Add: TTMSFMXLEDItem;
begin
  Result := TTMSFMXLEDItem(inherited Add);
end;

constructor TTMSFMXLEDs.Create(AOwner: TTMSFMXLEDBar);
begin
  inherited Create(TTMSFMXLEDItem);
  FOwner := AOwner;
end;



function TTMSFMXLEDs.GetItem(Index: Integer): TTMSFMXLEDItem;
begin
  Result := TTMSFMXLEDItem(inherited Items[Index]);
end;

function TTMSFMXLEDs.GetOwner: TPersistent;
begin
  Result := FOwner;
end;

function TTMSFMXLEDs.Insert(Index: Integer): TTMSFMXLEDItem;
begin
  Result := TTMSFMXLEDItem(inherited Insert(Index));
end;

procedure TTMSFMXLEDs.SetItem(Index: Integer; const Value: TTMSFMXLEDItem);
begin
  inherited Items[Index] := Value;
end;

{ TTMSFMXLEDBar }

constructor TTMSFMXLEDBar.Create(AOwner: TComponent);
var
  i: integer;
begin
  inherited;
  FLeds := TTMSFMXLEDs.Create(Self);
  Width := 175;
  Height := 40;
  FSpacing := 5;
  if (csDesigning in ComponentState) and not (csLoading in ComponentState) then
  begin
    for I := 0 to 5 do
      FLeds.Add;
  end;
end;

destructor TTMSFMXLEDBar.Destroy;
begin
  FLeds.Free;
  inherited;
end;

function TTMSFMXLEDBar.GetCount: Integer;
begin
  Result := Leds.Count;
end;

function TTMSFMXLEDBar.GetInstance: NativeUInt;
begin
  Result := HInstance;
end;

function TTMSFMXLEDBar.GetVersion: String;
var
  vn: Integer;
begin
  vn := GetVersionNr;
  Result := IntToStr(Hi(Hiword(vn)))+'.'+IntToStr(Lo(Hiword(vn)))+'.'+IntToStr(Hi(Loword(vn)))+'.'+IntToStr(Lo(Loword(vn)));
end;

function TTMSFMXLEDBar.GetVersionNr: integer;
begin
  Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;

procedure TTMSFMXLEDBar.Paint;
var
  I: Integer;
  h, w, s, x, y: Single;
begin
  inherited;
  if Leds.Count = 0 then
    Exit;


  x := Spacing;
  y := 0;
  h := Height;
  w := (Width - ((Leds.Count + 1) * Spacing)) / Leds.Count;
  if w < h then
    s := w
  else
    s := h;

  for I := 0 to Leds.Count - 1 do
  begin
    Leds[I].FLed.Draw(Canvas, RectF(x, y + (h - s ) / 2, x+ s,y+ (h - s ) / 2+ s), BoundsRect, RotationAngle);
    x := x + s + Spacing;
  end;
end;

procedure TTMSFMXLEDBar.SetCount(const Value: Integer);
var
  I: integer;
  val: Integer;
begin
  val := Max(0, Value);
  if val < Leds.Count then
  begin
    for I := Leds.Count - 1 downto val do
      Leds.Delete(I);
  end
  else
  begin
    for I := 0 to val - Leds.Count - 1 do
      Leds.Add;
  end;

  Self.Value := Self.Value;
end;

procedure TTMSFMXLEDBar.SetLeds(const Value: TTMSFMXLEDs);
begin
  if FLeds <> Value then
  begin
    FLeds.Assign(Value);
    Repaint;
  end;
end;

procedure TTMSFMXLEDBar.SetSpacing(const Value: Integer);
begin
  if FSpacing <> Value then
  begin
    FSpacing := Value;
    Repaint;
  end;
end;

procedure TTMSFMXLEDBar.SetValue(const Value: Integer);
var
  I: Integer;
begin
  FValue := Max(0, Min(Leds.Count, Value));
  for I := 0 to Leds.Count - 1 do
    Leds[I].State := Value > I;

  Repaint;
end;

end.
