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

interface

{$I TMSDEFS.INC}

uses
  FMX.Types, FMX.Objects, Classes, Types, SysUtils,
  StrUtils, Math, UITypes, FMX.TMSBasecontrol, DateUtils
  , FMX.Controls, 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 scrolling and selecting value in iOS
  // v1.0.5.4 : Improved : block refreshing columns when destroying the component
  // v1.1.0.0 : New : KeyBoard and Mouse Wheel handling support
  // v1.5.0.0 : New : support for XE4

type
  TTMSFMXSpinner = class;

  TTMSFMXColumnShape = class(TRectangle)
  private
    FFocusColor: TAlphaColor;
  public
    constructor Create(AOwner: TComponent); override;
    procedure Paint; override;
  published
    property FocusColor: TAlphaColor read FFocusColor write FFocusColor default TAlphaColorRec.White;
    property DisableFocusEffect;
  end;

  TTMSFMXSpinnerRangeType = (srtNumber, srtDateTime, srtCustom);

  TTMSFMXSpinnerStepType = (sstNumber, sstSecond, sstMinute, sstHour, sstDay, sstMonth, sstYear);

  TTMSFMXSpinnerCustomItem = class(TCollectionItem)
  private
    FOwner: TTMSFMXSpinner;
    FText: String;
    procedure SetText(const Value: String);
  protected
    procedure Changed;
  public
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
  published
    property Text: String read FText write SetText;
  end;

  TTMSFMXSpinnerCustomItems = class(TTMSFMXBaseCollection)
  private
    FOwner: TTMSFMXSpinner;
    FOnChange: TNotifyEvent;
    function GetItem(Index: Integer): TTMSFMXSpinnerCustomItem;
    procedure SetItem(Index: Integer; const Value: TTMSFMXSpinnerCustomItem);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TTMSFMXSpinner);
    function Add: TTMSFMXSpinnerCustomItem;
    function Insert(Index: Integer): TTMSFMXSpinnerCustomItem;
    property Items[Index: Integer]: TTMSFMXSpinnerCustomItem read GetItem write SetItem; default;
    procedure Update(Item: TCollectionItem); override;
  published
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TTMSFMXColumnAppearance = class(TPersistent)
  private
    FOwner: TTMSFMXSpinner;
    FSpacing: integer;
    FOnChange: TNotifyEvent;
    FTextSpacing: integer;
    FAutoSize: Boolean;
    procedure SetSpacing(const Value: integer);
    procedure SetTextSpacing(const Value: integer);
    procedure SetAutoSize(const Value: Boolean);
  public
    constructor Create(AOwner: TTMSFMXSpinner);
    destructor Destroy; override;
    procedure RefreshColumns;
  published
    property AutoSize: Boolean read FAutoSize write SetAutoSize default True;
    property Spacing: integer read FSpacing write SetSpacing default 5;
    property TextSpacing: integer read FTextSpacing write SetTextSpacing default 25;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  TTMSFMXColumn = class(TCollectionItem)
  private
    FSaveDateRangeto, FSaveDateRangeFrom: TDateTime;
    FDrawIndex: integer;
    FSp: Double;
    FAnimating, FAnimate: Boolean;
    FMouseDown, FMouseUp: Boolean;
    FTimeStart, FTimeStop: Double;
    FDragY, FScrollY: Integer;
    FClickX, FClickY: Integer;
    FCurrentScPos, FScPosTo: Integer;
    FRangeFrom: Double;
    FRangeTo: Double;
    FSelectedValue: Double;
    FRangeType: TTMSFMXSpinnerRangeType;
    FStep: Double;
    FValueFormat: String;
    FDateRangeTo: TDateTime;
    FDateRangeFrom: TDateTime;
    FDateTimeValueFormat: String;
    FStepType: TTMSFMXSpinnerStepType;
    FCyclic: Boolean;
    FFont: TFont;
    FWidth: Single;
    FTextAlign: TAlignment;
    FOnlyDate: Boolean;
    FOwner: TTMSFMXSpinner;
    FFontAppearance: TBrush;
    FCustomItems: TTMSFMXSpinnerCustomItems;
    procedure SetRangeFrom(const Value: Double);
    procedure SetRangeTo(const Value: Double);
    procedure SetSelectedValue(const Value: Double);
    procedure SetRangeType(const Value: TTMSFMXSpinnerRangeType);
    procedure SetStep(const Value: Double);
    procedure SetValueFormat(const Value: String);
    procedure SetDateRangeFrom(const Value: TDateTime);
    procedure SetDateRangeTo(const Value: TDateTime);
    procedure SetDateTimeValueFormat(const Value: String);
    procedure SetStepType(const Value: TTMSFMXSpinnerStepType);
    procedure SetCyclic(const Value: Boolean);
    procedure SetFont(const Value: TFont);
    function GetSelectedDateTime: TDateTime;
    procedure SetSelectedDateTime(const Value: TDateTime);
    procedure SetTextAlign(const Value: TAlignment);
    procedure SetOnlyDate(const Value: Boolean);
    function GetSelectedValue: Double;
    procedure SetWidth(const Value: Single);
    procedure SetCustomItems(const Value: TTMSFMXSpinnerCustomItems);
  protected
    function GetColumnRect: TRectF;
    procedure RefreshColumn;
    procedure PaintColumn(Sender: TObject; Canvas: TCanvas; const ARect: TRectF);
    procedure Draw(ACanvas: TCanvas; r: TRectF);
    procedure SetAnimatedValue;
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure DoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
    procedure DoMouseWheel(Sender: TObject; Shift: TShiftState; WheelDelta: Integer; var Handled: Boolean);
  public
    function Shape: TTMSFMXColumnShape;
    constructor Create(Collection: TCollection); override;
    destructor Destroy; override;
    procedure UpdateColumn;
    procedure ScrollToValue(Value: double; Animation: Boolean = true; AnimationSpeed: integer = 4);
    procedure Next(Animation: Boolean = true);
    procedure Previous(Animation: Boolean = true);
    function IncSteps(StartValue: Double; nr: integer): double;
    function StepsFromTo(StartValue, EndValue: Double): integer;
    function GetStep: Double;
    function GetRangeCount: integer;
    function GetRangeTo: Double;
    function GetRangeFrom: Double;
    property SelectedDateTime: TDateTime read GetSelectedDateTime write SetSelectedDateTime;
  published
    property Width: Single read FWidth write SetWidth;
    property RangeFrom: Double read FRangeFrom write SetRangeFrom;
    property RangeTo: Double read FRangeTo write SetRangeTo;
    property DateRangeFrom: TDateTime read FDateRangeFrom write SetDateRangeFrom;
    property DateRangeTo: TDateTime read FDateRangeTo write SetDateRangeTo;
    property Step: Double read FStep write SetStep;
    property StepType: TTMSFMXSpinnerStepType read FStepType write SetStepType default sstNumber;
    property SelectedValue: Double read GetSelectedValue write SetSelectedValue;
    property ValueFormat: String read FValueFormat write SetValueFormat;
    property DateTimeValueFormat: String read FDateTimeValueFormat write SetDateTimeValueFormat;
    property RangeType: TTMSFMXSpinnerRangeType read FRangeType write SetRangeType default srtNumber;
    property OnlyDate: Boolean read FOnlyDate write SetOnlyDate default false;
    property Cyclic: Boolean read FCyclic write SetCyclic default false;
    property Font: TFont read FFont write SetFont;
    property FontAppearance: TBrush read FFontAppearance write FFontAppearance;
    property TextAlign: TAlignment read FTextAlign write SetTextAlign default taCenter;
    property CustomItems: TTMSFMXSpinnerCustomItems read FCustomItems write SetCustomItems;
  end;

  TTMSFMXSelectedValueChangedEvent = procedure(Sender: TObject; Column: Integer; SelectedValue: Double; RangeType: TTMSFMXSpinnerRangeType) of object;

  TTMSFMXColumns = class(TTMSFMXBaseCollection)
  private
    FOwner: TTMSFMXSpinner;
    FOnChange: TNotifyEvent;
    function GetItem(Index: Integer): TTMSFMXColumn;
    procedure SetItem(Index: Integer; const Value: TTMSFMXColumn);
  protected
    function GetOwner: TPersistent; override;
  public
    constructor Create(AOwner: TTMSFMXSpinner);
    function Add: TTMSFMXColumn;
    function Insert(Index: Integer): TTMSFMXColumn;
    property Items[Index: Integer]: TTMSFMXColumn read GetItem write SetItem; default;
  published
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
  end;

  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXSpinner = class(TTMSFMXBaseControl)
  private
    FAnimateTimer: TTimer;
    FColumns: TTMSFMXColumns;
    FColumnAppearance: TTMSFMXColumnAppearance;
    FOnSelectedValueChanged: TTMSFMXSelectedValueChangedEvent;
    FAnimationFactor: integer;
    FSmoothScrolling: Boolean;
    procedure SetAnimationFactor(const Value: integer);
    procedure SetSmoothScrolling(const Value: Boolean);
    function GetVersion: String;
    function GetVersionNr: Integer;
  protected
    function GetInstance: NativeUInt; override;
    procedure Animate(Sender: TObject);
    procedure RefreshColumns;
    function DoesColumnExist(AControl: TFmxObject; ColumnName: String): TTMSFMXColumnShape;
    procedure UpdateColumns(AControl: TFmxObject);
    procedure CleanUpColumns(AControl: TFmxObject);
  public
    property AnimateTimer: TTimer read FAnimateTimer;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure Resize; override;
    function GetStyleObject: TFMXObject; override;
    procedure Update; override;
  published
    property Version: String read GetVersion;
    property SmoothScrolling: Boolean read FSmoothScrolling write SetSmoothScrolling default false;
    property AnimationFactor: integer read FAnimationFactor write SetAnimationFactor default 4;
    property Columns: TTMSFMXColumns read FColumns write FColumns;
    property ColumnAppearance: TTMSFMXColumnAppearance read FColumnAppearance write FColumnAppearance;
    property OnSelectedValueChanged: TTMSFMXSelectedValueChangedEvent read FOnSelectedValueChanged write FOnSelectedValueChanged;
  end;

