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

interface

{$I TMSDEFS.INC}

uses
  SysUtils, Types, Classes, Math, FMX.Forms, FMX.Types, UITypes,
  FMX.TMSBaseControl, FMX.TMSHTMLText, FMX.TMSBitmapContainer
  , FMX.Controls, Generics.Collections
  {$IFDEF DELPHIXE5_LVL}
  , FMX.Graphics, FMX.Effects
  {$ENDIF}
  ;

const
  SHADOWSIZE = 12;

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

  // version history
  // v1.0.0.0 : first release
  // v1.0.0.1 : Improved : TMSIOS define
  // v1.5.0.0 : New : support for XE4
  // v1.5.0.1 : Fixed : Issue with Padding vs Margins

type
  TTMSFMXPageSlider = class;
  TTMSFMXPage = class;

  TDbgList = class(TList<TFmxObject>)
  private
    function GetItemsEx(Index: Integer): Pointer;
    procedure SetItemsEx(Index: Integer; const Value: Pointer);
  public
    property Items[Index: Integer]: Pointer read GetItemsEx write SetItemsEx; default;
  end;

  TTMSFMXPage = class(TTMSFMXBaseControl)
  private
    FDragged, FMouseDown: Boolean;
    FOldPosX: Single;
    FDownX, FDownY: Single;
    FLeftTemp: Single;
    FBlockUpdate: Boolean;
    FAnimating: Boolean;
    FCurrentPos: Single;
    FDesignTime: Boolean;
    FPageIndex: integer;
    FPageSlider: TTMSFMXPageSlider;
    FUpdatingParent: Boolean;
    FShowHeader: Boolean;
    FHeaderHeight: Integer;
    FHeader: String;
    FShowFooter: Boolean;
    FFooterHeight: Integer;
    FFooter: String;
    FMinimumWidth: Integer;
    FBitmapContainer: TTMSFMXBitmapContainer;
    FOnFooterAnchorClick: TTMSFMXHTMLTextAnchorClickEvent;
    FOnHeaderAnchorClick: TTMSFMXHTMLTextAnchorClickEvent;
    FEffect: Boolean;
    procedure SetPageSlider(const Value: TTMSFMXPageSlider);
    function GetPageIndex: Integer;
    procedure SetPageIndex(const Value: Integer);
    procedure SetFooter(const Value: String);
    procedure SetHeader(const Value: String);
    procedure SetMinimumWidth(const Value: Integer);
    procedure SetCurrentPos(const Value: Single);
    function GetCurrentPos: Single;
    procedure SetBitmapContainer(const Value: TTMSFMXBitmapContainer);
    procedure SetEffect(const Value: Boolean);
  protected
    procedure ApplyStyle; override;
    function GetHeaderText: TControl;
    function GetFooterText: TControl;
    function GetHeader: TControl;
    function GetFooter: TControl;
    function GetContent: TControl;
    function GetEffect: TEffect;
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    property CurrentPos: Single read GetCurrentPos write SetCurrentPos;
    function GetPosTo: Single;
    procedure DoKeyDown(Sender: TObject; var Key: Word; var KeyChar: WideChar; Shift: TShiftState);
    procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure DoMouseLeaveAction(Sender: TObject);
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure SetParentComponent(Value: TComponent); override;
    procedure ReadState(Reader: TReader); override;
    procedure AssignEvents;
    procedure UpdateHeader;
    procedure UpdateEffect;
    procedure UpdateFooter;
    procedure UpdateMargins; virtual;
    procedure DoHeaderAnchorClick(Sender: TObject; Anchor: string);
    procedure DoFooterAnchorClick(Sender: TObject; Anchor: string);
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SetBounds(X, Y, AWidth, AHeight: Single); override;
    property PageSlider: TTMSFMXPageSlider read FPageSlider write SetPageSlider;
  published
    property Header: String read FHeader write SetHeader;
    property Footer: String read FFooter write SetFooter;
    property MinimumWidth: Integer read FMinimumWidth write SetMinimumWidth default 200;
    property PageIndex: Integer read GetPageIndex write SetPageIndex stored false;
    property BitmapContainer: TTMSFMXBitmapContainer read FBitmapContainer write SetBitmapContainer;

    property OnHeaderAnchorClick: TTMSFMXHTMLTextAnchorClickEvent read FOnHeaderAnchorClick write FOnHeaderAnchorClick;
    property OnFooterAnchorClick: TTMSFMXHTMLTextAnchorClickEvent read FOnFooterAnchorClick write FOnFooterAnchorClick;
    property Effect: Boolean read FEffect write SetEffect;
  end;

  TPageMovedEvent = procedure(Sender: TObject; FromPos: integer; ToPos: Integer) of object;
  TPageChangingEvent = procedure(Sender: TObject; FromPage, ToPage: Integer; var AllowChange: Boolean) of object;

  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXPageSlider = class(TTMSFMXPage)
  private
    FAnimate: Boolean;
    FTimer: TTimer;
    FPages: TDbgList;
    FPropertiesLoaded: Boolean;
    FActivePageIndex: Integer;
    FOnChange: TNotifyEvent;
    FConstructed, FDesignTime: boolean;
    FShowFocus: Boolean;
    FOnPageMoved: TPageMovedEvent;
    FOnChanging: TPageChangingEvent;
    FAnimationFactor: Integer;
    procedure SetAllPagesPosition;
    function GetPageCount: integer;
    function GetPage(index: integer): TTMSFMXPage;
    function GetActivePage: TTMSFMXPage;
    function GetActivePageIndex: Integer;
    procedure SetActivePage(const Value: TTMSFMXPage);
    procedure SetActivePageIndex(const Value: Integer);
    function GetVersion: string;
    function GetVersionNr: Integer;
    procedure SetVersion(const Value: string);
    procedure SetAnimationFactor(const Value: Integer);
  protected
    procedure UpdateMargins; override;
    function GetClassStyleName: String; override;
    function GetPageRect: TRectF;
    procedure DialogKey(var Key: Word; Shift: TShiftState); override;
    procedure DoTimer(Sender: TObject);
    procedure Notification(AComponent: TComponent; Operation: TOperation); override;
    procedure Resize; override;
    procedure ChangeActivePage(PageIndex: Integer);
    function IsActivePageNeighbour(PageIndex: Integer): Integer;
  public
    procedure Paint; override;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure GetChildren(Proc: TGetChildProc; Root: TComponent); override;
    function AddPage(APage: TTMSFMXPage): integer; overload;
    function AddPage(PageCaption: String): integer; overload;
    procedure RemovePage(APage: TTMSFMXPage);
    procedure MovePage(CurIndex, NewIndex: Integer);
    function FindNextPage(CurPage: TTMSFMXPage; GoForward: Boolean): TTMSFMXPage;
    procedure SelectNextPage(GoForward: Boolean);
    function IndexOfPage(APage: TTMSFMXPage): Integer;
    property PageCount: integer read GetPageCount;
    property Pages[index: integer]: TTMSFMXPage read GetPage;
    procedure NextPage;
    procedure PreviousPage;
  published
    property AnimationFactor: Integer read FAnimationFactor write SetAnimationFactor default 5;
    property Align;
    property Anchors;
    property ActivePage: TTMSFMXPage read GetActivePage write SetActivePage;
    property ShowHint;
    property Version: string read GetVersion write SetVersion stored false;
    property ActivePageIndex: Integer read GetActivePageIndex write SetActivePageIndex;
    property Visible;
    property OnPageMoved: TPageMovedEvent read FOnPageMoved write FOnPageMoved;
    property OnPageChange: TNotifyEvent read FOnChange write FOnChange;
    property OnPageChanging: TPageChangingEvent read FOnChanging write FOnChanging;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property OnDragDrop;
    property OnDragOver;
    property OnEnter;
    property OnExit;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property TabOrder;
  end;

