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

interface

{$I TMSDEFS.INC}

uses
  Classes, SysUtils, DateUtils, FMX.Controls, FMX.Objects, Types, FMX.Platform,
  FMX.Types, FMX.TMSBaseControl, FMX.Forms, UITypes, FMX.Dialogs, Math, FMX.TMSHTMLText,
  FMX.Menus, FMX.TMSEdit, FMX.StdCtrls, FMX.ExtCtrls
  {$IFDEF DELPHIXE5_LVL}
  , FMX.Graphics
  {$ENDIF}
  ;

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

  // version history
  // v1.0.0.0 : first release
  // v1.0.0.1 : Fixed : Issue with Delphi XE3 compatibility
  // v1.0.0.2 : Fixed : Issue with focusing calendar
  // v1.0.0.3 : Fixed : Issue with dblclick in TTMSFMXEdit
  // v1.0.0.4 : Improved : Escape to cancel date selection and return to previous selected date
  // v1.5.0.0 : New : support for XE4
  // v1.5.0.1 : Fixed : Issue with year sequence initialization in popup picker
  // v1.5.0.2 : Fixed : Issue with date parsing
  // v1.5.1.0 : New : OnMonthChanged and OnYearChanged events
  // v1.5.1.1 : Fixed : Issue with mouse enter/leave
  // v1.5.1.2 : Fixed : Issue with XE6 style compatibility