implementation

{$R FMX.TMSSpinner.res}

function GetTickCountX: DWORD;
var
  h, m, s, ms: Word;
begin
  DecodeTime(Now, h, m, s, ms);
  Result := ms + s * 1000 + m * 60 * 1000 + h * 60 * 60 * 1000;
end;

function AnimateDouble(var Start: Integer; Stop: Integer; Delta: Double; Margin: Integer): Boolean;
begin
  Result := true;
  if (Start > Stop - Margin) and (Start < Stop + Margin) then
  begin
    Start := Stop;
    Result := false;
  end
  else
  begin
    Delta := Max(1, Delta);
    if Start < Stop then
      Start := Round(Start + Delta)
    else
      Start := Round(Start - Delta);
  end;
end;

constructor TTMSFMXColumnAppearance.Create(AOwner: TTMSFMXSpinner);
begin
  FOwner := AOwner;
  FSpacing := 5;
  FTextSpacing := 25;
  FAutoSize := True;
end;

destructor TTMSFMXColumnAppearance.Destroy;
begin
  inherited;
end;

procedure TTMSFMXColumnAppearance.RefreshColumns;
var
  I: Integer;
begin
  for I := 0 to FOwner.Columns.Count - 1 do
    FOwner.Columns[I].RefreshColumn;