implementation

{$R FMX.TMSPage.res}

function AnimateDouble(var Start, Stop: Single; 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;

{ TDbgList }

function TDbgList.GetItemsEx(Index: Integer): Pointer;
begin
  if (Index >= Count) then
  begin
    raise Exception.Create('Index out of bounds in list read access');
  end;

  if Index < Count then
    Result := inherited Items[Index]
  else
    Result := nil;
end;

procedure TDbgList.SetItemsEx(Index: Integer; const Value: Pointer);
begin
  if (Index >= Count) then
  begin
    raise Exception.Create('Index out of bounds in list write access');
  end;
  if Index < Count then
    inherited Items[ Index] := value;
end;

{ TTMSFMXPage }

procedure TTMSFMXPage.ApplyStyle;
begin
  inherited;
  AssignEvents;
  UpdateHeader;
  UpdateFooter;
  UpdateEffect;
  UpdateMargins;
end;

procedure TTMSFMXPage.AssignEvents;
var
  f, c, h, ftxt, htxt: TControl;
begin
  f := GetFooter;
  h := GetHeader;
  c := GetContent;
  if Assigned(f) then
  begin
    f.CanFocus := True;
    f.OnMouseDown := DoMouseDown;
    f.OnKeyDown := DoKeyDown;
    f.OnMouseUp := DoMouseUp;
    f.OnMouseMove := DoMouseMove;
  end;

  ftxt := GetFooterText;
  if Assigned(ftxt) and (ftxt is TTMSFMXHTMLText) then
    (ftxt as TTMSFMXHTMLText).OnAnchorClick := DoFooterAnchorClick;

  htxt := GetHeaderText;
  if Assigned(htxt) and (htxt is TTMSFMXHTMLText) then
    (htxt as TTMSFMXHTMLText).OnAnchorClick := DoHeaderAnchorClick;

  if Assigned(h) then
  begin
    h.CanFocus := True;
    h.OnMouseDown := DoMouseDown;
    h.OnMouseUp := DoMouseUp;
    h.OnKeyDown := DoKeyDown;
    h.OnMouseMove := DoMouseMove;
  end;

  if Assigned(c) then
  begin
    c.CanFocus := True;
    c.OnKeyDown := DoKeyDown;
    c.OnMouseDown := DoMouseDown;
    c.OnMouseUp := DoMouseUp;
    c.OnMouseMove := DoMouseMove;
  end;
end;

constructor TTMSFMXPage.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);

  FDesignTime := (csDesigning in ComponentState) and not
      ((csReading in Owner.ComponentState) or (csLoading in Owner.ComponentState));

  FHeaderHeight := 44;
  FMinimumWidth := 200;
  FFooterHeight := 44;
  FShowHeader := True;
  FShowFooter := True;
  FEffect := True;

  if FDesignTime then
  begin
    FHeader := 'Main Page';
    FFooter := 'Footer';
  end;