type
  TTMSFMXCalendar = class;
  TTMSFMXCalendarEvents = class;

  TTMSFMXCalendarDateEventKind = (ekTriangle, ekRectangle, ekDiamond, ekEllipse);

  TProtectedControl = class(TControl);

  TTMSFMXCalendarStartDay = (Sunday, Monday, Tuesday, Wednesday, Thursday, Friday, Saturday);

  TTMSFMXCalendarEvent = class(TCollectionItem)
  private
    FOwner: TTMSFMXCalendarEvents;
    FDate: TDate;
    FText: String;
    FKind: TTMSFMXCalendarDateEventKind;
    FColor: TAlphaColor;
    procedure SetDate(const Value: TDate);
    procedure SetText(const Value: String);
    procedure SetKind(const Value: TTMSFMXCalendarDateEventKind);
    procedure SetColor(const Value: TAlphaColor);
  public
    constructor Create(Collection: TCollection); override;
  published
    property Date: TDate read FDate write SetDate;
    property Text: String read FText write SetText;
    property Kind: TTMSFMXCalendarDateEventKind read FKind write SetKind default ekEllipse;
    property Color: TAlphaColor read FColor write SetColor default TAlphaColorRec.Lime;
  end;

  TTMSFMXCalendarEventsArray = array of TTMSFMXCalendarEvent;

  TTMSFMXCalendarEvents = class(TTMSFMXBaseCollection)
  private
    FOnCalendarEventChange: TNotifyEvent;
    function GetItem(Index: Integer): TTMSFMXCalendarEvent;
    procedure SetItem(Index: Integer; const Value: TTMSFMXCalendarEvent);
  public
    procedure UpdateCalendar;
    property Items[Index: Integer]: TTMSFMXCalendarEvent read GetItem write SetItem; default;
    function Add: TTMSFMXCalendarEvent;
    function Insert(Index: Integer): TTMSFMXCalendarEvent;
    procedure EndUpdate; override;
    property OnCalendarEventChange: TNotifyEvent read FOnCalendarEventChange write FOnCalendarEventChange;
  end;

  TDisjunctDateItem = class(TCollectionItem)
  private
    FDate: TDate;
  published
  property
    Date: TDate read FDate write FDate;
  end;

  TDisjunctDateArray = class(TTMSFMXBaseCollection)
  private
    FOnDisjunctArrayChange: TNotifyEvent;
    function GetItem(Index: Integer): TDisjunctDateItem;
    procedure SetItem(Index: Integer; const Value: TDisjunctDateItem);
  public
    property Items[Index: Integer]: TDisjunctDateItem read GetItem write SetItem; default;
    function Add: TDisjunctDateItem;
    function Insert(Index: Integer): TDisjunctDateItem;
    procedure EndUpdate; override;
    property OnDisjunctArrayChange: TNotifyEvent read FOnDisjunctArrayChange write FOnDisjunctArrayChange;
  end;

  TTMSFMXCalendarDateEventShape = class(TTMSFMXBaseShape)
  private
    FDate: TDate;
    FKind: TTMSFMXCalendarDateEventKind;
    FEvent: TTMSFMXCalendarEvent;
    procedure SetKind(const Value: TTMSFMXCalendarDateEventKind);
  public
    constructor Create(AOwner: TComponent); override;
    procedure Painting; override;
    property Date: TDate read FDate write FDate;
    property Event: TTMSFMXCalendarEvent read FEvent write FEvent;
  published
    property Kind: TTMSFMXCalendarDateEventKind read FKind write SetKind default ekEllipse;
    property Fill;
    property Stroke;
    property StrokeThickness;
    property StrokeCap;
    property StrokeDash;
    property StrokeJoin;
  end;

  TTMSFMXCalendarDateShape = class(TRectangle)
  private
    FDate: TDate;
    FCalendar: TTMSFMXCalendar;
  public
    property Calendar: TTMSFMXCalendar read FCalendar write FCalendar;
    procedure Paint; override;
    property Date: TDate read FDate write FDate;
  end;

  TTMSFMXCalendarCurrentDayLabelClick = procedure(Sender: TObject; ADate: TDate; var Allow: Boolean) of object;

  TTMSFMXCalendarDaySelect = procedure(Sender: TObject; ADate: TDate) of object;
  TTMSFMXCalendarMultiDaySelect = procedure(Sender: TObject; AStartDate, AEndDate: TDate) of object;
  TTMSFMXCalendarDisjunctDaySelect = procedure(Sender: TObject; ADates: TDisjunctDateArray) of object;

  TTMSFMXCalendarCustomizeDay = procedure(Sender: TObject; ADate: TDate; ADayObject: TTMSFMXCalendarDateShape) of object;

  TTMSFMXCalendarCustomizeWeekDay = procedure(Sender: TObject; AWeekDay: Integer; AWeekDayObject: TTMSFMXCalendarDateShape) of object;

  TTMSFMXCalendarCustomizeWeekNumber = procedure(Sender: TObject; AWeekNumber: Integer; AWeekNumberObject: TTMSFMXCalendarDateShape) of object;

  TTMSFMXCalendarCustomizeEvent = procedure(Sender: TObject; AEvent: TTMSFMXCalendarEvent; AEventObject: TTMSFMXCalendarDateEventShape) of object;

  TTMSFMXCalendarEventClick = procedure(Sender: TObject; AEvent: TTMSFMXCalendarEvent; AEventObject: TTMSFMXCalendarDateEventShape) of object;

  TTMSFMXCalendarEventShow = procedure(Sender: TObject; AEvent: TTMSFMXCalendarEvent; AEventObject: TTMSFMXCalendarDateEventShape; AEventPopup: TCalloutPanel; var Allow: Boolean) of object;

  TTMSFMXCalendarEventHide = procedure(Sender: TObject; AEvent: TTMSFMXCalendarEvent; AEventObject: TTMSFMXCalendarDateEventShape; AEventPopup: TCalloutPanel) of object;

  TTMSFMXCalendarHasEvent = procedure(Sender: TObject; ADate: TDate; var EventColor: TAlphaColor; var EventText: String; var HasEvent: Boolean) of object;

  TTMSFMXCalendarMonthChanged = procedure(Sender: TObject; APreviousMonth, AMonth: Integer) of object;

  TTMSFMXCalendarYearChanged = procedure(Sender: TObject; APreviousYear, AYear: Integer) of object;

  TTMSFMXCalendarNavigate = (cnNone, cnSingleDaySelect, cnAlways);

  TTMSFMXCalendarWeekNumbersPosition = (wnpLeft, wnpRight);

  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXCalendar = class(TTMSFMXBaseControl)
  private
    FFirst: Boolean;
    FMouseDown: Boolean;
    FMonths: TPopupBox;
    FYears: TPopupBox;
    BlockUpdate: Boolean;
    FShiftState: TShiftState;
    FUpdateCount: Integer;
    FDisjunctDays: TDisjunctDateArray;
    FDate: TDate;
    FStartDay: TTMSFMXCalendarStartDay;
    FShowDaysBefore: Boolean;
    FShowDaysAfter: Boolean;
    FShowCurrentDay: Boolean;
    FMaxDate: TDate;
    FMinDate: TDate;
    FShowWeekDays: Boolean;
    FShowCurrentDayFooter: Boolean;
    FOnCurrentDayLabelClick: TTMSFMXCalendarCurrentDayLabelClick;
    FOnCustomizeWeekDay: TTMSFMXCalendarCustomizeWeekDay;
    FOnCustomizeDay: TTMSFMXCalendarCustomizeDay;
    FOnDaySelect: TTMSFMXCalendarDaySelect;
    FMultiSelect: Boolean;
    FOnMultiDaySelect: TTMSFMXCalendarMultiDaySelect;
    FOnDisjunctDaySelect: TTMSFMXCalendarDisjunctDaySelect;
    FDisjunctSelect: Boolean;
    FSelectedDay: TDate;
    FNavigateOnDayBefore: TTMSFMXCalendarNavigate;
    FNavigateOnDayAfter: TTMSFMXCalendarNavigate;
    FShowWeekNumbers: Boolean;
    FOnCustomizeWeekNumber: TTMSFMXCalendarCustomizeWeekNumber;
    FWeekNumbersPosition: TTMSFMXCalendarWeekNumbersPosition;
    FWeekDaysHeight: Single;
    FWeekNumbersWidth: Single;
    FEvents: TTMSFMXCalendarEvents;
    FOnCustomizeEvent: TTMSFMXCalendarCustomizeEvent;
    FOnEventClick: TTMSFMXCalendarEventClick;
    FOnEventShow: TTMSFMXCalendarEventShow;
    FOnEventHide: TTMSFMXCalendarEventHide;
    FEventPopup: TCalloutPanel;
    FEventLabel: TTMSFMXHTMLText;
    FOnHasEvent: TTMSFMXCalendarHasEvent;
    FFocusedDay: TDate;
    FShowFocusedDay: Boolean;
    FOnInternalDropDown: TNotifyEvent;
    FOnYearChanged: TTMSFMXCalendarYearChanged;
    FOnMonthChanged: TTMSFMXCalendarMonthChanged;
    function GetVersion: String;
    function GetVersionNr: Integer;
    procedure SetVersion(const Value: String);
    procedure SetDate(const Value: TDate);
    procedure SetStartDay(const Value: TTMSFMXCalendarStartDay);
    procedure SetShowDaysAfter(const Value: Boolean);
    procedure SetShowDaysBefore(const Value: Boolean);
    procedure SetShowCurrentDay(const Value: Boolean);
    function DoStoreMaxDate: Boolean;
    function DoStoreMinDate: Boolean;
    procedure SetMaxDate(const Value: TDate);
    procedure SetMinDate(const Value: TDate);
    procedure SetShowWeekDays(const Value: Boolean);
    procedure SetShowCurrentDayFooter(const Value: Boolean);
    procedure SetMultiSelect(const Value: Boolean);
    procedure SetDisjunctSelect(const Value: Boolean);
    procedure SetSelectedDays(const Value: TDisjunctDateArray);
    procedure SetSelectedDay(const Value: TDate);
    procedure SetNavigateOnDayAfter(const Value: TTMSFMXCalendarNavigate);
    procedure SetNavigateOnDayBefore(const Value: TTMSFMXCalendarNavigate);
    procedure SetShowWeekNumbers(const Value: Boolean);
    procedure SetWeekNumbersPosition(
      const Value: TTMSFMXCalendarWeekNumbersPosition);
    procedure SetWeekDaysHeight(const Value: Single);
    procedure SetWeekNumbersWidth(const Value: Single);
    procedure SetEvents(const Value: TTMSFMXCalendarEvents);
    procedure SetShowFocusedDay(const Value: Boolean);
  protected
    procedure ApplyAdditionalStyle(AControl: TFMXObject); override;
    procedure DoMonthChange(Sender: TObject);
    procedure DoYearChange(Sender: TObject);
    procedure DisjunctArrayChange(Sender: TObject);
    procedure CalendarEventChange(Sender: TObject);
    procedure NextMonth(Sender: TObject);
    procedure PreviousMonth(Sender: TObject);
    procedure ApplyStyle; override;
    procedure AssignEvents;
    function GetInstance: NativeUInt; override;
    procedure UpdateCalendar;
    procedure Resize; override;
    procedure CurrentDayLabelClicked(Sender: TObject);
    procedure CalendarDateSelect(Sender: TObject);
    procedure CalendarDateEventEnter(Sender: TObject);
    procedure CalendarDateEventLeave(Sender: TObject);
    procedure CalendarDateEventClick(Sender: TObject);
    procedure CalendarDateMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure CalendarDateMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Single);
    procedure CalendarDateMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Single);
    procedure KeyDown(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
    procedure KeyUp(var Key: Word; var KeyChar: WideChar; Shift: TShiftState); override;
    procedure PrepareNavigation(ADate: TDate; Shift: TShiftState = []);
  public
    property MonthsPopup: TPopupBox read FMonths write FMonths;
    property YearsPopup: TPopupBox read FYears write FYears;
    procedure BeginUpdate; override;
    procedure EndUpdate; override;
    function RemoveDateIfSelect(Date: TDate): Boolean;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure SelectDate(ADate: TDate; AShift: TShiftState = []);
    function GetPreviousIndicator: TControl;
    function GetNextIndicator: TControl;
    function GetCalendarView: TRectangle;
    function GetCalendarHeader: TRectangle;
    function GetCalendarFooter: TRectangle;
    function GetCalendarArea: TRectangle;
    function GetDateNormal: TTMSFMXCalendarDateShape;
    function GetEventShape: TTMSFMXCalendarDateEventShape;
    function GetDateWeek: TTMSFMXCalendarDateShape;
    function GetDateWeekNumber: TTMSFMXCalendarDateShape;
    function GetDateBefore: TTMSFMXCalendarDateShape;
    function GetDateAfter: TTMSFMXCalendarDateShape;
    function GetDateSelected: TTMSFMXCalendarDateShape;
    function GetDateCurrent: TTMSFMXCalendarDateShape;
    function GetDateWeekend: TTMSFMXCalendarDateShape;
    function GetCurrentDayLabel: TText;
    function GetHeader: TControl;
    function DaysPerWeek: Integer;
    function GetCountRows(ADate: TDate): Integer;
    function GetDayOfWeekColumn(ADate: TDate): integer;
    function GetDate(ADate: TDate; day, dim: integer): TDate;
    function IsDisjunctDate(ADate: TDate): Boolean;
    function IsWeekendDay(ADate: TDate): Boolean;
    property SelectedDays: TDisjunctDateArray read FDisjunctDays write SetSelectedDays;
    property SelectedDay: TDate read FSelectedDay write SetSelectedDay;
    property FocusedDay: TDate read FFocusedDay;
    function GetEventsByDate(ADate: TDate): TTMSFMXCalendarEventsArray;
    property EventPopup: TCalloutPanel read FEventPopup write FEventPopup;
    property EventPopupLabel: TTMSFMXHTMLText read FEventLabel write FEventLabel;
    property OnInternalDropDown: TNotifyEvent read FOnInternalDropDown write FOnInternalDropDown;
  published
    property Version: String read GetVersion write SetVersion;
    property Date: TDate read FDate write SetDate;
    property NavigateOnDayBefore: TTMSFMXCalendarNavigate read FNavigateOnDayBefore write SetNavigateOnDayBefore default cnSingleDaySelect;
    property NavigateOnDayAfter: TTMSFMXCalendarNavigate read FNavigateOnDayAfter write SetNavigateOnDayAfter default cnSingleDaySelect;
    property StartDay: TTMSFMXCalendarStartDay read FStartDay write SetStartDay default Sunday;
    property ShowDaysBefore: Boolean read FShowDaysBefore write SetShowDaysBefore default False;
    property ShowDaysAfter: Boolean read FShowDaysAfter write SetShowDaysAfter default False;
    property ShowCurrentDay: Boolean read FShowCurrentDay write SetShowCurrentDay default True;
    property MaxDate: TDate read FMaxDate write SetMaxDate stored DoStoreMaxDate;
    property MinDate: TDate read FMinDate write SetMinDate stored DoStoreMinDate;
    property ShowWeekDays: Boolean read FShowWeekDays write SetShowWeekDays default True;
    property ShowCurrentDayFooter: Boolean read FShowCurrentDayFooter write SetShowCurrentDayFooter default True;
    property OnCurrentDayLabelClick: TTMSFMXCalendarCurrentDayLabelClick read FOnCurrentDayLabelClick write FOnCurrentDayLabelClick;
    property OnCustomizeDay: TTMSFMXCalendarCustomizeDay read FOnCustomizeDay write FOnCustomizeDay;
    property OnCustomizeWeekDay: TTMSFMXCalendarCustomizeWeekDay read FOnCustomizeWeekDay write FOnCustomizeWeekDay;
    property OnCustomizeWeekNumber: TTMSFMXCalendarCustomizeWeekNumber read FOnCustomizeWeekNumber write FOnCustomizeWeekNumber;
    property OnDaySelect: TTMSFMXCalendarDaySelect read FOnDaySelect write FOnDaySelect;
    property OnMultiDaySelect: TTMSFMXCalendarMultiDaySelect read FOnMultiDaySelect write FOnMultiDaySelect;
    property OnDisjunctDaySelect: TTMSFMXCalendarDisjunctDaySelect read FOnDisjunctDaySelect write FOnDisjunctDaySelect;
    property MultiSelect: Boolean read FMultiSelect write SetMultiSelect default False;
    property DisjunctSelect: Boolean read FDisjunctSelect write SetDisjunctSelect default False;
    property ShowWeekNumbers: Boolean read FShowWeekNumbers write SetShowWeekNumbers default False;
    property WeekNumbersPosition: TTMSFMXCalendarWeekNumbersPosition read FWeekNumbersPosition write SetWeekNumbersPosition default wnpRight;
    property WeekNumbersWidth: Single read FWeekNumbersWidth write SetWeekNumbersWidth;
    property WeekDaysHeight: Single read FWeekDaysHeight write SetWeekDaysHeight;
    property Events: TTMSFMXCalendarEvents read FEvents write SetEvents;
    property OnCustomizeEvent: TTMSFMXCalendarCustomizeEvent read FOnCustomizeEvent write FOnCustomizeEvent;
    property OnHasEvent: TTMSFMXCalendarHasEvent read FOnHasEvent write FOnHasEvent;
    property OnEventClick: TTMSFMXCalendarEventClick read FOnEventClick write FOnEventClick;
    property OnEventShow: TTMSFMXCalendarEventShow read FOnEventShow write FOnEventShow;
    property OnEventHide: TTMSFMXCalendarEventHide read FOnEventHide write FOnEventHide;
    property ShowFocusedDay: Boolean read FShowFocusedDay write SetShowFocusedDay default True;
    property OnMonthChanged: TTMSFMXCalendarMonthChanged read FOnMonthChanged write FOnMonthChanged;
    property OnYearChanged: TTMSFMXCalendarYearChanged read FOnYearChanged write FOnYearChanged;
  end;

  [ComponentPlatformsAttribute(TMSPlatforms)]
  TTMSFMXCalendarPicker = class(TTMSFMXEditBtn)
  private
    FOldDate: TDateTime;
    FCalendar: TTMSFMXCalendar;
    FMultiSelectDelimiter: String;
    FDisjunctSelectDelimiter: String;
    function GetDate: TDate;
    procedure SetDate(const Value: TDate);
  protected
    procedure CalendarDaySelect(Sender: TObject; ADate: TDate);
    procedure CalendarMultiDaySelect(Sender: TObject; AStartDate, AEndDate: TDate);
    procedure CalendarDisjunctDaySelect(Sender: TObject; ADates: TDisjunctDateArray);
    procedure CalendarDropDown(Sender: TObject);
    procedure CloseWithEscape(Sender: TObject);
  public
    procedure DropDown; override;
    constructor Create(AOwner: TComponent); override;
    property Date: TDate read GetDate write SetDate;
  published
    property Calendar: TTMSFMXCalendar read FCalendar write FCalendar;
    property MultiSelectDelimiter: String read FMultiSelectDelimiter write FMultiSelectDelimiter;
    property DisjunctSelectDelimiter: String read FDisjunctSelectDelimiter write FDisjunctSelectDelimiter;
  end;

implementation

{$R FMX.TMSCalendar.res}

procedure TTMSFMXCalendar.ApplyAdditionalStyle(AControl: TFMXObject);
var
  o: TFmxObject;
  t: TText;
begin
  inherited;
  o := AControl.FindStyleResource('currentdaylabel');
  if Assigned(o) then
  begin
    t := o as TText;
    {$IFDEF DELPHIXE6_LVL}
    t.TextSettings.FontColor := TAlphaColorRec.Black;
    t.TextSettings.Font.Style := [TFontStyle.fsBold];
    {$ELSE}
    t.Color := TAlphaColorRec.Black;
    t.Font.Style := [TFontStyle.fsBold];
    {$ENDIF}
  end;

  o := AControl.FindStyleResource('datenormal').FindStyleResource('datetext');
  if Assigned(o) then
  begin
    t := o as TText;
    {$IFDEF DELPHIXE6_LVL}
    t.TextSettings.FontColor := $FF212F3C;
    {$ELSE}
    t.Color := $FF212F3C;
    {$ENDIF}
  end;

  o := AControl.FindStyleResource('dateselected').FindStyleResource('datetext');
  if Assigned(o) then
  begin
    t := o as TText;
    {$IFDEF DELPHIXE6_LVL}
    t.TextSettings.FontColor := $FF212F3C;
    {$ELSE}
    t.Color := $FF212F3C;
    {$ENDIF}
  end;

  o := AControl.FindStyleResource('dateweekend').FindStyleResource('datetext');
  if Assigned(o) then
  begin
    t := o as TText;
    {$IFDEF DELPHIXE6_LVL}
    t.TextSettings.FontColor := $FF212F3C;
    {$ELSE}
    t.Color := $FF212F3C;
    {$ENDIF}
  end;

  o := AControl.FindStyleResource('datecurrent').FindStyleResource('datetext');
  if Assigned(o) then
  begin
    t := o as TText;
    {$IFDEF DELPHIXE6_LVL}
    t.TextSettings.FontColor := TAlphaColorRec.White;
    {$ELSE}
    t.Color := TAlphaColorRec.White;
    {$ENDIF}
  end;

  o := AControl.FindStyleResource('datebefore').FindStyleResource('datetext');
  if Assigned(o) then
  begin
    t := o as TText;
    {$IFDEF DELPHIXE6_LVL}
    t.TextSettings.FontColor := $FFA4A4A4;
    {$ELSE}
    t.Color := $FFA4A4A4;
    {$ENDIF}
  end;

  o := AControl.FindStyleResource('dateafter').FindStyleResource('datetext');
  if Assigned(o) then
  begin
    t := o as TText;
    {$IFDEF DELPHIXE6_LVL}
    t.TextSettings.FontColor := $FFA4A4A4;
    {$ELSE}
    t.Color := $FFA4A4A4;
    {$ENDIF}
  end;

  o := AControl.FindStyleResource('dateweek').FindStyleResource('datetext');
  if Assigned(o) then
  begin
    t := o as TText;
    {$IFDEF DELPHIXE6_LVL}
    t.TextSettings.FontColor := $FF212F3C;
    {$ELSE}
    t.Color := $FF212F3C;
    {$ENDIF}
  end;

  o := AControl.FindStyleResource('dateweeknumber').FindStyleResource('datetext');
  if Assigned(o) then
  begin
    t := o as TText;
    {$IFDEF DELPHIXE6_LVL}
    t.TextSettings.FontColor := $FF212F3C;
    {$ELSE}
    t.Color := $FF212F3C;
    {$ENDIF}
  end;

  o := AControl.FindStyleResource('dateeventtext');
  if Assigned(o) then
  begin
    t := o as TText;
    {$IFDEF DELPHIXE6_LVL}
    t.TextSettings.FontColor := $FF212F3C;
    {$ELSE}
    t.Color := $FF212F3C;
    {$ENDIF}
  end;
end;

procedure TTMSFMXCalendar.ApplyStyle;
begin
  inherited;
  AssignEvents;
  UpdateCalendar;
end;

procedure TTMSFMXCalendar.AssignEvents;
var
  lbl: TText;
  cnext, cprev: TControl;
  i: Integer;
  sc: TFmxObject;
begin
  lbl := GetCurrentDayLabel;
  if Assigned(lbl) then
    lbl.OnClick := CurrentDayLabelClicked;

  //FMonths
  sc := FindStyleResource('months');
  FMonths := nil;
  if Assigned(sc) and (sc is TPopupBox) then
  begin
    FMonths := TPopupBox(sc);
    FMonths.CanParentFocus := True;
    for i := 1 to 12 do
      FMonths.Items.Add(FormatSettings.LongMonthNames[i]);
    FMonths.ItemIndex := MonthOf(Date) - 1;
    FMonths.OnChange := DoMonthChange;
  end;
  //FYears
  sc := FindStyleResource('years');
  FYears := nil;
  if Assigned(sc) and (sc is TPopupBox) then
  begin
    FYears := TPopupBox(sc);
    FYears.CanParentFocus := True;
    for i := 5 downto 1 do
      FYears.Items.Add(IntToStr(YearOf(Date) - i));
    FYears.Items.Add(IntToStr(YearOf(Date)));
    for i := 1 to 5 do
      FYears.Items.Add(IntToStr(YearOf(Date) + i));
    FYears.ItemIndex := 5;
    FYears.OnChange := DoYearChange;
  end;

  cnext := GetNextIndicator;
  cprev := GetPreviousIndicator;

  if Assigned(cnext) then
    cnext.OnClick := NextMonth;

  if Assigned(cprev) then
    cprev.OnClick := PreviousMonth;
end;

procedure TTMSFMXCalendar.BeginUpdate;
begin
  inherited;
  Inc(FUpdateCount);
end;

procedure TTMSFMXCalendar.CalendarDateEventClick(Sender: TObject);
var
  evntshp: TTMSFMXCalendarDateEventShape;
begin
  if Sender is TTMSFMXCalendarDateEventShape then
  begin
    evntshp := (Sender as TTMSFMXCalendarDateEventShape);
    if Assigned(evntshp) then
    begin
      if Assigned(OnEventClick) then
        OnEventClick(Self, evntshp.Event, evntshp);
    end;
  end;
end;

procedure TTMSFMXCalendar.CalendarDateEventEnter(Sender: TObject);
var
  evntshp: TTMSFMXCalendarDateEventShape;
  AllowShow: Boolean;
  v: TControl;
begin
  v := GetCalendarView;
  if Assigned(v) then
  begin
    if Sender is TTMSFMXCalendarDateEventShape then
    begin
      evntshp := (Sender as TTMSFMXCalendarDateEventShape);
      if Assigned(evntshp) then
      begin
        AllowShow := True;

        EventPopupLabel.AutoSize := False;
        {$IFDEF DELPHIXE6_LVL}
        EventPopupLabel.Align := TAlignLayout.None;
        {$ELSE}
        EventPopupLabel.Align := TAlignLayout.alNone;
        {$ENDIF}
        EventPopupLabel.Text := evntshp.event.Text;
        EventPopupLabel.Width := 100;
        EventPopupLabel.Height := 40;
        EventPopupLabel.AutoSize := True;
        EventPopup.Width := Max(20, EventPopupLabel.Width + 10);
        EventPopup.Height := Max(20, EventPopupLabel.Height + EventPopup.CalloutLength);
        EventPopupLabel.AutoSize := False;
        EVentPopupLabel.Width := EventPopup.Width;
        EventPopupLabel.Height := EventPopup.Height - EventPopup.CalloutLength;
        EventPopup.SetBounds((evntshp.Parent as TControl).Position.X + v.Position.X + evntshp.Position.X + evntshp.Width / 2 - EventPopup.Width / 2, (evntshp.Parent as TControl).Position.Y  + evntshp.Position.Y - EventPopup.Height / 2, EventPopup.Width, EventPopup.Height);
        EventPopup.Parent := Self;

        if Assigned(OnEventShow) then
          OnEventShow(Self, evntshp.Event, evntshp, EventPopup, AllowShow);

        if AllowShow then
          EventPopup.Visible := True;
      end;
    end;
  end;
end;

procedure TTMSFMXCalendar.CalendarDateEventLeave(Sender: TObject);
var
  evntshp: TTMSFMXCalendarDateEventShape;
begin
  if Sender is TTMSFMXCalendarDateEventShape then
  begin
    evntshp := (Sender as TTMSFMXCalendarDateEventShape);
    if Assigned(evntshp) then
    begin
      if EventPopup.Visible then
      begin
        EventPopup.Visible := False;
        if Assigned(OnEventHide) then
          OnEventHide(Self, evntshp.Event, evntshp, EventPopup);
      end;
    end;
  end;
end;

procedure TTMSFMXCalendar.CalendarDateMouseDown(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Single);
begin
  SetFocus;
  FMouseDown := True;
  FFirst := True;
end;

procedure TTMSFMXCalendar.CalendarDateMouseMove(Sender: TObject;
  Shift: TShiftState; X, Y: Single);
var
  dt: TDate;
  v: TRectangle;
begin
  if not (ssLeft in Shift) then
    FMouseDown := False;

  if FMouseDown then
  begin
    if Sender is TTMSFMXCalendarDateShape then
    begin
      if FFirst then
      begin
        v := GetCalendarView;
        if Assigned(v) then
        begin
          v.RemoveObject(Sender as TTMSFMXCalendarDateShape);
          dt := (Sender as TTMSFMXCalendarDateShape).Date;
          SelectDate(dt, FShiftState);
        end;
        FFirst := False;
      end;

      if MultiSelect then
        SelectDate((Sender as TTMSFMXCalendarDateShape).Date, [ssShift])
      else
        SelectDate((Sender as TTMSFMXCalendarDateShape).Date);
    end;
  end;
end;

procedure TTMSFMXCalendar.CalendarDateMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Single);
var
  dt: TDate;
  v: TRectangle;