end;

procedure TTMSFMXColumnAppearance.SetTextSpacing(
  const Value: integer);
var
  I: Integer;
begin
  if FTextSpacing <> value then
  begin
    FTextSpacing := Max(1, Value);
    for I := 0 to FOwner.Columns.Count - 1 do
    begin
      with FOwner.Columns[i] do
      begin
        FCurrentScPos := StepsFromTo(GetRangeFrom, FSelectedValue) * FOwner.ColumnAppearance.TextSpacing;
        FScPosTo := FcurrentScPos;
      end;
    end;
    RefreshColumns;
  end;
end;

procedure TTMSFMXColumnAppearance.SetAutoSize(const Value: Boolean);
begin
  if FAutoSize <> Value then
  begin
    FAutoSize := Value;
    RefreshColumns;
  end;
end;

procedure TTMSFMXColumnAppearance.SetSpacing(const Value: integer);
begin
  if FSpacing <> value then
  begin
    FSpacing := Value;
    RefreshColumns;
  end;
end;

{ TTMSFMXColumn }

procedure TTMSFMXColumn.Draw(ACanvas: TCanvas; r: TRectF);
var
  I: Integer;
  dw: integer;
  s: String;
  srih, sriw: Single;
  pttext: TPointF;
  d: Double;
  ypostext: Double;
  sci, cnt, j: integer;
  cdt, cdf: integer;
  txtspc: integer;
begin
  if GetRangeCount <= 0 then
    Exit;

  txtspc := FOwner.FColumnAppearance.TextSpacing;
  ACanvas.Font.Assign(Font);
  srih := ACanvas.TextHeight('gh');

  cnt := Round(R.Height / ((txtspc / 2) + srih)) + 5;
  i := (FCurrentScPos div txtspc) - (cnt div 2);
  j := 0;

  while j <= cnt do
  begin
    if (i < 0) and Cyclic then
      sci := ((i mod (GetRangeCount + 1) + GetRangeCount + 1) mod (GetRangeCount + 1))
    else if (i > GetRangeCount) and Cyclic then
      sci := ((i mod (GetRangeCount + 1)) mod (GetRangeCount + 1))
    else
      sci := i;

    d := IncSteps(GetRangeFrom, sci);
    cdt := CompareDateTime(d, GetRangeTo);
    cdf := CompareDateTime(d, GetRangeFrom);
    if (((cdf = 0) or (cdf = 1)) and ((cdt = 0) or (cdt = -1))) or Cyclic then
    begin
      case RangeType of
        srtCustom:
        begin
          if (d >= 0) and (d <= CustomItems.Count - 1) then
            s := CustomItems[Round(d)].Text;
        end;
        srtNumber:
        begin
          if pos('d',ValueFormat) > 0 then
          begin
            dw := round(d);
            try
              s := Format(ValueFormat,[dw]);
            except
              s := '';
            end;
          end
          else
          begin
            try
              s := Format(ValueFormat, [d]);
            except
              s := '';
            end;
          end;
        end;
        srtDateTime:
        begin
          try
            s := FormatDateTime(DateTimeValueFormat, d);
          except
            s := '';
          end;
        end;
      end;


      sriw := ACanvas.TextWidth(s);
      srih := ACanvas.TextHeight(s);

      if s <> '' then
      begin
        ypostext := -FCurrentScPos + (i * txtspc) + (r.Bottom - srih) / 2;
        case TextAlign of
          taLeftJustify: pttext := PointF(r.Left, ypostext);
          taRightJustify: pttext := PointF(r.Left + ((r.Width - sriw)), ypostext);
          taCenter: pttext := PointF(r.Left + ((r.Width - sriw) / 2), ypostext);
        end;
      end;

      if s <> '' then
      begin
        ACanvas.Fill.Assign(FontAppearance);
        {$IFDEF DELPHIXE6_LVL}
        ACanvas.FillText(RectF(pttext.X, pttext.Y, pttext.X + sriw, pttext.Y + srih), s, false, FOwner.Opacity, [], TTextAlign.Center);
        {$ELSE}
        ACanvas.FillText(RectF(pttext.X, pttext.Y, pttext.X + sriw, pttext.Y + srih), s, false, FOwner.Opacity, [], TTextAlign.taCenter);
        {$ENDIF}
      end;
    end;

    Inc(j);
    Inc(i);
  end;
end;

function TTMSFMXColumn.GetColumnRect: TRectF;
var
  r: TRectF;
  s, st: Double;
  i: integer;
  cc: integer;
begin
  with FOwner do
  begin
    cc := 0;
    for i := 0 to Columns.Count - 1 do
      Inc(cc);

    r := Fowner.BoundsRect;
    if ColumnAppearance.AutoSize then
    begin
      s := (r.Right - r.Left - ((cc + 1) * ColumnAppearance.Spacing)) / cc;
      st := r.Left + (FDrawIndex * s) + (FDrawIndex + 1) * ColumnAppearance.Spacing;
    end
    else
    begin
      s := Self.Width;
      i := FDrawIndex;
      st := r.Left;
      while (i > 0) do
      begin
        st := st + Columns[i - 1].Width + ColumnAppearance.Spacing;
        Dec(i);
      end;
    end;

    Result := RectF(st, r.Top, st + s, r.Bottom);
  end;
