{********************************************************************}
{                                                                    }
{ 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.TMS7SegLed;

interface

{$I TMSDEFS.INC}

uses
  FMX.Types, FMX.Objects, Classes, Types, SysUtils,Math, FMX.TMSBaseControl,
  FMX.Controls , UIConsts, FMX.Styles
  {$IFDEF DELPHIXE5_LVL}
  , FMX.Graphics
  {$ENDIF}
  {$IFDEF DELPHIXE6_LVL}
  , System.Math.Vectors
  {$ENDIF}
  ;



const
  MAJ_VER = 1; // Major version nr.
  MIN_VER = 5; // Minor version nr.
  REL_VER = 0; // Release nr.
  BLD_VER = 2; // 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.5.0.0 : New : support for XE4
  // v1.5.0.1 : Fixed : Issue with string conversion on iOS / Android
  // v1.5.0.2 : Fixed : Issue with naming for led elements


type
  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMX7SegLEDShape = class(TTMSFMXBaseShape)
  private
    FFillActive: TBrush;
    FValue: byte;
    FDecimalSeparator: Boolean;
    procedure SetFillActive(const Value: TBrush);
    procedure SetValue(const AValue: byte);
  protected
    procedure DrawSegH(px1,px2,py1,lw: double; Active: boolean);
    procedure DrawSegV(px1,px2,py1,py2,lw: double; Active: boolean);
    procedure FillActiveChanged(Sender: TObject);
  public
    property DecimalSeparator: Boolean read FDecimalSeparator write FDecimalSeparator;
    procedure Painting; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property Fill;
    property FillActive: TBrush read FFillActive write SetFillActive;
    property Stroke;
    property StrokeThickness;
    property StrokeCap;
    property StrokeDash;
    property StrokeJoin;
    property Value: byte read FValue write SetValue;
  end;

  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMX7SegLED = class(TTMSFMXBaseControl)
  private
    FValue: double;
    FDigits: integer;
    FDecimals: integer;
    procedure SetValue(const AValue: double);
    procedure SetDigits(const Value: integer);
    procedure SetDecimals(const Value: integer);
    function GetVersion: String;
    function GetVersionNr: Integer;
  protected
    function GetInstance: NativeUInt; override;
  public
    procedure Update; override;
    constructor Create(AOwner: TComponent); override;
    procedure CleanUpLeds(AControl: TControl);
    procedure UpdateLedObjects;
    function Shape: TTMSFMX7SegLEDShape;
    function DoesLedExist(AControl: TControl; LedName: String): TTMSFMX7SegLEDShape;
  published
    property Digits: integer read FDigits write SetDigits default 4;
    property Decimals: integer read FDecimals write SetDecimals default 2;
    property StyleLookup;
    property Value: double read FValue write SetValue;
    property Version: String read GetVersion;
  end;

implementation

{$R FMX.TMS7segled.res}

{ TTMSFMX7SegLEDShape }

constructor TTMSFMX7SegLEDShape.Create(AOwner: TComponent);
begin
  inherited;
  Width := 80;
  Height := 120;

  Fill.Color := $FFB7B7B7;

  {$IFDEF DELPHIXE6_LVL}
  FFillActive := TBrush.Create(TBrushKind.Solid, $FFFF0000);
  {$ELSE}
  FFillActive := TBrush.Create(TBrushKind.bkSolid, $FFFF0000);
  {$ENDIF}
  FFillActive.OnChanged := FillActiveChanged;
end;

destructor TTMSFMX7SegLEDShape.Destroy;
begin
  FFillActive.Free;
  inherited;
end;

procedure TTMSFMX7SegLEDShape.FillActiveChanged(Sender: TObject);
begin
  Repaint;
end;

procedure TTMSFMX7SegLEDShape.DrawSegV(px1,px2,py1,py2,lw: double; Active: boolean);
var
  pth: TPathData;
  poly: TPolygon;
begin
  if Active then
  begin
    Canvas.Fill.Assign(FillActive);
    Canvas.Stroke.Color := Canvas.Fill.Color;
  end
  else
  begin
    Canvas.Fill.Assign(Fill);
    Canvas.Stroke.Color := claGray;
  end;

  pth := TPathData.Create;

  pth.MoveTo(PointF(px1, py1));
  pth.LineTo(PointF(px1 + lw, py1+lw));
  pth.LineTo(PointF(px2 + lw, py2-lw));
  pth.LineTo(PointF(px2, py2));

  pth.LineTo(PointF(px2 - lw, py2-lw));

  pth.LineTo(PointF(px1 - lw, py1+lw));
  pth.LineTo(PointF(px1, py1));

  pth.FlattenToPolygon(poly);
  Canvas.FillPolygon(poly, Opacity);
  Canvas.DrawPath(pth, Opacity);
  pth.Free;
end;



procedure TTMSFMX7SegLEDShape.DrawSegH(px1,px2,py1,lw: double; Active: boolean);
var
  pth: TPathData;
  poly: TPolygon;
begin
  if Active then
  begin
    Canvas.Fill.Assign(FillActive);
    Canvas.Stroke.Color := Canvas.Fill.Color;
  end
  else
  begin
    Canvas.Fill.Assign(Fill);
    Canvas.Stroke.Color := claGray;
  end;


  pth := TPathData.Create;

  pth.MoveTo(PointF(px1, py1));
  pth.LineTo(PointF(px1 + lw, py1-lw));
  pth.LineTo(PointF(px2 - lw, py1-lw));
  pth.LineTo(PointF(px2, py1));
  pth.LineTo(PointF(px2 - lw, py1+lw));
  pth.LineTo(PointF(px1 + lw, py1+lw));
  pth.LineTo(PointF(px1, py1));

  pth.FlattenToPolygon(poly);
  Canvas.FillPolygon(poly, Opacity);
  Canvas.DrawPath(pth, Opacity);
  pth.Free;
end;

procedure TTMSFMX7SegLEDShape.Painting;
var
  px1,px2,py1,py2: double;
  lw: double;
  d: double;
  active: boolean;

begin
  inherited;

  px1 := 0.1 * Width;
  px2 := 0.9 * Width;
  py1 := 0.1 * Height;
  lw := 0.05 * Height;

  d := Max(1,0.02 * Height);

  active := Value in [0,2,3,5,6,7,8,9];

  DrawSegH(px1,px2,py1 - d,lw,active);

  px1 := 0.075 * Width;
  px2 := 0.875 * Width;
  py1 := 0.5 * Height;
  lw := 0.05 * Height;

  active := Value in [2,3,4,5,6,8,9];

  DrawSegH(px1,px2,py1,lw,active);

  px1 := 0.05 * Width;
  px2 := 0.85 * Width;
  py1 := 0.9 * Height;
  lw := 0.05 * Height;

  active := Value in [0,2,3,5,6,8,9];

  DrawSegH(px1,px2,py1 + d,lw,active);

  px1 := 0.9 * Width;
  px2 := 0.875 * Width;
  py1 := 0.1 * Height;
  py2 := 0.5 * Height;
  lw := 0.05 * Height;

  active := Value in [0,1,2,3,4,7,8,9];

  DrawSegV(px1 + d,px2 + d,py1 - d,py2 - d,lw,active);

  px1 := 0.1 * Width;
  px2 := 0.075 * Width;
  py1 := 0.1 * Height;
  py2 := 0.5 * Height;
  lw := 0.05 * Height;

  active := Value in [0,4,5,6,8,9];

  DrawSegV(px1 - d,px2 - d,py1 - d,py2 - d,lw,active);

  px1 := 0.075 * Width;
  px2 := 0.05 * Width;
  py1 := 0.5 * Height;
  py2 := 0.9 * Height;
  lw := 0.05 * Height;

  active := Value in [0,2,6,8];

  DrawSegV(px1 - d,px2- d,py1+d,py2+d,lw,active);

  px1 := 0.875 * Width;
  px2 := 0.85 * Width;
  py1 := 0.5 * Height;
  py2 := 0.9 * Height;
  lw := 0.05 * Height;

  active := Value in [0,1,3,4,5,6,7,8,9];

  DrawSegV(px1+ d,px2 +d ,py1+d,py2+d,lw,active);

  if DecimalSeparator then
  begin
    // draw the dot
    Canvas.FillEllipse(RectF(0.9 * Width, 0.9 * Height,0.9 * Width + lw * 1.5, 0.9 * Height + lw * 1.5),Opacity);
  end;
end;

procedure TTMSFMX7SegLEDShape.SetFillActive(const Value: TBrush);
begin
  FFillActive.Assign(Value);
end;

procedure TTMSFMX7SegLEDShape.SetValue(const AValue: byte);
begin
  if (FValue <> AValue) then
    FValue := AValue;
end;

{ TTMSFMX7SegLED }

procedure TTMSFMX7SegLED.SetDecimals(const Value: integer);
begin
  if (FDecimals <> Value) then
  begin
    FDecimals := Value;
    UpdateLedObjects;
  end;
end;

procedure TTMSFMX7SegLED.SetDigits(const Value: integer);
begin
  if (FDigits <> Value) then
  begin
    FDigits := Value;
    UpdateLedObjects;
  end;
end;

procedure TTMSFMX7SegLED.SetValue(const AValue: double);
begin
  if (FValue <> AValue) then
  begin
    FValue := AValue;
    UpdateLedObjects;
  end;
end;

function TTMSFMX7SegLED.Shape: TTMSFMX7SegLEDShape;
begin
  Result := TTMSFMX7SegLEDShape(FindStyleResource('led'));
end;

procedure TTMSFMX7SegLED.Update;
begin
  inherited;
  UpdateLedObjects;
end;

procedure TTMSFMX7SegLED.UpdateLedObjects;
var
  I, K: Integer;
  sn: String;
  newsec, sec, led: TTMSFMX7SegLEDShape;
  innerElement: TFMXObject;
  strValue, strValueDec: String;
begin
  innerelement := Self;
  strValue := inttostr(Floor(Value));
  strValueDec := floattostr(Round(Frac(Value) * Power(10, Decimals)));

  led := Self.FindStyleResource('led') as TTMSFMX7SegLEDShape;

  if Assigned(innerElement) and Assigned(led) then
  begin
    led.Visible := False;
    for I := 0 to Digits + Decimals - 1 do
    begin
      sn := 'FMXLed'+inttostr(I);
      sec := DoesLedExist(innerelement as TControl, sn);
      if Assigned(sec) then
        newsec := sec
      else
      begin
        newsec := TTMSFMX7SegLEDShape.Create(innerElement);
        newsec.BeginUpdate;
        newsec.HitTest := False;
        newsec.StyleName := sn;
        newsec.Locked := True;
        innerElement.AddObject(newsec);
        {$IFDEF DELPHIXE6_LVL}
        newsec.Align := TAlignLayout.Scale;
        {$ELSE}
        newsec.Align := TAlignLayout.alScale;
        {$ENDIF}
        newsec.EndUpdate;
      end;

      newsec.Width := (Width - 10) / (Digits + Decimals) - 1;
      newsec.Position.X := 5 + (Width - 10) / (Digits + Decimals) * I;
      newsec.Position.Y := 2;
      newsec.Height := Height - 4;


      newsec.FillActive.Assign(led.FillActive);
      newsec.Fill.Assign(led.Fill);
      newsec.Stroke.Assign(led.Stroke);
      newsec.StrokeThickness := led.Stroke.Thickness;
      newsec.StrokeCap := led.Stroke.Cap;
      newsec.StrokeDash := led.Stroke.Dash;
      newsec.StrokeJoin := led.Stroke.Join;
      newsec.Value := 0;

      newsec.DecimalSeparator := (I = Digits - 1) and (Decimals > 0);

      if I > Digits - 1 then
      begin
        K := I - Digits;
        if (K >= 0) and (K <= Length(strValuedec) - 1) then
        begin
          {$IFDEF DELPHI_LLVM}
          newsec.Value := StrToInt(strValueDec[K]);
          {$ELSE}
          newsec.Value := StrToInt(strValueDec[K + 1]);
          {$ENDIF}
        end;
      end;

      if I <= Digits - 1 then
      begin
        K := I - (Digits - Length(strValue));
        if (K >= 0) and (K <= Length(strValue) - 1) then
        begin
          {$IFDEF DELPHI_LLVM}
          newsec.Value := StrToInt(strValue[K]);
          {$ELSE}
          newsec.Value := StrToInt(strValue[K + 1]);
          {$ENDIF}
        end;
      end;

      newsec.Name := sn + Name;
    end;
  end;

  CleanUpLeds(innerelement as TControl);
end;

procedure TTMSFMX7SegLED.CleanUpLeds(AControl: TControl);
var
  str: TStringList;
  iDigit: Integer;
  lName: String;
  i: integer;
  obj: TFMXObject;
  l: TTMSFMX7SegLEDShape;
begin
  str := TStringList.Create;
  for iDigit := 0 to Digits + Decimals - 1 do
  begin
    lName := 'FMXLed'+inttostr(iDigit);
    str.Add(UpperCase(lName+Name));
  end;

  if Assigned(AControl) then
  begin
    for I := AControl.ChildrenCount - 1 downto 0 do
    begin
      obj := AControl.Children[i];
      if (obj is TTMSFMX7SegLEDShape) then
      begin
        l := obj as TTMSFMX7SegLEDShape;
        if str.IndexOf(UpperCase(l.Name)) = -1 then
        begin
          {$IFDEF DELPHI_LLVM}
          l.Release;
          {$ELSE}
          l.Free;
          {$ENDIF}
        end;
      end;
    end;
  end;

  str.Free;
end;

constructor TTMSFMX7SegLED.Create(AOwner: TComponent);
begin
  inherited;
  Width := 360;
  Height := 65;
  FDigits := 4;
  FDecimals := 2;
end;

function TTMSFMX7SegLED.DoesLedExist(AControl: TControl;
  LedName: String): TTMSFMX7SegLEDShape;
var
  i: integer;
  obj: TFMXObject;
  l: TTMSFMX7SegLEDShape;
begin
  Result := nil;
  if Assigned(AControl) then
  begin
    for I := 0 to AControl.ChildrenCount - 1 do
    begin
      obj := AControl.Children[i];
      if (obj is TTMSFMX7SegLEDShape) then
      begin
        l := obj as TTMSFMX7SegLEDShape;
        if UpperCase(l.StyleName) = UpperCase(LedName) then
        begin
          Result := l;
          Break;
        end;
      end;
    end;
  end;
end;

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


function TTMSFMX7SegLED.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 TTMSFMX7SegLED.GetVersionNr: integer;
begin
  Result := MakeLong(MakeWord(BLD_VER,REL_VER),MakeWord(MIN_VER,MAJ_VER));
end;

initialization
  RegisterFmxClasses([TTMSFMX7SegLED, TTMSFMX7SegLEDShape]);

end.