begin
  FMouseDown := False;
  ReleaseCapture;
  if FFirst then
  begin
    v := GetCalendarView;
    if Assigned(v) then
    begin
      v.RemoveObject(Sender as TTMSFMXCalendarDateShape);
      dt := (Sender as TTMSFMXCalendarDateShape).Date;
      SelectDate(dt, FShiftState);
    end;
    FFirst := False;
  end;
end;

procedure TTMSFMXCalendar.CalendarDateSelect(Sender: TObject);
var
  dt: TDate;
  v: TRectangle;
begin
  Exit;
  if Sender is TTMSFMXCalendarDateShape then
  begin
    v := GetCalendarView;
    if Assigned(v) then
    begin
      v.RemoveObject(Sender as TTMSFMXCalendarDateShape);
      dt := (Sender as TTMSFMXCalendarDateShape).Date;
      SelectDate(dt, FShiftState);
    end;
  end;
end;

procedure TTMSFMXCalendar.CalendarEventChange(Sender: TObject);
begin
  UpdateCalendar;
end;

constructor TTMSFMXCalendar.Create(AOwner: TComponent);
begin
  inherited;
  CanFocus := True;
  FDate := Now;
  FSelectedDay := -1;
  FFocusedDay := -1;
  FWeekNumbersPosition := wnpRight;
  FWeekDaysHeight := 20;
  FWeekNumbersWidth := 20;
  FStartDay := Sunday;
  FShowWeekDays := True;
  FShowWeekNumbers := False;
  FNavigateOnDayBefore := cnSingleDaySelect;
  FNavigateOnDayAfter := cnSingleDaySelect;
  FShowDaysBefore := False;
  FShowDaysAfter := False;
  FShowCurrentDay := True;
  FShowCurrentDayFooter := True;
  FDisjunctSelect := False;
  FMultiSelect := False;
  FShowFocusedDay := True;
  FMaxDate := 0;
  FMinDate := 0;

  FEventPopup := TCalloutPanel.Create(Self);
  {$IFDEF DELPHIXE6_LVL}
  FEventPopup.CalloutPosition := TCalloutPosition.Bottom;
  {$ELSE}
  FEventPopup.CalloutPosition := TCalloutPosition.cpBottom;
  {$ENDIf}
  FEventPopup.Visible := False;
  FEventLabel := TTMSFMXHTMLText.Create(FEventPopup);
  FEventLabel.Margins.Left := 3;
  FEventLabel.Margins.Top := 3;
  FEventLabel.Margins.Bottom := 3;
  FEventLabel.Margins.Right := 3;
  {$IFDEF DELPHIXE6_LVL}
  FEventLabel.HorzTextAlign := TTextAlign.Center;
  FEventLabel.VertTextAlign := TTextAlign.Center;
  {$ELSE}
  FEventLabel.HorzTextAlign := TTextAlign.taCenter;
  FEventLabel.VertTextAlign := TTextAlign.taCenter;
  {$ENDIF}
  FEventPopup.AddObject(FEventLabel);

  FEvents := TTMSFMXCalendarEvents.Create(TTMSFMXCalendarEvent);
  FEvents.OnCalendarEventChange := CalendarEventChange;

  FDisjunctDays := TDisjunctDateArray.Create(TDisjunctDateItem);
  FDisjunctDays.OnDisjunctArrayChange := DisjunctArrayChange;

  BlockUpdate := True;
  Width := 200;
  Height := 180;
  BlockUpdate := False;