end;

function TTMSFMXColumn.GetRangeCount: integer;
begin
  result := StepsFromTo(GetRangeFrom, GetRangeTo);
end;

function TTMSFMXColumn.GetRangeFrom: Double;
begin
  Result := 0;
  case RangeType of
    srtNumber, srtCustom: result := RangeFrom;
    srtDateTime:
    begin
      if OnlyDate then
        result := Int(FSaveDateRangeFrom)
      else
        result := FSaveDateRangeFrom;
    end;
  end;
end;

function TTMSFMXColumn.GetRangeTo: Double;
begin
  Result := 0;
  case RangeType of
    srtNumber, srtCustom: result := RangeTo;
    srtDateTime:
    begin
      if OnlyDate then
        result := int(FSaveDateRangeto)
      else
        result := FSaveDateRangeTo;
    end;
  end;
end;

function TTMSFMXColumn.GetSelectedDateTime: TDateTime;
begin
  result := SelectedValue;
end;

function TTMSFMXColumn.GetSelectedValue: Double;
begin
  Result := Max(GetRangeFrom, Min(FSelectedValue, GetRangeTo));
end;

function TTMSFMXColumn.IncSteps(StartValue: double; nr: integer): double;
var
  i: integer;
  d: integer;
begin
  case StepType of
    sstMonth:
    begin
      if (nr > 0) then d := 1 else d := -1;
      for i := 1 to abs(nr) do
        StartValue := incmonth(StartValue, d);
      result := StartValue;
    end;
    sstYear:
    begin
      if (nr > 0) then d := 1 else d := -1;
      for i := 1 to abs(nr) do
        startvalue := incyear(StartValue, d);
      result := StartValue;
    end;
    else result := StartValue + (nr * GetStep);
  end;
end;


function TTMSFMXColumn.StepsFromTo(startvalue, endvalue: double): integer;
var
  steps: integer;
begin
  case StepType of
  sstMonth:
  begin
    steps := 0;
    while (startvalue < endvalue) do
    begin
      startvalue := incmonth(startvalue);
      inc(steps);
    end;
  end;
  sstYear:
  begin
    steps := 0;
    while (startvalue < endvalue) do
    begin
      startvalue := incyear(startvalue);
      inc(steps);
    end;
  end;
  else Steps := Round(Abs(endvalue - startvalue) / getstep);
  end;

  Result := Steps;
end;


function TTMSFMXColumn.GetStep: Double;
begin
  Result := 1;
  case StepType of
    sstNumber: Result := Step;
    sstSecond: Result := Step / 86400;
    sstMinute: Result := Step / 1440;
    sstHour: Result := Step / 24;
    sstDay: Result := Step;
  end;
end;

procedure TTMSFMXColumn.Next(Animation: Boolean = true);
begin
  ScrollToValue(IncSteps(SelectedValue, 1), Animation);
end;

procedure TTMSFMXColumn.PaintColumn(Sender: TObject; Canvas: TCanvas;
  const ARect: TRectF);
begin
  Draw(Canvas, ARect);
end;

procedure TTMSFMXColumn.Previous(Animation: Boolean = true);
begin
  ScrollToValue(IncSteps(SelectedValue, -1), Animation);
end;

procedure TTMSFMXColumn.RefreshColumn;
var
  s: TTMSFMXColumnShape;
  r: TRectF;
begin
  s := Shape;
  if Assigned(s) then
  begin
    r := GetColumnRect;
    s.Position.X := r.Left;
    s.Position.Y := r.Top;
    s.Width := r.Width;
    s.Height := r.Height;
    s.Repaint;
  end;
end;

procedure TTMSFMXColumn.ScrollToValue(Value: double; Animation: Boolean = true; AnimationSpeed: integer = 4);
begin
  if (FSelectedValue <> value) then
  begin
    Fanimate := Animation;
    FSp := AnimationSpeed;

    FSelectedValue := Max(GetRangeFrom, Min(Value, GetRangeTo));

    if Value < GetRangeFrom then
      FScPosTo := -FOwner.ColumnAppearance.TextSpacing
    else
      FScPosTo := StepsFromTo(GetRangeFrom, Value) * FOwner.ColumnAppearance.TextSpacing;

    if not Cyclic then
    begin
      FScPosTo := Max(0, Min(FOwner.ColumnAppearance.TextSpacing * GetRangeCount, FScPosTo));
      FSelectedValue := Min(Max(Value, RangeFrom), RangeTo);
    end;

    if not Animation then
    begin
      if Cyclic then
      begin
        if FScPosTo = (GetRangeCount + 1) * FOwner.ColumnAppearance.TextSpacing then
          FScPosTo := 0
        else if FScPosTo = -FOwner.ColumnAppearance.TextSpacing then
          FScPosTo := GetRangeCount * FOwner.ColumnAppearance.TextSpacing;
      end;

      FScPosTo := Max(0, Min(Fowner.ColumnAppearance.TextSpacing * GetRangeCount, FScPosTo));
      FSelectedValue := IncSteps(GetRangeFrom, FScPosTo div Fowner.ColumnAppearance.TextSpacing);
      FCurrentScPos := FScPosTo;

      if Assigned(FOwner.FOnSelectedValueChanged) then
        FOwner.FOnSelectedValueChanged(Self, Index, FSelectedValue, RangeType);
    end;
  end;
end;

procedure TTMSFMXColumn.SetAnimatedValue;
begin
  FSelectedValue := Max(GetRangeFrom, Min(IncSteps(GetRangeFrom, FScPosTo div FOwner.ColumnAppearance.TextSpacing), GetRangeTo));