end;

destructor TTMSFMXPage.Destroy;
begin
  if (FPageSlider <> nil) then
    FPageSlider.RemovePage(Self);
  inherited;
end;

procedure TTMSFMXPage.SetPageSlider(const Value: TTMSFMXPageSlider);
begin
  if (FPageSlider <> Value) then
  begin
    if FPageSlider <> nil then FPageSlider.RemovePage(Self);
    Parent := Value;
    if (Value <> nil) then
    begin
      Value.AddPage(Self);
      if not (csLoading in ComponentState) then
      begin
        if Value.PageCount > 1 then
        begin
          // assign page appearance
        end;
      end;
    end;
  end;
end;

procedure TTMSFMXPage.SetParentComponent(Value: TComponent);
var
  ci, ni: Integer;
  APageSlider: TTMSFMXPageSlider;
begin
  if ((Value is TTMSFMXPage) or (Value is TTMSFMXPageSlider)) and not (FUpdatingParent) then
  begin
    APageSlider := nil;
    if (Value is TTMSFMXPage) then
    begin
      APageSlider := TTMSFMXPage(Value).FPageSlider;
    end
    else if (Value is TTMSFMXPageSlider) then
    begin
      APageSlider := TTMSFMXPageSlider(Value);
    end;

    if Assigned(FPageSlider) and Assigned(APageSlider) then
    begin
      if (FPageSlider <> APageSlider) then
      begin
        FUpdatingParent := True;
        FPageSlider := APageSlider;
        FUpdatingParent := False;
      end;

      if (FPageSlider = APageSlider) then
      begin
        if (Value is TTMSFMXPage) then
        begin
          ci := FPageSlider.IndexOfPage(self);
          ni := FPageSlider.IndexOfPage(TTMSFMXPage(Value));
          Value := APageSlider;
          if (ci >= 0) and (ci < FPageSlider.FPages.Count) and
             (ni >= 0) and (ni < FPageSlider.FPages.Count) then
          begin
            FPageSlider.MovePage(ci, ni);
          end
          else
            raise Exception.Create('Invalid Parent '+inttostr(ci)+':'+inttostr(ni));
        end
        else if (Value is TTMSFMXPageSlider) then
        begin
          Value := APageSlider;
        end;
      end
      else
        raise Exception.Create('Invalid Parent');
    end;
  end;
  inherited;
end;

procedure TTMSFMXPage.UpdateHeader;
var
  htxt: TControl;
begin
  htxt := GetHeaderText;
  if Assigned(htxt) and (htxt is TTMSFMXHTMLText) then
  begin
    (htxt as TTMSFMXHTMLText).Text := Header;
    (htxt as TTMSFMXHTMLText).BitmapContainer := BitmapContainer;
  end;
end;

procedure TTMSFMXPage.UpdateMargins;
var
  h, f: TControl;