end;

procedure TTMSFMXCalendar.CurrentDayLabelClicked(Sender: TObject);
var
  Allow: Boolean;
begin
  Allow := True;
  if Assigned(OnCurrentDayLabelClick) then
    OnCurrentDayLabelClick(Self, Date, Allow);

  if Allow then
    Date := Now;
end;

function TTMSFMXCalendar.DaysPerWeek: Integer;
begin
  Result := 7;
end;

destructor TTMSFMXCalendar.Destroy;
begin
  FEventLabel.Free;
  FEventPopup.Free;
  FDisjunctDays.Free;
  FEvents.Free;
  inherited;
end;

procedure TTMSFMXCalendar.DisjunctArrayChange(Sender: TObject);
begin
  UpdateCalendar;
end;


procedure TTMSFMXCalendar.DoMonthChange(Sender: TObject);
var
  AYear, AMonth, ADay: Word;
begin
  if Assigned(FMonths) then
  begin
    DecodeDate(Date, AYear, AMonth, ADay);
    Date := EncodeDate(AYear, FMonths.ItemIndex + 1, ADay);
  end;
end;

function TTMSFMXCalendar.DoStoreMaxDate: Boolean;
begin
  Result := FMaxDate <> 0.0;
end;

function TTMSFMXCalendar.DoStoreMinDate: Boolean;
begin
  Result := FMinDate <> 0.0;
end;

procedure TTMSFMXCalendar.DoYearChange(Sender: TObject);
var
  AYear, AMonth, ADay: Word;
begin
  DecodeDate(Date, AYear, AMonth, ADay);
  Date := EncodeDate(StrToInt(FYears.Text), AMonth, ADay);
end;

procedure TTMSFMXCalendar.EndUpdate;
begin
  inherited;
  Dec(FUpdateCount);
  if FUpdateCount = 0 then
    UpdateCalendar;
end;

function TTMSFMXCalendar.GetCalendarArea: TRectangle;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('calendararea');
  if Assigned(obj) and (obj is TRectangle) then
    Result := obj as TRectangle;
end;

function TTMSFMXCalendar.GetCalendarFooter: TRectangle;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('calendarfooter');
  if Assigned(obj) and (obj is TRectangle) then
    Result := obj as TRectangle;
end;

function TTMSFMXCalendar.GetCalendarHeader: TRectangle;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('calendarheader');
  if Assigned(obj) and (obj is TRectangle) then
    Result := obj as TRectangle;
end;

function TTMSFMXCalendar.GetCalendarView: TRectangle;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('calendarview');
  if Assigned(obj) and (obj is TRectangle) then
    Result := obj as TRectangle;
end;

function TTMSFMXCalendar.GetCountRows(ADate: TDate): Integer;
var
  dim, wd, i: integer;
  dt: TDate;
  wdtotalfirst, wdtotallast: integer;
  y, m, d: Word;
begin
  result := 0;
  dim := DaysInMonth(ADate);
  DecodeDate(ADate, y, m, d);
  wdtotalfirst := GetDayOfWeekColumn(EncodeDate(y, m, 1));
  wdtotallast := GetDayOfWeekColumn(EncodeDate(y, m, dim));
  for I := 2-wdtotalfirst to dim + 7 - wdtotallast do
  begin
    dt := GetDate(ADate, i, dim);
    wd := GetDayOfWeekColumn(dt);
    if (wd = 7) then
      Inc(result);
  end;