end;

procedure TTMSFMXColumn.SetCustomItems(const Value: TTMSFMXSpinnerCustomItems);
begin
  if FCustomItems <> Value then
  begin
    FCustomItems.Assign(Value);
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetCyclic(const Value: Boolean);
begin
  if FCyclic <> value then
  begin
    FCyclic := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetDateRangeFrom(const Value: TDateTime);
begin
  if FDateRangeFrom <> Value then
  begin
    FDateRangeFrom := Value;
    FSaveDateRangeFrom := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetDateRangeTo(const Value: TDateTime);
begin
  if FDateRangeTo <> value then
  begin
    FDateRangeTo := Value;
    FSaveDateRangeto := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetDateTimeValueFormat(const Value: String);
begin
  if FDateTimeValueFormat <> value then
  begin
    FDateTimeValueFormat := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetFont(const Value: TFont);
begin
  if FFont <> Value then
  begin
    FFont.Assign(Value);
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetOnlyDate(const Value: Boolean);
begin
  if FOnlyDate <> value then
  begin
    FOnlyDate := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetRangeFrom(const Value: Double);
begin
  if FRangeFrom <> value then
  begin
    FRangeFrom := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetRangeTo(const Value: Double);
begin
  if FRangeTo <> value then
  begin
    FRangeTo := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetRangeType(
  const Value: TTMSFMXSpinnerRangeType);
begin
  if FRangeType <> Value then
  begin
    FRangeType := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetSelectedDateTime(const Value: TDateTime);
begin
  SelectedValue := value;
end;

procedure TTMSFMXColumn.SetSelectedValue(const Value: double);
begin
  if (FSelectedValue <> value) and (Value <= GetRangeTo) and (Value >= GetRangeFrom) then
  begin
    FSelectedValue := Value;
    if FSelectedValue <> -1 then
    begin
      if Abs(GetRangeTo - GetRangeFrom) = 0 then
      begin
        FSelectedValue := -1;
      end
      else
      begin
        FCurrentScPos := StepsFromTo(GetRangeFrom, FSelectedValue) * FOwner.ColumnAppearance.TextSpacing;
        FScPosTo := FcurrentScPos;
      end;
    end;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetStep(const Value: Double);
begin
  if (FStep <> value) and (Value > 0) then
  begin
    FStep := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetStepType(
  const Value: TTMSFMXSpinnerStepType);
begin
  if FStepType <> Value then
  begin
    FStepType := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetTextAlign(const Value: TAlignment);
begin
  if FTextAlign <> value then
  begin
    FTextAlign := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetValueFormat(const Value: String);
begin
  if FValueFormat <> value then
  begin
    FValueFormat := Value;
    RefreshColumn;
  end;
end;

procedure TTMSFMXColumn.SetWidth(const Value: Single);
begin
  if FWidth <> Value then
  begin
    FWidth := Value;
    UpdateColumn;
  end;
end;

function TTMSFMXColumn.Shape: TTMSFMXColumnShape;
var
  innerelement: TControl;
begin
  Result := nil;
  innerelement := FOwner.FindStyleResource('innerelement') as TControl;
  if Assigned(innerelement) then
    Result := innerelement.FindStyleResource('FMXSpinnerColumn'+inttostr(Index)) as TTMSFMXColumnShape;
end;

procedure TTMSFMXSpinner.Animate(Sender: TObject);
var
  d: single;
  posTo: integer;
  i: integer;
  spc: Integer;
  c: TTMSFMXColumn;
begin
  if (csDesigning in ComponentState) or (Columns.Count = 0) then
    Exit;

  for I := 0 to Columns.Count - 1 do
  begin
    c := Columns[I];
    if c.FAnimate then
    begin
      posTo := c.FScPosTo;
      d := Abs(posto - c.FCurrentScPos) / Max(1, Abs(c.FSp) * FAnimationFactor);
      spc := c.FCurrentScPos;
      c.FAnimating := AnimateDouble(spc, posto, d, 1);
      c.FCurrentScPos := spc;
      if c.FAnimating then
      begin
        if c.Cyclic then
        begin
          if c.FScPosTo >= (c.GetRangeCount + 1) * ColumnAppearance.TextSpacing then
          begin
            c.FCurrentScPos := c.FCurrentScPos - (c.GetRangeCount * ColumnAppearance.TextSpacing) - ColumnAppearance.TextSpacing;
            c.FScPosTo := c.FScPosTo - (c.GetRangeCount * ColumnAppearance.TextSpacing) - ColumnAppearance.TextSpacing;
            c.SetAnimatedValue;
          end
          else if c.FScPosTo <= -ColumnAppearance.TextSpacing then
          begin
            c.FCurrentScPos := c.FCurrentScPos + (c.GetRangeCount * ColumnAppearance.TextSpacing) +  ColumnAppearance.TextSpacing;
            c.FScPosTo := c.FScPosTo + (c.GetRangeCount * ColumnAppearance.TextSpacing) +  ColumnAppearance.TextSpacing;
            c.SetAnimatedValue;
          end;
        end;
        c.RefreshColumn;
      end
      else
      begin
        c.FAnimate := false;
        c.SetAnimatedValue;
        if Assigned(FOnSelectedValueChanged) then
          FOnSelectedValueChanged(Self, c.Index, c.FSelectedValue, c.RangeType);
      end;
    end;
  end;
end;

procedure TTMSFMXSpinner.CleanUpColumns(AControl: TFmxObject);
var
  str: TStringList;
  iSection: Integer;
  lName: String;
  innerElement: TFMXObject;
  i: integer;
  obj: TFMXObject;
  l: TTMSFMXColumnShape;