begin
  h := GetHeader;
  f := GetFooter;

  if Assigned(h) then
    if h.Visible then
      Padding.Top := h.Height;

  if Assigned(f) then
    if f.Visible then
      Padding.Bottom := f.Height;
end;

procedure TTMSFMXPage.UpdateEffect;
var
  ef: TEffect;
begin
  ef := GetEffect;
  if Assigned(ef) then
    ef.Enabled := Effect and not (csDesigning in ComponentState);
end;

procedure TTMSFMXPage.UpdateFooter;
var
  ftxt: TControl;
begin
  ftxt := GetFooterText;
  if Assigned(ftxt) and (ftxt is TTMSFMXHTMLText) then
  begin
    (ftxt as TTMSFMXHTMLText).Text := Footer;
    (ftxt as TTMSFMXHTMLText).BitmapContainer := BitmapContainer;
  end;
end;

procedure TTMSFMXPage.ReadState(Reader: TReader);
begin
  inherited ReadState(Reader);
  if Reader.Parent is TTMSFMXPageSlider then
    PageSlider := TTMSFMXPageSlider(Reader.Parent);
end;

procedure TTMSFMXPage.SetBitmapContainer(const Value: TTMSFMXBitmapContainer);
begin
  FBitmapContainer := Value;
end;

procedure TTMSFMXPage.SetBounds(X, Y, AWidth, AHeight: Single);
begin
  inherited;
end;

procedure TTMSFMXPage.SetCurrentPos(const Value: Single);
var
  r: TRectF;
begin
  if Assigned(FPageSlider) then
  begin
    r := FPageSlider.GetPageRect;
    FCurrentPos := Max(r.Left, Min(r.Right, Value));
  end;
end;

procedure TTMSFMXPage.SetEffect(const Value: Boolean);
begin
  if FEffect <> Value then
  begin
    FEffect := Value;
    UpdateEffect;
  end;
end;

procedure TTMSFMXPage.SetFooter(const Value: String);
begin
  if FFooter <> Value then
  begin
    FFooter := Value;
    UpdateFooter;
  end;
end;

procedure TTMSFMXPage.SetHeader(const Value: String);
begin
  if FHeader <> Value then
  begin
    FHeader := Value;
    UpdateHeader;
  end;
end;

procedure TTMSFMXPage.SetMinimumWidth(const Value: Integer);
var
  I: Integer;
begin
  if FMinimumWidth <> Value then
  begin
    FMinimumWidth := Value;
    if Assigned(PageSlider) then
    begin
      if not FBlockUpdate then
        PageSlider.SetAllPagesPosition;
    end
    else
    begin
      if Self is TTMSFMXPageSlider then
      begin
        FBlockUpdate := True;
        for I := 0 to (Self as TTMSFMXPageSlider).PageCount - 1 do
          (Self as TTMSFMXPageSlider).Pages[I].MinimumWidth := Value;
        FBlockUpdate := False;

        (Self as TTMSFMXPageSlider).SetAllPagesPosition;
      end;
    end;
  end;

  UpdateMargins;
end;

function TTMSFMXPage.GetContent: TControl;
begin
  Result := FindStyleResource('content') as TControl;
end;

function TTMSFMXPage.GetCurrentPos: Single;
var
  r: TRectF;
begin
  Result := 0;
  if Assigned(FPageSlider) then
  begin
    r := FPageSlider.GetPageRect;
    Result := Max(r.Left, Min(r.Right, FCurrentPos));
  end;
end;

function TTMSFMXPage.GetFooter: TControl;
begin
  Result := FindStyleResource('footer') as TControl;
end;

function TTMSFMXPage.GetFooterText: TControl;
begin
  Result := FindStyleResource('footertext') as TControl;
end;

function TTMSFMXPage.GetHeader: TControl;
begin
  Result := FindStyleResource('header') as TControl;
end;

function TTMSFMXPage.GetHeaderText: TControl;
begin
  Result := FindStyleResource('headertext') as TControl;
end;

function TTMSFMXPage.GetPageIndex: Integer;
begin
  if Assigned(FPageSlider) then
    Result := FPageSlider.IndexOfPage(Self)
  else
    Result := -1;
end;

function TTMSFMXPage.GetPosTo: Single;
begin
  if FPageSlider.ActivePageIndex = PageIndex then
  begin
    if FLeftTemp < MinimumWidth * 2  then
      Result := MinimumWidth
    else
      Result := MinimumWidth * 2;
  end
  else if FPageSlider.ActivePageIndex > PageIndex then
  begin
    if FLeftTemp < MinimumWidth then
      Result := 0
    else
      Result := MinimumWidth
  end
  else if FPageSlider.ActivePageIndex < PageIndex then
    Result := FPageSlider.GetPageRect.Right
  else
    Result := GetCurrentPos;