end;

function TTMSFMXCalendar.GetCurrentDayLabel: TText;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('currentdaylabel');
  if Assigned(obj) and (obj is TText) then
    Result := obj as TText;
end;

function TTMSFMXCalendar.GetDate(ADate: TDate; day, dim: integer): TDate;
var
  y, m, d: Word;
begin
  DecodeDate(ADate, y, m, d);

  if (day <= dim) and (day >= 1) then
    result := EncodeDate(y, m, day)
  else if day > dim then
  begin
    if m = 12 then
      result := EncodeDate(y + 1, 1, day - DaysInMonth(EncodeDate(y + 1, 1, 1)))
    else
      result := EncodeDate(y, m + 1, day - dim)
  end
  else
  begin
    if m = 1 then
      result := EncodeDate(y - 1, 12, DaysInMonth(EncodeDate(y - 1, 12, 1)) + day)
    else
      result := EncodeDate(y, m - 1, DaysInMonth(EncodeDate(y, m - 1, 1)) + day);
  end;
end;

function TTMSFMXCalendar.GetDateAfter: TTMSFMXCalendarDateShape;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('dateafter');
  if Assigned(obj) and (obj is TTMSFMXCalendarDateShape) then
    Result := obj as TTMSFMXCalendarDateShape;
end;

function TTMSFMXCalendar.GetDateBefore: TTMSFMXCalendarDateShape;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('datebefore');
  if Assigned(obj) and (obj is TTMSFMXCalendarDateShape) then
    Result := obj as TTMSFMXCalendarDateShape;
end;

function TTMSFMXCalendar.GetDateCurrent: TTMSFMXCalendarDateShape;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('datecurrent');
  if Assigned(obj) and (obj is TTMSFMXCalendarDateShape) then
    Result := obj as TTMSFMXCalendarDateShape;
end;

function TTMSFMXCalendar.GetDateNormal: TTMSFMXCalendarDateShape;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('datenormal');
  if Assigned(obj) and (obj is TTMSFMXCalendarDateShape) then
    Result := obj as TTMSFMXCalendarDateShape;
end;

function TTMSFMXCalendar.GetDateSelected: TTMSFMXCalendarDateShape;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('dateselected');
  if Assigned(obj) and (obj is TTMSFMXCalendarDateShape) then
    Result := obj as TTMSFMXCalendarDateShape;
end;

function TTMSFMXCalendar.GetDateWeek: TTMSFMXCalendarDateShape;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('dateweek');
  if Assigned(obj) and (obj is TTMSFMXCalendarDateShape) then
    Result := obj as TTMSFMXCalendarDateShape;
end;

function TTMSFMXCalendar.GetDateWeekend: TTMSFMXCalendarDateShape;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('dateweekend');
  if Assigned(obj) and (obj is TTMSFMXCalendarDateShape) then
    Result := obj as TTMSFMXCalendarDateShape;
end;

function TTMSFMXCalendar.GetDateWeekNumber: TTMSFMXCalendarDateShape;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('dateweeknumber');
  if Assigned(obj) and (obj is TTMSFMXCalendarDateShape) then
    Result := obj as TTMSFMXCalendarDateShape;
end;

function TTMSFMXCalendar.GetDayOfWeekColumn(ADate: TDate): integer;
var
  dow: integer;
begin
  dow := DayOfWeek(ADate) - Integer(StartDay);
  if dow > 0 then
    Result := dow
  else
    Result := dow + 7;
end;

function TTMSFMXCalendar.GetEventsByDate(
  ADate: TDate): TTMSFMXCalendarEventsArray;
var
  I: Integer;
begin
  for I := 0 to Events.Count - 1 do
  begin
    if CompareDate(ADate, Events[I].Date) = EqualsValue then
    begin
      SetLength(Result, Length(Result) + 1);
      Result[Length(Result) - 1] := Events[I];
    end;
  end;
end;

function TTMSFMXCalendar.GetEventShape: TTMSFMXCalendarDateEventShape;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('dateevent');
  if Assigned(obj) and (obj is TTMSFMXCalendarDateEventShape) then
    Result := obj as TTMSFMXCalendarDateEventShape;
end;

function TTMSFMXCalendar.GetHeader: TControl;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('calendarheader');
  if Assigned(obj) and (obj is TControl) then
    Result := obj as TControl;
end;

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

function TTMSFMXCalendar.GetNextIndicator: TControl;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('nextmonth');
  if Assigned(obj) and (obj is TControl) then
    Result := obj as TControl;
end;

function TTMSFMXCalendar.GetPreviousIndicator: TControl;
var
  obj: TFmxObject;
begin
  Result := nil;
  obj := FindStyleResource('previousmonth');
  if Assigned(obj) and (obj is TControl) then
    Result := obj as TControl;
end;

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

function TTMSFMXCalendar.IsDisjunctDate(ADate: TDate): Boolean;
var
  I: Integer;
begin
  Result := False;
  if (FDisjunctDays.Count > 0) then
  begin
    Result := False;
    for I := 0 to FDisjunctDays.Count - 1 do
    begin
      if CompareDate(ADate, FDisjunctDays[i].Date) = 0 then
      begin
        Result := True;
        break;
      end;
    end;
  end;
end;

function TTMSFMXCalendar.IsWeekendDay(ADate: TDate): Boolean;
begin
  Result := (DayOfWeek(ADate) = 1) or (DayOfWeek(ADate) = 7);
end;

procedure TTMSFMXCalendar.KeyDown(var Key: Word; var KeyChar: WideChar;
  Shift: TShiftState);
var
  d: TDate;
begin
  inherited;
  SetFocus;

  if Key = vkF4 then
  begin
    if Assigned(OnInternalDropDown) then
      OnInternalDropDown(Self);
    Exit;
  end;

  FShiftState := Shift;

  case key of
    vkUp, vkDown, vkRight, vkLeft, vkHome,vkEnd, vkNext, vkPrior, vkSpace:
    begin
     if SelectedDay = -1 then
       SelectedDay := Now;

      d := FocusedDay;

      case Key of
        vkPrior: d := IncMonth(d, -1);
        vkNext: d := IncMonth(d, 1);
        vkUp: d := IncWeek(d, -1);
        vkDown: d := IncWeek(d, 1);
        vkRight: d := IncDay(d, 1);
        vkLeft: d := IncDay(d, -1);
        vkHome:
        begin
          if ssCtrl in Shift then
            d := EncodeDate(YearOf(d), 1, 1)
          else
            d := EncodeDate(YearOf(d), MonthOf(d), 1)
        end;
        vkEnd:
        begin
          if ssCtrl in Shift then
            d := EncodeDate(YearOf(d), 12, 31)
          else
            d := EncodeDate(YearOf(d), MonthOf(d), DaysInMonth(d))
        end;
      end;

      if MultiSelect and DisjunctSelect and (ssCtrl in Shift) then
      begin
        if Key = vkSpace then
        begin
          SelectDate(d, FShiftState);
          FFocusedDay := d;
        end
        else
        begin
          FFocusedDay := d;
          UpdateCalendar;
        end;
      end
      else
      begin
        SelectDate(d, FShiftState);
        FFocusedDay := d;
      end;
    end;
  end;
end;

procedure TTMSFMXCalendar.KeyUp(var Key: Word; var KeyChar: WideChar;
  Shift: TShiftState);
begin
  inherited;
  FShiftState := [];
end;

procedure TTMSFMXCalendar.NextMonth(Sender: TObject);
begin
  Date := IncMonth(Date, 1);
end;

procedure TTMSFMXCalendar.PrepareNavigation(ADate: TDate; Shift: TShiftState);
begin
  if MonthOf(ADate) < MonthOf(Date) then
  begin
    case NavigateOnDayBefore of
      cnSingleDaySelect: if Shift = [] then Date := ADate;
      cnAlways: Date := ADate;
    end;
  end
  else if MonthOf(ADate) > MonthOf(Date) then
  begin
    case NavigateOnDayAfter of
      cnSingleDaySelect: if Shift = [] then Date := ADate;
      cnAlways: Date := ADate;
    end;
  end;
end;

procedure TTMSFMXCalendar.PreviousMonth(Sender: TObject);
begin
  Date := IncMonth(Date, -1);
end;

function TTMSFMXCalendar.RemoveDateIfSelect(Date: TDate): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to FDisjunctDays.Count - 1 do
  begin
    if CompareDate(Date, FDisjunctDays[i].Date) = 0 then
    begin
      FDisjunctDays.Delete(i);
      Result := False;
      Break;
    end;
  end;
end;

procedure TTMSFMXCalendar.Resize;
begin
  inherited;
  if not BlockUpdate then
  begin
    NeedStyleLookup;
    Repaint;
  end;
end;

procedure TTMSFMXCalendar.SelectDate(ADate: TDate; AShift: TShiftState = []);
var
  select: Boolean;
  d, startd, endd: TDate;
  mind, maxd: TDate;