begin
  innerElement := AControl;

  str := TStringList.Create;
  for iSection := 0 to Columns.Count - 1 do
  begin
    lName := 'FMXSpinnerColumn'+inttostr(iSection);
    str.Add(UpperCase(lName+'Name'));
  end;

  if Assigned(innerElement) then
  begin
    for I := innerElement.ChildrenCount - 1 downto 0 do
    begin
      obj := innerElement.Children[i];
      if (obj is TTMSFMXColumnShape) then
      begin
        l := obj as TTMSFMXColumnShape;
        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 TTMSFMXSpinner.Create(AOwner: TComponent);
var
  i: integer;
begin
  inherited;
  ClipChildren := True;
  FAnimationFactor := 4;
  FColumnAppearance := TTMSFMXColumnAppearance.Create(Self);
  FColumns := TTMSFMXColumns.Create(Self);
  if (csDesigning in ComponentState) and not
    ((csReading in Owner.ComponentState) or (csLoading in Owner.ComponentState)) then
  begin
    for I := 0 to 2 do
      Columns.Add;
  end;

  FSmoothScrolling := False;
  FAnimateTimer := TTimer.Create(Self);
  FAnimateTimer.Interval := 1;
  FAnimateTimer.Enabled := true;
  FAnimateTimer.OnTimer := Animate;

  Width := 220;
  Height := 180;

end;

destructor TTMSFMXSpinner.Destroy;
begin
  FAnimateTimer.Free;
  FColumnAppearance.Free;
  FColumns.Free;
  inherited;
end;

function TTMSFMXSpinner.DoesColumnExist(AControl: TFmxObject;
  ColumnName: String): TTMSFMXColumnShape;
var
  innerElement: TFMXObject;
  i: integer;
  obj: TFMXObject;
  l: TTMSFMXColumnShape;
begin
  Result := nil;
  innerElement := AControl;
  if Assigned(innerElement) then
  begin
    for I := 0 to innerElement.ChildrenCount - 1 do
    begin
      obj := innerElement.Children[i];
      if (obj is TTMSFMXColumnShape) then
      begin
        l := obj as TTMSFMXColumnShape;
        if UpperCase(l.StyleName) = UpperCase(ColumnName) then
        begin
          Result := l;
          Break;
        end;
      end;
    end;
  end;
end;

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

function TTMSFMXSpinner.GetStyleObject: TFMXOBject;
begin
  Result := inherited GetStyleObject;
  UpdateColumns(Result);
end;

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

procedure TTMSFMXSpinner.RefreshColumns;
begin
  if csDestroying in ComponentState then
    Exit;

  ColumnAppearance.RefreshColumns;
end;

procedure TTMSFMXSpinner.Resize;
begin
  inherited;
  RefreshColumns;
end;

procedure TTMSFMXSpinner.SetAnimationFactor(const Value: integer);
begin
  FAnimationFactor := Value;
end;

procedure TTMSFMXSpinner.SetSmoothScrolling(const Value: Boolean);
begin
  FSmoothScrolling := Value;
end;

procedure TTMSFMXSpinner.Update;
begin
  inherited;
  UpdateColumns(Self);
end;

procedure TTMSFMXSpinner.UpdateColumns(AControl: TFmxObject);
var
  I: Integer;
  sn: String;
  newsec, sec: TTMSFMXColumnShape;
  innerElement: TControl;
  r: TRectF;
begin
  if Assigned(Acontrol) then
    innerElement := AControl.FindStyleResource('innerelement') as TControl
  else
    innerElement := Self.FindStyleResource('innerelement') as TControl;

  if Assigned(innerElement) then
  begin
    for I := 0 to Columns.Count - 1 do
    begin
      sn := 'FMXSpinnerColumn'+inttostr(I);
      sec := DoesColumnExist(innerelement, sn);
      if Assigned(sec) then
        newsec := sec
      else
      begin
        newsec := TTMSFMXColumnShape.Create(innerElement);
        newsec.BeginUpdate;
        newsec.HitTest := False;
        newsec.StyleName := sn;
        newsec.Locked := True;
        innerElement.AddObject(newsec);
        newsec.EndUpdate;
      end;

      newsec.HitTest := True;
      newsec.CanFocus := True;
      newsec.OnMouseWheel := Columns[I].DoMouseWheel;
      newsec.OnKeyDown := Columns[I].DoKeyDown;
      newsec.OnMouseDown := Columns[I].DoMouseDown;
      newsec.OnMouseMove := Columns[I].DoMouseMove;
      newsec.OnMouseUp := Columns[I].DoMouseUp;
      newsec.OnPaint := Columns[I].PaintColumn;
      newsec.Name := sn + 'Name';
      r := Columns[I].GetColumnRect;
      newsec.Position.X := r.Left;
      newsec.Position.Y := r.Top;
      newsec.Width := r.Width;
      newsec.Height := r.Height;
      newsec.SendToBack;
    end;
  end;

  CleanUpColumns(innerElement);

  RefreshColumns;
end;

{ TTMSFMXColumns }

function TTMSFMXColumns.Add: TTMSFMXColumn;
begin
  result := TTMSFMXColumn(inherited Add);
end;

constructor TTMSFMXColumns.Create(AOwner: TTMSFMXSpinner);
begin
  inherited Create(TTMSFMXColumn);
  FOwner := AOwner;
end;


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

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

function TTMSFMXColumns.Insert(Index: Integer): TTMSFMXColumn;
begin
  Result := TTMSFMXColumn(inherited Insert(Index));