end;

function TTMSFMXPage.GetEffect: TEffect;
begin
  Result := FindStyleResource('contenteffect') as TEffect;
end;

procedure TTMSFMXPage.DoFooterAnchorClick(Sender: TObject; Anchor: string);
begin
  if Assigned(OnFooterAnchorClick) then
    OnFooterAnchorClick(Sender, Anchor);
end;

procedure TTMSFMXPage.DoHeaderAnchorClick(Sender: TObject; Anchor: string);
begin
  if Assigned(OnHeaderAnchorClick) then
    OnHeaderAnchorClick(Sender, Anchor);
end;

procedure TTMSFMXPage.DoKeyDown(Sender: TObject; var Key: Word;
  var KeyChar: WideChar; Shift: TShiftState);
var
  pg: TTMSFMXPageSlider;
begin
  if Self is TTMSFMXPageSlider then
    pg := Self as TTMSFMXPageSlider
  else
    pg := PageSlider;

  if Assigned(pg) then
  begin
    case Key of
      vkHome: pg.ActivePageIndex := 0;
      vkEnd: pg.ActivePageIndex := pg.PageCount - 1;
      vkLeft, vkUp: pg.SelectNextPage(False);
      vkRight, vkDown: pg.SelectNextPage(True);
    end;
  end;
end;

procedure TTMSFMXPage.DoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
  Y: Single);
begin
  if (Sender is TControl) then
    (Sender as TControl).SetFocus;

  FDownX := X;
  FDownY := Y;
  FMouseDown := True;
  Foldposx := X;
  if not (csDesigning in ComponentState)  and Assigned(PageSlider) then
  begin
    if Assigned(FPageSlider) then
      FPageSlider.FAnimate := False;
  end;
end;

procedure TTMSFMXPage.DoMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Single);
var
  p: TPointF;
  I: Integer;
  page, nextpage: TTMSFMXPage;
begin
  inherited;
  FDragged := FMouseDown and not ((X >= FDownX - 2) and (X <= FDownX + 1) and (Y >= FDownY - 2) and (Y <= FDownY + 2));
  if FDragged and not (csDesigning in ComponentState) and Assigned(PageSlider) then
  begin
    if FPageSlider.ActivePageIndex = PageIndex then
    begin
      p := LocalToScreen(PointF(Position.X, Position.Y));
      Position.X := Position.X - (FOldPosX - x);
      CurrentPos := Position.X;
      for I :=  0 to PageIndex - 1 do
      begin
        page := TTMSFMXPage(FPageSlider.FPages[I]);
        nextpage := TTMSFMXPage(FPageSlider.FPages[I + 1]);
        if Assigned(page) and Assigned(nextpage) then
        begin
          page.CurrentPos := nextpage.Position.X - page.MinimumWidth;
          if (nextpage.CurrentPos <= page.GetCurrentPos) then
            page.CurrentPos := nextpage.CurrentPos
          else if (nextpage.CurrentPos >= page.GetCurrentPos + page.Width)  then
            page.Position.X := nextpage.Position.X - page.Width
          else
            page.Position.X := page.GetCurrentPos;

          page.FLeftTemp := page.Position.X;
          nextpage.FLeftTemp := nextpage.Position.X;
          page.CurrentPos := page.Position.X;
          nextpage.CurrentPos := nextpage.CurrentPos;
        end;
      end;
    end;
  end;
end;

procedure TTMSFMXPage.DoMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X,
  Y: Single);
begin
  FMouseDown := False;
  if FDragged then
  begin
    if not (csDesigning in ComponentState) and Assigned(PageSlider) then
    begin
      if Assigned(FPageSlider) then
      begin
        if Position.X < Max(150, MinimumWidth / 2) then
          FPageSlider.NextPage
        else if Position.X > FPageSlider.Width - Max(150, MinimumWidth) then
          FPageSlider.PreviousPage
      end;

      if Assigned(FPageSlider) then
        FPageSlider.FAnimate := True;
    end;
  end
  else
  begin
    if Assigned(FPageSlider) then
    begin
      if (X >= FDownX - 2) and (X <= FDownX + 1) and (Y >= FDownY - 2) and (Y <= FDownY + 2) then
        FPageSlider.ActivePageIndex := PageIndex;
    end;
  end;
  FDragged := False;