begin
  mind := MinDate;
  maxd := MaxDate;

  if MinDate = 0 then
    mind := ADate;

  if MaxDate = 0 then
    maxd := ADate;

  select := (ADate >= mind) and (ADate <= maxd);

  if (ADate <> - 1) and select then
  begin
    if (ssShift in AShift) and MultiSelect then
    begin
      BeginUpdate;
      PrepareNavigation(ADate, AShift);
      FDisjunctDays.Clear;
      if CompareDate(SelectedDay, ADate) = LessThanValue then
      begin
        startd := SelectedDay;
        endd := ADate;
      end
      else
      begin
        endd := SelectedDay;
        startd := ADate;
      end;

      d := startd;
      while CompareDate(d, IncDay(endd, 1)) = LessThanValue do
      begin
        FDisjunctDays.Add.Date := d;
        d := IncDay(d, 1);
      end;

      EndUpdate;
      if Assigned(OnMultiDaySelect) then
        OnMultiDaySelect(Self, startd, endd);
    end
    else if (ssCtrl in AShift) and MultiSelect and DisjunctSelect then
    begin
      BeginUpdate;
      PrepareNavigation(ADate, AShift);

      if not IsDisjunctDate(SelectedDay) then
        FDisjunctDays.Add.Date := SelectedDay;

      if RemoveDateIfSelect(ADate) then
        FDisjunctDays.Add.Date := ADate;

      EndUpdate;
      if Assigned(OnDisjunctDaySelect) then
        OnDisjunctDaySelect(Self, FDisjunctDays);
    end
    else
    begin
      BeginUpdate;
      PrepareNavigation(ADate);
      FDisjunctDays.Clear;
      SelectedDay := ADate;
      EndUpdate;
      if Assigned(OnDaySelect) then
        OnDaySelect(Self, ADate);
    end;
  end;
end;

procedure TTMSFMXCalendar.SetDate(const Value: TDate);
var
  i: integer;
  m, mp, y, yp: Integer;
begin
  if FDate <> Value then
  begin

    mp := MonthOf(FDate);
    yp := YearOf(FDate);
    FDate := Value;
    m := MonthOf(FDate);
    y := YearOf(FDate);

    if Assigned(OnMonthChanged) and (mp <> m) then
      OnMonthChanged(Self, mp, m);

    if Assigned(OnYearChanged) and (yp <> y) then
      OnYearChanged(Self, yp, y);

    UpdateCalendar;

    if Assigned(FMonths) then
      FMonths.ItemIndex := MonthOf(Date) - 1;

    if Assigned(FYears) then
    begin
      FYears.BeginUpdate;
      FYears.Items.Clear;
      for i := 5 downto 1 do
        FYears.Items.Add(IntToStr(YearOf(Date) - i));
      FYears.Items.Add(IntToStr(YearOf(Date)));
      for i := 1 to 5 do
        FYears.Items.Add(IntToStr(YearOf(Date) + i));
      FYears.Text := IntToStr(YearOf(Date));

      FYears.ItemIndex := 5;
      FYears.EndUpdate;
    end;
  end;
end;

procedure TTMSFMXCalendar.SetDisjunctSelect(const Value: Boolean);
begin
  if FDisjunctSelect <> Value then
    FDisjunctSelect := Value;
end;

procedure TTMSFMXCalendar.SetEvents(const Value: TTMSFMXCalendarEvents);
begin
  if FEvents <> Value then
  begin
    FEvents.Assign(Value);
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetMaxDate(const Value: TDate);
begin
  if FMaxDate <> value then
  begin
    FMaxDate := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetMinDate(const Value: TDate);
begin
  if FMinDate <> value then
  begin
    FMinDate := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetMultiSelect(const Value: Boolean);
begin
  FMultiSelect := Value;
end;

procedure TTMSFMXCalendar.SetNavigateOnDayAfter(
  const Value: TTMSFMXCalendarNavigate);
begin
  FNavigateOnDayAfter := Value;
end;

procedure TTMSFMXCalendar.SetNavigateOnDayBefore(
  const Value: TTMSFMXCalendarNavigate);
begin
  FNavigateOnDayBefore := Value;
end;

procedure TTMSFMXCalendar.SetSelectedDay(const Value: TDate);
begin
  if FSelectedDay <> Value then
  begin
    FSelectedDay := Value;
    FFocusedDay := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetSelectedDays(const Value: TDisjunctDateArray);
begin
  FDisjunctDays.Assign(Value);
end;

procedure TTMSFMXCalendar.SetShowCurrentDay(const Value: Boolean);
begin
  if FShowCurrentDay <> Value then
  begin
    FShowCurrentDay := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetShowCurrentDayFooter(const Value: Boolean);
var
  lbl: TText;
begin
  if FShowCurrentDayFooter <> Value then
  begin
    FShowCurrentDayFooter := Value;
    lbl := GetCurrentDayLabel;
    if Assigned(lbl) then
      lbl.Visible := ShowCurrentDayFooter;
  end;
end;

procedure TTMSFMXCalendar.SetShowDaysAfter(const Value: Boolean);
begin
  if FShowDaysAfter <> Value then
  begin
    FShowDaysAfter := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetShowDaysBefore(const Value: Boolean);
begin
  if FShowDaysBefore <> Value then
  begin
    FShowDaysBefore := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetShowFocusedDay(const Value: Boolean);
begin
  if FShowFocusedDay <> Value then
  begin
    FShowFocusedDay := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetShowWeekDays(const Value: Boolean);
begin
  if FShowWeekDays <> Value then
  begin
    FShowWeekDays := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetShowWeekNumbers(const Value: Boolean);
begin
  if FShowWeekNumbers <> Value then
  begin
    FShowWeekNumbers := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetStartDay(const Value: TTMSFMXCalendarStartDay);
begin
  if FStartDay <> Value then
  begin
    FStartDay := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetVersion(const Value: String);
begin

end;

procedure TTMSFMXCalendar.SetWeekDaysHeight(const Value: Single);
begin
  if FWeekDaysHeight <> Value then
  begin
    FWeekDaysHeight := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetWeekNumbersPosition(
  const Value: TTMSFMXCalendarWeekNumbersPosition);
begin
  if FWeekNumbersPosition <> Value then
  begin
    FWeekNumbersPosition := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.SetWeekNumbersWidth(const Value: Single);
begin
  if FWeekNumbersWidth <> Value then
  begin
    FWeekNumbersWidth := Value;
    UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendar.UpdateCalendar;
var
  a, v: TRectangle;
  r: TRectF;
  dt: TDate;
  I: Integer;
  m, d, y: Word;
  dim: Integer;
  k: Integer;
  cdt, cd: TDate;
  cw, ch, chw: Single;
  rows: Integer;
  yoff, xoff: Single;
  wdtotalfirst, wdtotallast: Integer;
  start, stop: Integer;
  wd: Single;
  rd: TRectF;
  drawcurrent, drawselected: Boolean;
  day: String;
  mind: TDate;
  maxd: TDate;
  robj, rdcur, rdsel, rdnor, rdbef, rdaft, rdwe, rdweek, rdwenum: TTMSFMXCalendarDateShape;
  txtobj: TFMXObject;
  txtd: TText;
  rw: TRectF;
  dweek: TDate;
  dwr, wrn: TRectF;
  weekday: String;
  dpw: Integer;
  dow: Integer;
  wwd: Single;
  lblcur: TText;
  chwk: Single;
  sw: String;
  rEventsArr: TTMSFMXCalendarEventsArray;
  J: Integer;
  evnt, evnthas: TTMSFMXCalendarEvent;
  revent, revnt: TTMSFMXCalendarDateEventShape;
  hasevent: Boolean;
  eventtxt: String;
  evntc: TAlphaColor;
  strText: string;
begin
  if BlockUpdate or (FUpdateCount > 0) or (csDestroying in ComponentState) then
    Exit;

  BlockUpdate := True;

  lblcur := GetCurrentDayLabel;
  if Assigned(lblcur) then
  begin
    lblcur.Visible := ShowCurrentDayFooter;
    lblcur.Text := DateToStr(Now);
  end;

  a := GetCalendarArea;
  v := GetCalendarView;
  rdcur := GetDateCurrent;
  rdsel := GetDateSelected;
  rdnor := GetDateNormal;
  rdbef := GetDateBefore;
  rdaft := GetDateAfter;
  rdwe := GetDateWeekend;
  rdweek := GetDateWeek;
  rdwenum := GetDateWeekNumber;
  revent := GetEventShape;
  if Assigned(a) and Assigned(v) and Assigned(rdcur) and Assigned(rdsel) And Assigned(rdnor)
    and Assigned(rdbef) and Assigned(rdaft) and Assigned(rdwe) and Assigned(rdweek) and Assigned(rdwenum) and Assigned(revent) then
  begin
    v.Width := a.Width * 3;
    v.Position.X := -a.Width;
    v.Position.Y := 0;
    v.Height := a.Height;
    dt := Date;

    for I := v.ChildrenCount - 1 downto 0 do
    begin
      strText := v.Children[I].StyleName;
      if Pos('tmsfmxcalendardaterect', strText) > 0 then
      begin
        {$IFDEF DELPHI_LLVM}
        v.RemoveObject(v.Children[I]);
        {$ELSE}
        v.Children[I].Free;
        {$ENDIF}
      end;
    end;

    I := 0;