end;

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

{ TTMSFMXColumn }

constructor TTMSFMXColumn.Create(Collection: TCollection);
begin
  inherited;
  FOwner := (Collection as TTMSFMXColumns).FOwner;
  FDrawIndex := Index;
  FWidth := 20;
  FRangeFrom := 0;
  FRangeTo := 20;
  FRangeType := srtNumber;
  FStep := 1;
  FValueFormat := '%g';
  FDateRangeFrom := Now;
  FDateRangeTo := Now + 20;
  FSaveDateRangeto := FDateRangeto;
  FSaveDateRangefrom := FDateRangeFrom;
  FDateTimeValueFormat := 'dd/mm/yy';
  FStepType := sstNumber;
  FFont := TFont.Create;
  FOnlyDate := false;
  FTextAlign := taCenter;

  FCustomItems := TTMSFMXSpinnerCustomItems.Create(FOwner);

  {$IFDEF DELPHIXE6_LVL}
  FFontAppearance := TBrush.Create(TBrushKind.Solid, claBlack);
  {$ELSE}
  FFontAppearance := TBrush.Create(TBrushKind.bkSolid, claBlack);
  {$ENDIF}

  if (csDesigning in FOwner.ComponentState) and not (csLoading in FOwner.ComponentState) then
  begin
    FFont.Size := 18;
    FFont.Style := [TFontStyle.fsBold];
  end;

  UpdateColumn;
end;

destructor TTMSFMXColumn.Destroy;
begin
  FCustomItems.Free;
  FFontAppearance.Free;
  FFont.Free;
  inherited;
  UpdateColumn;
end;

procedure TTMSFMXColumn.UpdateColumn;
var
  obj: TControl;
begin
  if csDesigning in FOwner.ComponentState then
  begin
    obj := nil;
    if Assigned(FOwner.Scene) and Assigned(FOwner.Scene.GetStyleBook) and Assigned(FOwner.Scene.GetStyleBook.Root) then
    begin
      if FOwner.StyleLookup <> '' then
        obj := TControl(FOwner.Scene.GetStyleBook.FindStyleResource(FOwner.StyleLookup))
      else
        obj := TControl(FOwner.Scene.GetStyleBook.FindStyleResource(FOwner.GetClassStyleName));
    end;

    if Assigned(obj) then
      FOwner.UpdateColumns(obj);

    FOwner.NeedStyleLookUp;
    FOwner.Repaint;
  end
  else
    FOwner.UpdateColumns(FOwner);
end;

procedure TTMSFMXColumn.DoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
var
  sel: Double;
begin
  inherited;
  sel := FSelectedValue;
  case Key of
    vkUp: sel := IncSteps(FSelectedValue, -1);
    vkDown: sel := IncSteps(FSelectedValue, 1);
    vkHome: sel := GetRangeFrom;
    vkEnd: sel := GetRangeTo;
    vkPrior: sel := IncSteps(FSelectedValue, -10);
    vkNext: sel := IncSteps(FSelectedValue, 10);
  end;

  if Cyclic then
  begin
    if sel = IncSteps(GetRangeFrom, 1) then
      sel := GetRangeFrom
    else if sel = IncSteps(GetRangeFrom, -1) then
      sel := GetRangeTo;
  end;

  sel := Min(GetRangeTo, Max(GetRangeFrom, sel));

  if (FSelectedValue <> sel) then
  begin
    ScrollToValue(sel, false);
    FOwner.Repaint;
  end;
end;

procedure TTMSFMXColumn.DoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  inherited;
  if (Sender is TTMSFMXColumnShape) then
    (Sender as TTMSFMXColumnShape).Capture;

  FMouseDown := true;
  FDragY := Round(Y);
  FScrollY := Round(Y);
  FTimeStart := GetTickCountX;
  FClickY := FDragY;
  FClickX := Round(X);
end;

procedure TTMSFMXColumn.DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
var
  pos: Integer;