end;

procedure TTMSFMXPage.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if not (csDestroying in ComponentState) then
  begin
    if (Operation = opRemove) and (AComponent = FBitmapContainer) then
      FBitmapContainer := nil;
  end;
  inherited;
end;

procedure TTMSFMXPage.SetPageIndex(const Value: Integer);
begin
  if Assigned(FPageSlider) and (Value >= 0) and (Value < FPageSlider.PageCount) then
    FPageSlider.MovePage(FPageSlider.IndexOfPage(Self), Value);
end;

{ TTMSFMXPageSlider }

constructor TTMSFMXPageSlider.Create(AOwner: TComponent);
var
  t: TTMSFMXPage;
begin
  FConstructed := false;
  inherited;

  FPages := TDbgList.Create;

  ClipChildren := True;
  FActivePageIndex := -1;
  FAnimationFactor := 5;
  Height := 400;
  Width := 600;

  FShowFocus := true;

  FTimer := TTimer.Create(Self);
  FTimer.Interval := 10;
  FTimer.OnTimer := DoTimer;
  FTimer.Enabled := True;

  FDesignTime := (csDesigning in ComponentState) and not
      ((csReading in Owner.ComponentState) or (csLoading in Owner.ComponentState));

  if FDesignTime then
  begin
    t := TTMSFMXPage.Create(Owner);
    t.PageSlider := self;
    t.Name := 'Page1';
    t.Header := 'Page 1';
    t := TTMSFMXPage.Create(Owner);
    t.PageSlider := self;
    t.Name := 'Page2';
    t.Header := 'Page 2';
    t := TTMSFMXPage.Create(Owner);
    t.PageSlider := self;
    t.Name := 'Page3';
    t.Header := 'Page 3';
    ActivePageIndex := 0;
  end;
end;

destructor TTMSFMXPageSlider.Destroy;
var
  i: Integer;
begin
  for I := 0 to FPages.Count - 1 do
    TTMSFMXPage(FPages[I]).FPageSlider := nil;

  FPages.Free;
  FTimer.Free;
  inherited;
end;

procedure TTMSFMXPage.DoMouseLeaveAction(Sender: TObject);
begin
  inherited;
  if FDragged then
    DoMouseUp(Sender, TMouseButton.mbLeft, [], 0, 0);
end;

procedure TTMSFMXPageSlider.DoTimer(Sender: TObject);
var
  d: Double;
  posto, pos: Single;
  I: Integer;
  aPage: TTMSFMXPage;
  anim: Boolean;
begin
  if (csDesigning in ComponentState) or (csDestroying in ComponentState) then
    Exit;

  if FAnimate then
  begin
    anim := False;
    for I := 0 to PageCount - 1 do
    begin
      aPage := TTMSFMXPage(Pages[I]);
      posTo := aPage.GetPosTo;
      d := Abs(posto - aPage.GetCurrentPos) / AnimationFactor;
      pos := aPage.CurrentPos;
      aPage.FAnimating := AnimateDouble(pos, posto, d, 1);
      aPage.CurrentPos := pos;
      anim := anim or aPage.FAnimating;
      if not apage.FAnimating then
        apage.FLeftTemp := 0;
    end;
    FAnimate := anim;
    SetAllPagesPosition;
  end;
end;

procedure TTMSFMXPageSlider.MovePage(CurIndex, NewIndex: Integer);
var
  OldActivePage: TTMSFMXPage;
begin
  if (CurIndex >= 0) and (CurIndex < FPages.Count) and
     (NewIndex >= 0) and (NewIndex < FPages.Count) then
  begin
    OldActivePage := ActivePage;
    FPages.Move(CurIndex, NewIndex);
    ActivePage := OldActivePage;

    if Assigned(FOnPageMoved) then
      FOnPageMoved(Self, CurIndex, NewIndex);
  end;
end;

function TTMSFMXPageSlider.AddPage(APage: TTMSFMXPage): integer;
begin
  Result := FPages.IndexOf(APage);
  if (FPages.IndexOf(APage) < 0) then
  begin
    FPages.Add(APage);
    APage.FPageIndex := FPages.Count - 1;
    Result := FPages.Count - 1;
  end;

  if (APage.Parent <> Self) then
    APage.Parent := Self;
  APage.FPageSlider := Self;
  SetAllPagesPosition;

  if Assigned(ActivePage) then
    ActivePage.BringToFront;
end;

function TTMSFMXPageSlider.AddPage(PageCaption: String): integer;
var
  aPage: TTMSFMXPage;