//    for I := -1 to 1 do
    begin

      cdt := IncMonth(dt, I);
      DecodeDate(cdt, y, m, d);
      chw := 0;
      if ShowWeekDays then
      begin
        chw := WeekDaysHeight;
        dpw := DaysPerWeek;
        rw := RectF((I + 1) * a.Width + 1 , 0, (I + 2) * a.Width - 1, chw);
        if ShowWeekNumbers then
        begin
          case WeekNumbersPosition of
            wnpLeft: rw.Left := rw.Left + WeekNumbersWidth;
            wnpRight: rw.Right := rw.Right - WeekNumbersWidth;
          end;
        end;

        wwd := rw.Width / dpw;

        for K := 1 to dpw do
        begin
          dow := GetDayOfWeekColumn(EncodeDate(y, m, K));
          weekday := FormatSettings.ShortDayNames[DayOfWeek(EncodeDate(y, m, k))];
          dwr := RectF(((dow - 1) * wwd) + rw.Left, rw.Top, (dow * wwd) + rw.Left, rw.Top + chw);
          robj := rdweek.Clone(v) as TTMSFMXCalendarDateShape;
          CloneChildrenBase(rdweek, robj);

          robj.StyleName := 'tmsfmxcalendardaterect'+weekday;

          txtobj := robj.FindStyleResource('datetext');
          if Assigned(txtobj) then
          begin
            if txtobj is TText then
            begin
              txtd := txtobj as TText;
              txtd.Text := weekday;
            end;
          end;

          robj.SetBounds(dwr.Left, dwr.Top, dwr.Width, dwr.Height);
          v.AddObject(robj);
          robj.Visible := True;

          if Assigned(OnCustomizeWeekDay) then
            OnCustomizeWeekDay(Self, dow, robj);
        end;
      end;

      dim := DaysInMonth(cdt);

      rows := 1;
      wdtotalfirst := GetDayOfWeekColumn(EncodeDate(y, m, 1));
      wdtotallast := GetDayOfWeekColumn(EncodeDate(y, m, dim));
      if ShowDaysBefore then
        start := 2-wdtotalfirst
      else
        start := 1;

      if ShowDaysAfter then
        stop := dim + 7 - wdtotallast
      else
        stop := dim;

      chwk := 0;
      r := RectF((I + 1) * a.Width + 1, chw, (I + 2) * a.Width - 1, v.Height);
      ch := r.Height / GetCountRows(cdt);

      if ShowWeekNumbers then
      begin
        dweek := GetDate(cdt, start + 3, dim);
        chwk := WeekNumbersWidth;
        K := 1;
        while dweek <= EncodeDate(y, m, dim) + 7 do
        begin
          case WeekNumbersPosition of
            wnpLeft: wrn.Left := r.Left;
            wnpRight: wrn.Left := r.Right - chwk;
          end;

          wrn.Width := chwk;
          wrn.Top := chw + ((K - 1) * ch);
          wrn.Height := ch;

          robj := rdwenum.Clone(v) as TTMSFMXCalendarDateShape;
          CloneChildrenBase(rdwenum, robj);

          sw := IntToStr(WeekOfTheYear(dweek));
          robj.StyleName := 'tmsfmxcalendardaterectweeknum'+sw;

          txtobj := robj.FindStyleResource('datetext');
          if Assigned(txtobj) then
          begin
            if txtobj is TText then
            begin
              txtd := txtobj as TText;
              txtd.Text := sw;
            end;
          end;

          robj.SetBounds(wrn.Left, wrn.Top, wrn.Width, wrn.Height);
          v.AddObject(robj);
          robj.Visible := True;

          if Assigned(OnCustomizeWeekNumber) then
            OnCustomizeWeekNumber(Self, WeekOf(dweek), robj);

          dweek := dweek + 7;
          Inc(K);
        end;
      end;

      case WeekNumbersPosition of
        wnpLeft: r.Left := r.Left + chwk;
        wnpRight: r.Width := r.Width - chwk;
      end;

      cw := r.Width / DaysPerWeek;
      yoff := r.Top;
      xoff := r.Left;

      for K := start to stop do
      begin
        cd := GetDate(cdt, k, dim);
        wd := GetDayOfWeekColumn(cd);

        rd.Left := xoff + (wd * cw) - cw;
        rd.Top := yoff + ((rows - 1) * ch);
        rd.Height := ch;
        rd.Width := cw;

        drawcurrent := (CompareDate(Int(Now), cd) = 0) and ShowCurrentDay;

        if FDisjunctDays.Count > 0 then
          drawselected := IsDisjunctDate(cd)
        else
          drawselected := CompareDate(SelectedDay, cd) = 0;

        mind := MinDate;
        maxd := MaxDate;

        if MinDate = 0 then
          mind := cd;

        if MaxDate = 0 then
          maxd := cd;

        robj := nil;

        if (cd >= mind) and (cd <= maxd) then
        begin
          if drawselected then
          begin
            //selected
            robj := rdsel.Clone(v) as TTMSFMXCalendarDateShape;
            CloneChildrenBase(rdsel, robj);
          end
          else if drawcurrent then
          begin
            //current
            robj := rdcur.Clone(v) as TTMSFMXCalendarDateShape;
            CloneChildrenBase(rdcur, robj);
          end
          else if not drawcurrent then
          begin
            if IsWeekendDay(cd) and (k >= 1) and (k <= dim) then
            begin
              //weekend
              robj := rdwe.Clone(v) as TTMSFMXCalendarDateShape;
              CloneChildrenBase(rdwe, robj);
            end
            else if (k >= 1) and (k <= dim) then
            begin
              //normal
              robj := rdnor.Clone(v) as TTMSFMXCalendarDateShape;
              CloneChildrenBase(rdnor, robj);
            end
            else if (k < 1) then
            begin
              //bfore
              robj := rdbef.Clone(v) as TTMSFMXCalendarDateShape;
              CloneChildrenBase(rdbef, robj);
            end
            else if (k > dim) then
            begin
              //after
              robj := rdaft.Clone(v) as TTMSFMXCalendarDateShape;
              CloneChildrenBase(rdaft, robj);
            end;
          end;
        end
        else
        begin
          //disabled
          robj := rdnor.Clone(v) as TTMSFMXCalendarDateShape;
          CloneChildrenBase(rdnor, robj);
          robj.Enabled := False;
        end;

        if Assigned(robj) then
        begin
          robj.StyleName := 'tmsfmxcalendardaterect'+DateToStr(cd);
          robj.Date := cd;
          robj.HitTest := True;
          robj.CanFocus := False;
          robj.OnClick := CalendarDateSelect;
          robj.Calendar := Self;
          robj.OnMouseDown := CalendarDateMouseDown;
          robj.OnMouseUp := CalendarDateMouseUp;
          robj.OnMouseMove := CalendarDateMouseMove;

          txtobj := robj.FindStyleResource('datetext');
          if Assigned(txtobj) then
          begin
            if txtobj is TText then
            begin
              txtd := txtobj as TText;
              txtd.HitTest := False;
              day := inttostr(DayOf(cd));
              txtd.Text := day;
            end;
          end;

          robj.SetBounds(rd.Left, rd.Top, rd.Width, rd.Height);

          if Assigned(OnHasEvent) then
          begin
            hasevent := False;
            eventtxt := '';
            evntc := TAlphaColorRec.Lime;
            OnHasEvent(Self, cd, evntc, eventtxt, hasevent);
            if hasevent then
            begin
             reventsarr := GetEventsByDate(cd);
             if Length(reventsarr) = 0 then
             begin
               evnthas := Events.Add;
               evnthas.Text := eventtxt;
               evnthas.Date := cd;
               evnthas.Color := evntc;
             end;
            end;
          end;

          SetLength(reventsarr, 0);
          reventsarr := GetEventsByDate(cd);
          for J := 0 to Length(rEventsArr) - 1 do
          begin
            evnt := rEventsArr[J];
            if Assigned(evnt) then
            begin
              revnt := revent.Clone(robj) as TTMSFMXCalendarDateEventShape;
              revnt.StyleName := 'tmsfmxcalendardateeventrect' + datetostr(cd);
              revnt.Position.X := robj.Width - revent.Width - 1;
              revnt.Position.Y := 1;
              revnt.Visible := True;
              revnt.Fill.Color := evnt.Color;
              revnt.Cursor := crHandPoint;
              revnt.Kind := evnt.Kind;
              revnt.HitTest := True;
              revnt.OnClick := CalendarDateEventClick;
              revnt.OnMouseEnter := CalendarDateEventEnter;
              revnt.OnMouseLeave := CalendarDateEventLeave;
              revnt.Date := cd;
              revnt.Event := evnt;
              robj.AddObject(revnt);

              if Assigned(OnCustomizeEvent) then
                OnCustomizeEvent(Self, evnt, revnt);
            end;
          end;

          v.AddObject(robj);
          robj.Visible := True;

          if Assigned(OnCustomizeDay) then
            OnCustomizeDay(Self, cd, robj);
        end;

        if (wd = 7) and (k >= 1) and (k <= dim) then
          Inc(rows);
      end;
    end;
  end;

  BlockUpdate := False;
end;

{ TDisjunctDateArray }

function TDisjunctDateArray.Add: TDisjunctDateItem;
begin
  Result := TDisjunctDateItem(inherited Add);
end;

procedure TDisjunctDateArray.EndUpdate;
begin
  inherited;
  if Assigned(OnDisjunctArrayChange) then
    OnDisjunctArrayChange(Self);