begin
  inherited;
  if FMouseDown then
  begin
    if ((FDragY < y-FOwner.ColumnAppearance.TextSpacing / 2) or (FDragY > Y+FOwner.ColumnAppearance.TextSpacing / 2)) or FOwner.SmoothScrolling then
    begin
      FSp := 2;
      FAnimate := false;

      pos := FCurrentScPos;

      if (Y - FDragY) > 0 then
      begin
        pos := pos - Abs(Round(Y) - FDragY);
        if not FOwner.SmoothScrolling then
        begin
          while not ((pos mod FOwner.ColumnAppearance.TextSpacing) = 0) do
            pos := pos - 1;
        end;
      end
      else
      begin
        pos := pos + Abs(Round(Y) - FDragY);
        if not FOwner.SmoothScrolling then
        begin
          while not ((pos mod FOwner.ColumnAppearance.TextSpacing) = 0) do
            pos := pos + 1;
        end;
      end;

      if Cyclic then
      begin
        if pos = (GetRangeCount + 1) * FOwner.ColumnAppearance.TextSpacing then
          pos := 0
        else if pos = -FOwner.ColumnAppearance.TextSpacing then
          pos := GetRangeCount * FOwner.ColumnAppearance.TextSpacing;
      end;

      if (FOwner.SmoothScrolling and not Cyclic) or not FOwner.SmoothScrolling then
        pos := Max(0, Min(FOwner.ColumnAppearance.TextSpacing * GetRangeCount, pos));

      if not FOwner.SmoothScrolling then
      begin
        FSelectedValue := IncSteps(GetRangeFrom, pos div FOwner.ColumnAppearance.TextSpacing);

        if Assigned(FOwner.FOnSelectedValueChanged) then
          FOwner.FOnSelectedValueChanged(Self, Index, FSelectedValue, RangeType);
      end;

      FCurrentScPos := pos;
      FScPosTo := FCurrentScPos;
      if FOwner.SmoothScrolling then
      begin
        if (Y - FDragY) > 0 then
        begin
          while not ((FScPosTo mod FOwner.ColumnAppearance.TextSpacing) = 0) do
            FScPosTo := FScPosTo - 1;
        end
        else
        begin
          while not ((FScPosTo mod FOwner.ColumnAppearance.TextSpacing) = 0) do
            FScPosTo := FScPosTo + 1;
        end;
      end;

      FDragY := Round(Y);
      RefreshColumn;
    end;
  end
  else
  begin
    if FMouseUp then
    begin
      FMouseUp := false;

      if ((FTimeStop - FTimeStart) > 500) or ((FTimeStop - FTimeStart) = 0) then
        Exit;

      FSp := Abs(Y - FScrollY) / (FTimeStop - FTimeStart);
      if FSp > 0 then
      begin
        if (Y - FScrollY) > 0 then
        begin
          FScPosTo := FScPosTo - Round(Abs(Y - FScrollY) * FSp);
          while not ((FScPosTo mod FOwner.ColumnAppearance.TextSpacing) = 0) do
            FScPosTo := FScPosTo - 1;
        end
        else
        begin
          FScPosTo := FScPosTo + Round(Abs(Y - FScrollY) * FSp);
          while not ((FScPosTo mod FOwner.ColumnAppearance.TextSpacing) = 0) do
            FScPosTo := FScPosTo + 1;
        end;

        if not Cyclic then
          FScPosTo := Max(0, Min(FOwner.ColumnAppearance.TextSpacing * GetRangeCount, FScPosTo));
      end;
    end;
  end;
end;

procedure TTMSFMXColumn.DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
  Y: Single);
begin
  inherited;
  if (Sender is TTMSFMXColumnShape) then
    (Sender as TTMSFMXColumnShape).ReleaseCapture;
  if FAnimating and FAnimate then
  begin
    FAnimate := false;
    FScrollY := FCurrentScPos;
    FScPosTo := FCurrentScPos;
    FTimeStart := 0;
    FTimeStop := 0;
  end;
  FMouseDown := false;
  FMouseUp := true;
  FTimeStop := GetTickCountX;
  FAnimate := (FTimeStop - FTimeStart > 0);
end;

procedure TTMSFMXColumn.DoMouseWheel(Sender: TObject; Shift: TShiftState;
  WheelDelta: Integer; var Handled: Boolean);
begin
  inherited;
  if WheelDelta < 0 then
  begin
    FSp := FOwner.FAnimationFactor;
    FScPosTo := FScPosTo + FOwner.ColumnAppearance.TextSpacing
  end
  else
  begin
    FSp := FOwner.FAnimationFactor;
    FScPosTo := FScPosTo - FOwner.ColumnAppearance.TextSpacing
  end;
  if not Cyclic then
    FScPosTo := Max(0, Min(FOwner.ColumnAppearance.TextSpacing * GetRangeCount, FScPosTo));
  FAnimate := true;
end;

{ TTMSFMXSpinnerCustomItem }

procedure TTMSFMXSpinnerCustomItem.Changed;
begin
  FOwner.Repaint;
end;

constructor TTMSFMXSpinnerCustomItem.Create(Collection: TCollection);
begin
  inherited;
  FOwner := (Collection as TTMSFMXSpinnerCustomItems).FOwner;
end;

destructor TTMSFMXSpinnerCustomItem.Destroy;
begin
  inherited;
end;

procedure TTMSFMXSpinnerCustomItem.SetText(const Value: String);
begin
  if FText <> value then
  begin
    FText := Value;
    Changed;
  end;
end;

{ TTMSFMXSpinnerCustomItems }

function TTMSFMXSpinnerCustomItems.Add: TTMSFMXSpinnerCustomItem;
begin
  Result := TTMSFMXSpinnerCustomItem(inherited Add);
end;

constructor TTMSFMXSpinnerCustomItems.Create(AOwner: TTMSFMXSpinner);
begin
  inherited Create(TTMSFMXSpinnerCustomItem);
  FOwner := AOwner;
end;

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

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

function TTMSFMXSpinnerCustomItems.Insert(
  Index: Integer): TTMSFMXSpinnerCustomItem;
begin
  Result := TTMSFMXSpinnerCustomItem(inherited Insert(Index));
end;

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

procedure TTMSFMXSpinnerCustomItems.Update(Item: TCollectionItem);
begin
  FOwner.Repaint;
end;

{ TTMSFMXColumnShape }

constructor TTMSFMXColumnShape.Create(AOwner: TComponent);
begin
  inherited;
  FFocusColor := TAlphaColorRec.White;
end;

procedure TTMSFMXColumnShape.Paint;
begin
  inherited;
  if IsFocused and not DisableFocusEffect then
  begin
    Canvas.Stroke.Color := FocusColor;
    {$IFDEF DELPHIXE6_LVL}
    Canvas.StrokeDash := TStrokeDash.Dot;
    {$ELSE}
    Canvas.StrokeDash := TStrokeDash.sdDot;
    {$ENDIF}
    Canvas.StrokeThickness := 1.5;
    Canvas.DrawRect(BoundsRect, XRadius, YRadius, Corners, AbsoluteOpacity, CornerType);
  end;
end;

initialization
  RegisterFmxClasses([TTMSFMXColumnShape]);

end.