begin
  aPage := TTMSFMXPage.Create(Self);
  {$IFDEF DELPHIXE6_LVL}
  aPage.Align := TAlignLayout.Client;
  {$ELSE}
  aPage.Align := TAlignLayout.alClient;
  {$ENDIF}
  aPage.Header := PageCaption;
  aPage.FPageIndex := FPages.Count - 1;
  Result := AddPage(aPage);
end;

procedure TTMSFMXPageSlider.NextPage;
begin
  ActivePageIndex := ActivePageIndex + 1;
end;

procedure TTMSFMXPageSlider.Notification(AComponent: TComponent;
  Operation: TOperation);
begin
  if not (csDestroying in ComponentState) and (Operation = opRemove) then
  begin
    if (AComponent = PopupMenu) then
      PopupMenu := nil;
  end;

  inherited;
end;

procedure TTMSFMXPageSlider.Paint;
begin
  inherited;

  if (csDesigning in ComponentState) and (FPages.Count = 0) then
  begin
//    Canvas.Font.Assign(self.Font);
//    Canvas.Brush.Style := bsClear;
//    th := Canvas.TextHeight('gh');
//    Canvas.TextOut(10, Height div 2, 'Right-click and choose "New Page"');
//    Canvas.TextOut(10, (Height div 2) + th,'to insert a new page');
//    Canvas.Font.Style := [fsItalic];
//    Canvas.TextOut(10, Height div 2 + 3*th, 'If no such right-click menu option appears');
//    Canvas.TextOut(10, Height div 2 + 4*th, 'please install designtime package!');
  end;
end;

procedure TTMSFMXPageSlider.PreviousPage;
begin
  ActivePageIndex := ActivePageIndex - 1;
end;

procedure TTMSFMXPageSlider.RemovePage(APage: TTMSFMXPage);
var
  i, ni: Integer;
begin
  i := FPages.IndexOf(APage);
  if (i >= 0) then
  begin
    if i < ActivePageIndex then
      ni := ActivePageIndex - 1
    else
      ni := ActivePageIndex;

    if (ActivePage = APage) then
      SelectNextPage(True);

    FPages.Delete(i);
    APage.FPageSlider := nil;

    ActivePageIndex := ni;
  end;
end;

procedure TTMSFMXPageSlider.Resize;
var
  i: Integer;
begin
  inherited;
  Padding.Right := Width - MinimumWidth;
  for I := 0 to pageCount - 1 do
    TTMSFMXPage(Pages[I]).CurrentPos := TTMSFMXPage(Pages[I]).GetPosTo;

  SetAllPagesPosition;
end;

function TTMSFMXPageSlider.GetPageCount: integer;
begin
  Result := FPages.Count;
end;

function TTMSFMXPageSlider.GetPage(index: integer): TTMSFMXPage;
begin
  Result := TTMSFMXPage(FPages[index]);
end;

procedure TTMSFMXPageSlider.GetChildren(Proc: TGetChildProc;
  Root: TComponent);
var
  I: Integer;
  Control: TFmxObject;
begin
  for I := 0 to FPages.Count - 1 do Proc(TComponent(FPages[I]));

  for I := 0 to ChildrenCount - 1 do
  begin
    Control := Children[I];
    if (Control.Owner = Root) and (FPages.IndexOf(Control) < 0) then Proc(Control);
  end;
end;

function TTMSFMXPageSlider.GetClassStyleName: String;
begin
  Result := 'TTMSFMXPagestyle';
  Delete(Result, 1, 1);
end;

function TTMSFMXPageSlider.FindNextPage(CurPage: TTMSFMXPage; GoForward: Boolean): TTMSFMXPage;
var
  i, CurIndex: Integer;
begin
  Result := nil;
  CurIndex := FPages.IndexOf(CurPage);


  if (CurPage = nil) or (CurIndex < 0) then
  begin

    if FPages.Count > 0 then
    begin
      if GoForward then
        Result := FPages[0]
      else
        Result := FPages[FPages.Count - 1];
    end;
    Exit;
  end;

  if GoForward then
  begin
    i := CurIndex;
    Inc(i);
    if (i >= FPages.Count) then
      i := 0;

    Result := Pages[i];
  end
  else  // BackWard
  begin
    i := CurIndex;
    dec(i);
    if (i >= FPages.Count) then
      i := 0;
    if (i < 0) then
      i := FPages.Count-1;

    Result := Pages[i];
  end;
end;

function TTMSFMXPageSlider.GetActivePage: TTMSFMXPage;
begin
  Result := nil;
  if (ActivePageIndex >= 0) and (ActivePageIndex < FPages.Count) then
    Result := Pages[FActivePageIndex];