end;

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

function TDisjunctDateArray.Insert(Index: Integer): TDisjunctDateItem;
begin
  Result := TDisjunctDateItem(inherited Insert(Index));
end;

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

{ TTMSFMXCalendarEvents }

function TTMSFMXCalendarEvents.Add: TTMSFMXCalendarEvent;
begin
  Result := TTMSFMXCalendarEvent(inherited Add);
end;

procedure TTMSFMXCalendarEvents.EndUpdate;
begin
  inherited;
  UpdateCalendar;
end;

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

function TTMSFMXCalendarEvents.Insert(Index: Integer): TTMSFMXCalendarEvent;
begin
  Result := TTMSFMXCalendarEvent(inherited Insert(Index));
end;

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

procedure TTMSFMXCalendarEvents.UpdateCalendar;
begin
  if Assigned(OnCalendarEventChange) then
    OnCalendarEventChange(Self);
end;

{ TTMSFMXCalendarEvent }

constructor TTMSFMXCalendarEvent.Create(Collection: TCollection);
begin
  inherited;
  FOwner := (Collection as TTMSFMXCalendarEvents);
  FKind := ekEllipse;
  FDate := Now;
  FColor := TAlphaColorRec.Lime;
end;

procedure TTMSFMXCalendarEvent.SetColor(const Value: TAlphaColor);
begin
  if FColor <> Value then
  begin
    FColor := Value;
    if Assigned(FOwner) then
      FOwner.UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendarEvent.SetDate(const Value: TDate);
begin
  if FDate <> Value then
  begin
    FDate := Value;
    if Assigned(FOwner) then
      FOwner.UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendarEvent.SetKind(
  const Value: TTMSFMXCalendarDateEventKind);
begin
  if FKind <> Value then
  begin
    FKind := Value;
    if Assigned(FOwner) then
      FOwner.UpdateCalendar;
  end;
end;

procedure TTMSFMXCalendarEvent.SetText(const Value: String);
begin
  if FText <> Value then
  begin
    FText := Value;
    if Assigned(FOwner) then
      FOwner.UpdateCalendar;
  end;
end;

{ TTMSFMXCalendarDateEventShape }

constructor TTMSFMXCalendarDateEventShape.Create(AOwner: TComponent);
begin
  inherited;
  FKind := ekEllipse;
end;

procedure TTMSFMXCalendarDateEventShape.Painting;
var
  pth: TPathData;
begin
  inherited;
  case Kind of
    ekTriangle:
    begin
      pth := TPathData.Create;
      pth.MoveTo(PointF(Width / 2, 0));
      pth.LineTo(PointF(Width, Height));
      pth.LineTo(PointF(0, Height));
      pth.ClosePath;
      Canvas.FillPath(pth, Opacity, Fill);
      Canvas.DrawPath(pth, Opacity, Stroke);
      pth.Free;
    end;
    ekRectangle:
    begin
      Canvas.FillRect(BoundsRect, 0, 0, AllCorners, Opacity, Fill);
      Canvas.DrawRect(BoundsRect, 0, 0, AllCorners, Opacity, Stroke);
    end;
    ekDiamond:
    begin
      pth := TPathData.Create;
      pth.MoveTo(PointF(Width / 2, 0));
      pth.LineTo(PointF(Width, Height / 2));
      pth.LineTo(PointF(Width / 2, Height));
      pth.LineTo(PointF(0, Height / 2));
      pth.ClosePath;
      Canvas.FillPath(pth, Opacity, Fill);
      Canvas.DrawPath(pth, Opacity, Stroke);
      pth.Free;
    end;
    ekEllipse:
    begin
      Canvas.FillEllipse(Boundsrect, Opacity, Fill);
      Canvas.DrawEllipse(Boundsrect, Opacity, Stroke);
    end;
  end;
end;

procedure TTMSFMXCalendarDateEventShape.SetKind(
  const Value: TTMSFMXCalendarDateEventKind);
begin
  if FKind <> Value then
  begin
    FKind := Value;
    Repaint;
  end;
end;

{ TTMSFMXCalendarDateShape }

procedure TTMSFMXCalendarDateShape.Paint;
var
  r: TRectF;
begin
  inherited;
  if Assigned(Calendar) then
  begin
    if Calendar.IsFocused and (Calendar.FocusedDay = Date) then
    begin
      Canvas.Stroke.Color := TAlphaColorRec.Black;
      {$IFDEF DELPHIXE6_LVL}
      Canvas.StrokeDash := TStrokeDash.Dot;
      Canvas.Stroke.Kind := TBrushKind.Solid;
      {$ELSE}
      Canvas.StrokeDash := TStrokeDash.sdDot;
      Canvas.Stroke.Kind := TBrushKind.bkSolid;
      {$ENDIF}
      Canvas.StrokeThickness := 1;
      r := BoundsRect;
      InflateRect(r, -2, -2);
      Canvas.DrawRect(r, XRadius, YRadius, Corners, Opacity, CornerType);
    end;
  end;
end;

{ TTMSFMXCalendarPicker }

procedure TTMSFMXCalendarPicker.CalendarDaySelect(Sender: TObject; ADate: TDate);
begin
  Text := DateToStr(ADate);
  if Observers.IsObserving(TObserverMapping.EditLinkID) then
    if not TLinkObservers.EditLinkEdit(Observers) then
    begin
      TLinkObservers.EditLinkReset(Observers);
      Exit;
    end
    else
      TLinkObservers.EditLinkModified(Observers);
  if Observers.IsObserving(TObserverMapping.ControlValueID) then
    TLinkObservers.ControlValueModified(Observers);
end;

procedure TTMSFMXCalendarPicker.CalendarDisjunctDaySelect(Sender: TObject;
  ADates: TDisjunctDateArray);
var
  I: Integer;
begin
  Text := '';
  for I := 0 to ADates.Count - 1 do
  begin
    Text := Text + DateToStr(ADates[I].Date);
    if I < ADates.Count - 1 then
      Text := Text + DisjunctSelectDelimiter;
  end;
end;

procedure TTMSFMXCalendarPicker.CalendarDropDown(Sender: TObject);
begin
  DropDown;
end;

procedure TTMSFMXCalendarPicker.CalendarMultiDaySelect(Sender: TObject;
  AStartDate, AEndDate: TDate);
begin
  Text := DateToStr(AStartDate) + MultiSelectDelimiter + DateToStr(AEndDate);
end;

procedure TTMSFMXCalendarPicker.CloseWithEscape(Sender: TObject);
begin
  Date := FOldDate;
end;

constructor TTMSFMXCalendarPicker.Create(AOwner: TComponent);
begin
  inherited;
  FMultiSelectDelimiter := '-';
  FDisjunctSelectDelimiter := ';';
  Text := DateToStr(Now);
  FCalendar := TTMSFMXCalendar.Create(Self);
  FCalendar.OnDaySelect := CalendarDaySelect;
  FCalendar.OnInternalDropDown := CalendarDropDown;
  FCalendar.OnMultiDaySelect := CalendarMultiDaySelect;
  FCalendar.OnDisjunctDaySelect := CalendarDisjunctDaySelect;
  PopupControl := Calendar;
  OnCloseWithEscape := CloseWithEscape;
end;

procedure TTMSFMXCalendarPicker.DropDown;
procedure Split
   (const Delimiter: Char;
    Input: string;
    const Strings: TStrings) ;
begin
   Assert(Assigned(Strings)) ;
   Strings.Clear;
   Strings.Delimiter := Delimiter;
   Strings.DelimitedText := Input;
end;

var
  d, ds, de: TDateTime;
  s: Integer;
  str: TStringList;
  I: Integer;
  strText: String;
begin
  if not Popup.IsOpen then
  begin
    try
      strText := Text;
      if Pos(DisjunctSelectDelimiter, strText) > 0 then
      begin
        str := TStringList.Create;
        try
          Split(DisjunctSelectDelimiter[1], strText, str);
          for I := 0 to str.Count - 1 do
          begin
            TryStrToDate(str[I], d);
            if I = 0 then
              Calendar.SelectDate(d, [])
            else
              Calendar.SelectDate(d, [ssCtrl]);
          end;
        finally
          str.Free;
        end;
      end
      else if Pos(MultiSelectDelimiter, strText) > 0 then
      begin
        s := Pos(MultiSelectDelimiter, strText);
        TryStrToDate(Copy(strText, 0, s-1), ds);
        TryStrToDate(Copy(strText, s+1, Length(strText) - 1), de);
        Calendar.SelectDate(ds, []);
        Calendar.SelectDate(de, [ssShift]);
      end
      else
      begin
        TryStrToDate(strText, d);
        Calendar.SelectedDay := d;
        Calendar.Date := d;
        FOldDate := d;
      end;
    except
      Calendar.Date := Now;
    end;
  end;

  inherited;
end;

function TTMSFMXCalendarPicker.GetDate: TDate;
var
  d: TDateTime;
begin
  TryStrToDate(Text, d);
  Result := d;
end;

procedure TTMSFMXCalendarPicker.SetDate(const Value: TDate);
begin
  FOldDate := Date;
  Text := DateToStr(Value);
end;

initialization
  RegisterFmxClasses([TTMSFMXCalendar, TTMSFMXCalendarPicker, TTMSFMXCalendarDateEventShape, TTMSFMXCalendarDateShape]);

end.