end;

function TTMSFMXPageSlider.GetActivePageIndex: Integer;
begin
  Result := FActivePageIndex;
end;

procedure TTMSFMXPageSlider.SelectNextPage;
begin
  if GoForward then
    NextPage
  else
    PreviousPage;
end;

function TTMSFMXPageSlider.IndexOfPage(APage: TTMSFMXPage): Integer;
begin
  Result := FPages.IndexOf(APage);
end;

procedure TTMSFMXPageSlider.SetActivePage(const Value: TTMSFMXPage);
begin
  if (FPages.IndexOf(Value) >= 0) then
    ActivePageIndex := FPages.IndexOf(Value);
end;

procedure TTMSFMXPageSlider.ChangeActivePage(PageIndex: Integer);
var
  AllowChange: Boolean;
  I: Integer;
begin
  if (PageIndex >= -1) and (PageIndex < FPages.Count) then
  begin
    AllowChange := True;
    if Assigned(FOnChanging) and FPropertiesLoaded and not (csDestroying in ComponentState) then
      FOnChanging(Self, ActivePageIndex, PageIndex, AllowChange);

    if not AllowChange then
      Exit;

    FActivePageIndex := PageIndex;

    if Assigned(FOnChange) and not (csDestroying in ComponentState)
      and not (csLoading in ComponentState) then
      FOnChange(Self);

    if FActivePageIndex > -1 then
    begin
      for I := 0 to GetPageCount - 1 do
      begin
        if (csDesigning in ComponentState) and (TTMSFMXPage(FPages[I]).PageIndex <> PageIndex) then
          TTMSFMXPage(FPages[PageIndex]).Visible := False
        else
        begin
          if not  TTMSFMXPage(FPages[PageIndex]).Visible then
            TTMSFMXPage(FPages[PageIndex]).Visible := True;

          TTMSFMXPage(FPages[PageIndex]).BringToFront;
        end;
      end;
    end;
  end;

  SetAllPagesPosition;
end;

procedure TTMSFMXPageSlider.SetActivePageIndex(const Value: Integer);
begin
  ChangeActivePage(Value);
  FAnimate := True;
end;

procedure TTMSFMXPageSlider.SetAllPagesPosition;
var
  i: Integer;
  R: TRectF;
  APage: TTMSFMXPage;
begin
  R := GetPageRect;
  for i := 0 to FPages.Count - 1 do
  begin
    APage := TTMSFMXPage(FPages[i]);
    if (APage <> nil) and (FPages.IndexOf(APage) >= 0) then
    begin
      if csDesigning in ComponentState then
      begin
        APage.SetBounds(r.Left + APage.MinimumWidth, R.Top, R.Right - r.Left - APage.MinimumWidth,
          R.Bottom - R.Top);
      end
      else
      begin
        if (csLoading in ComponentState) then
          APage.CurrentPos := r.Right;

        APage.SetBounds(r.Left + APage.GetCurrentPos, R.Top, R.Right - r.Left - APage.MinimumWidth,
          R.Bottom - R.Top);
      end;
    end;
  end;
end;

procedure TTMSFMXPageSlider.SetAnimationFactor(const Value: Integer);
begin
  if FAnimationFactor <> Value then
    FAnimationFactor := Max(1, Value);
end;

function TTMSFMXPageSlider.GetPageRect: TRectF;
begin
  Result := BoundsRect;
end;

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

procedure TTMSFMXPageSlider.SetVersion(const Value: string);
begin

end;

procedure TTMSFMXPageSlider.UpdateMargins;
begin
  inherited;
  Padding.Right := Width - MinimumWidth;
end;

procedure TTMSFMXPageSlider.DialogKey(var Key: Word; Shift: TShiftState);
begin
  inherited;
end;

function TTMSFMXPageSlider.IsActivePageNeighbour(
  PageIndex: Integer): Integer;
var
  i: Integer;
begin
  Result := 0;
  if (PageIndex = ActivePageIndex) or (PageIndex < 0) or (PageIndex >= PageCount) then
    Exit;

  if (PageIndex < ActivePageIndex) then
  begin
    for i:= ActivePageIndex - 1 downto PageIndex do
    begin
      if (i = PageIndex) then
        Result := -1;
      Break;
    end;
  end
  else
  begin
    for i:= ActivePageIndex + 1 to PageIndex do
    begin
      if (i = PageIndex) then
        Result := 1;
      Break;
    end;
  end;
end;

end.

