{ pickdate unit

  Copyright (C) 2005-2010 Lagunov Aleksey alexs@hotbox.ru and Lazarus team
  original conception from rx library for Delphi (c)

  This library is free software; you can redistribute it and/or modify it
  under the terms of the GNU Library General Public License as published by
  the Free Software Foundation; either version 2 of the License, or (at your
  option) any later version with the following modification:

  As a special exception, the copyright holders of this library give you
  permission to link this library with independent modules to produce an
  executable, regardless of the license terms of these independent modules,and
  to copy and distribute the resulting executable under terms of your choice,
  provided that you also meet, for each linked independent module, the terms
  and conditions of the license of that module. An independent module is a
  module which is not derived from or based on this library. If you modify
  this library, you may extend this exception to your version of the library,
  but you are not obligated to do so. If you do not wish to do so, delete this
  exception statement from your version.

  This program is distributed in the hope that it will be useful, but WITHOUT
  ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
  FITNESS FOR A PARTICULAR PURPOSE. See the GNU Library General Public License
  for more details.

  You should have received a copy of the GNU Library General Public License
  along with this library; if not, write to the Free Software Foundation,
  Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
}

unit pickdate;

{$I rx.inc}

interface

uses
  LCLType, Classes, Controls, SysUtils, Graphics, DateUtil, Grids,
  LCLProc, LMessages, ExtCtrls, StdCtrls, Buttons, Forms, Menus;

{ TRxCalendar }

type
  TDayOfWeek = 0..6;

  TDaysItem = packed record
    DayNum:byte;
    DayDate:TDateTime;
    DayColor:TColor;
  end;
  
  TDaysArray = array[0..6, 1..6] of TDaysItem;

  { TCustomRxCalendar }

  TCustomRxCalendar = class(TCustomDrawGrid)
  private
    FDate: TDateTime;
    FMonthOffset: Integer;
    FNotInThisMonthColor: TColor;
    FOnChange: TNotifyEvent;
    FReadOnly: Boolean;
    FStartOfWeek: TDayOfWeekName;
    FUpdating: Boolean;
    FUseCurrentDate: Boolean;
    FWeekends: TDaysOfWeek;
    FWeekendColor: TColor;
    FDaysArray:TDaysArray;
    FShortDaysOfWeek: TStrings;
    function GetDateElement(Index: Integer): Integer;
    procedure FillDaysArray;
    function GetShortDaysOfWeek: TStrings;
    procedure SetCalendarDate(Value: TDateTime);
    procedure SetDateElement(Index: Integer; Value: Integer);
    procedure SetNotInThisMonthColor(const AValue: TColor);
    procedure SetShortDaysOfWeek(const AValue: TStrings);
    procedure SetStartOfWeek(Value: TDayOfWeekName);
    procedure SetUseCurrentDate(Value: Boolean);
    procedure SetWeekendColor(Value: TColor);
    procedure SetWeekends(Value: TDaysOfWeek);
    function IsWeekend(ACol, ARow: Integer): Boolean;
    procedure CalendarUpdate(DayOnly: Boolean);
    function StoreCalendarDate: Boolean;
    procedure AddWeek;
    procedure DecWeek;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure Change; dynamic;
    procedure ChangeMonth(Delta: Integer);
    procedure Click; override;
    function DaysThisMonth: Integer;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure LMSize(var Message: TLMSize); message LM_SIZE;
    procedure RxCalendarMouseWheelUp(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    procedure RxCalendarMouseWheelDown(Sender: TObject; Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
    procedure UpdateShortDaysOfWeek; virtual;

    property CalendarDate: TDateTime read FDate write SetCalendarDate
      stored StoreCalendarDate;
    property Day: Integer index 3  read GetDateElement write SetDateElement stored False;
    property Month: Integer index 2  read GetDateElement write SetDateElement stored False;
    property ReadOnly: Boolean read FReadOnly write FReadOnly default False;
    property StartOfWeek: TDayOfWeekName read FStartOfWeek write SetStartOfWeek default Mon;
    property UseCurrentDate: Boolean read FUseCurrentDate write SetUseCurrentDate default True;
    property WeekendColor: TColor read FWeekendColor write SetWeekendColor default clRed;
    property Weekends: TDaysOfWeek read FWeekends write SetWeekends default [Sun];
    property Year: Integer index 1  read GetDateElement write SetDateElement stored False;
    property OnChange: TNotifyEvent read FOnChange write FOnChange;
    property NotInThisMonthColor:TColor read FNotInThisMonthColor write SetNotInThisMonthColor default clSilver;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure NextMonth;
    procedure NextYear;
    procedure PrevMonth;
    procedure PrevYear;
    procedure UpdateCalendar; virtual;
    property ShortDaysOfWeek: TStrings read GetShortDaysOfWeek write SetShortDaysOfWeek;
  end;

  { TRxCalendar1 }

  TRxCalendarGrid = class(TCustomRxCalendar)
  protected
    procedure SetBounds(aLeft, aTop, aWidth, aHeight: integer); override;
  published
    property Align;
    property Anchors;
    property BorderColor;
    property BorderSpacing;
    property CalendarDate;
    property Constraints;
    property Day;
    property Font;
    property Hint;
    property Month;
    property NotInThisMonthColor;
    property PopupMenu;
    property ReadOnly;
    property SelectedColor;
    property ShortDaysOfWeek; //
    property StartOfWeek;
    property TabStop;
    property UseCurrentDate;
    property Visible;
    property WeekendColor;
    property Weekends;
    property Year;

    property OnChange;
    property OnClick;
    property OnEnter;
    property OnExit;
    property OnKeyDown;
    property OnKeyPress;
    property OnKeyUp;
    property OnMouseDown;
    property OnMouseEnter;
    property OnMouseLeave;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnPrepareCanvas;
  end;

{ TPopupCalendar }

type
  TCloseUpEvent = procedure (Sender: TObject; Accept: Boolean) of object;

  TPopupCalendar = class(TForm)
  private
    FCalendar: TCustomRxCalendar;
    FCloseUp: TCloseUpEvent;
    FTitleLabel: TLabel;
    FFourDigitYear: Boolean;
    FBtns: array[0..3] of TSpeedButton;
    FMonthMenu:TPopupMenu;
    FMonthNames: TStrings;
    procedure CalendarMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    function GetDate: TDateTime;
    procedure PrevMonthBtnClick(Sender: TObject);
    procedure NextMonthBtnClick(Sender: TObject);
    procedure PrevYearBtnClick(Sender: TObject);
    procedure NextYearBtnClick(Sender: TObject);
    procedure CalendarChange(Sender: TObject);
    procedure SetDate(const AValue: TDateTime);
    procedure SetMonthNames(const AValue: TStrings);
    procedure TopPanelDblClick(Sender: TObject);
    procedure MonthMenuClick(Sender: TObject);
    procedure CalendarDblClick(Sender: TObject);
  protected
    FCloseBtn:TBitBtn;
    FControlPanel:TPanel;
    procedure KeyDown(var Key: Word; Shift: TShiftState); override;
    procedure KeyPress(var Key: Char); override;
    procedure Paint;override;
    procedure Deactivate; override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    procedure AutoSizeForm;
    property Date:TDateTime read GetDate write SetDate;
    property OnCloseUp: TCloseUpEvent read FCloseUp write FCloseUp;
    property Calendar: TCustomRxCalendar read FCalendar;
    property MonthNames: TStrings read FMonthNames write SetMonthNames;
  end;

{ TSelectDateDlg }

type
  TSelectDateDlg = class(TForm)
    Calendar: TCustomRxCalendar;
    TitleLabel: TLabel;
    FMonthMenu:TPopupMenu;
    procedure PrevMonthBtnClick(Sender: TObject);
    procedure NextMonthBtnClick(Sender: TObject);
    procedure PrevYearBtnClick(Sender: TObject);
    procedure NextYearBtnClick(Sender: TObject);
    procedure CalendarChange(Sender: TObject);
    procedure CalendarDblClick(Sender: TObject);
    procedure TopPanelDblClick(Sender: TObject);
    procedure FormKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure MonthMenuClick(Sender: TObject);
  private
    { Private declarations }
    FBtns: array[0..3] of TSpeedButton;
    procedure SetDate(Date: TDateTime);
    function GetDate: TDateTime;
  public
    { Public declarations }
    constructor Create(AOwner: TComponent); override;
    property Date: TDateTime read GetDate write SetDate;
  end;

{ Calendar dialog }

function SelectDate(var Date: TDateTime; const DlgCaption: TCaption;
  AStartOfWeek: TDayOfWeekName; AWeekends: TDaysOfWeek;
  AWeekendColor: TColor; BtnHints: TStrings): Boolean;
function SelectDateStr(var StrDate: string; const DlgCaption: TCaption;
  AStartOfWeek: TDayOfWeekName; AWeekends: TDaysOfWeek;
  AWeekendColor: TColor; BtnHints: TStrings): Boolean;
function PopupDate(var Date: TDateTime; Edit: TWinControl): Boolean;

{ Popup calendar }

function CreatePopupCalendar(AOwner: TComponent
  {$IFDEF USED_BiDi}; ABiDiMode: TBiDiMode = bdLeftToRight {$ENDIF}): TPopupCalendar;
procedure SetupPopupCalendar(PopupCalendar: TWinControl;
  AStartOfWeek: TDayOfWeekName; AWeekends: TDaysOfWeek;
  AWeekendColor: TColor; BtnHints: TStrings; FourDigitYear: Boolean);

const
  PopupCalendarSize: TPoint = (X: 187; Y: 124);

implementation

uses Messages, RXCtrls, rxconst, ToolEdit, vclutils, math, LCLStrConsts,
  {rxstrutils,} LResources;

const
  SBtnGlyphs: array[0..3] of PChar = ('PREV2', 'PREV1', 'NEXT1', 'NEXT2');

procedure FontSetDefault(AFont: TFont);
(*
{$IFDEF WIN32}
var
  NonClientMetrics: TNonClientMetrics;
{$ENDIF}
*)
begin
(*
{$IFDEF WIN32}
  NonClientMetrics.cbSize := SizeOf(NonClientMetrics);
  if SystemParametersInfo(SPI_GETNONCLIENTMETRICS, 0, @NonClientMetrics, 0) then
    AFont.Handle := CreateFontIndirect(NonClientMetrics.lfMessageFont)
  else
{$ENDIF}
*)
  with AFont do
  begin
    Color := clWindowText;
{$IFDEF WINDOWS}
    Name := 'MS Sans Serif';
    Size := 8;
{$ELSE}
    if Assigned(Application) and Assigned(Application.MainForm) then
      Size := Application.MainForm.Font.Size
    else
      Size := 9;
    Name := 'default';
{$ENDIF}
    Style := [];
  end;
end;

function CreateRxCalendarPopupMenu(AOwner:TComponent; AOnClick:TNotifyEvent):TPopupMenu;
var
  i:integer;
  MI:TMenuItem;
begin
  Result:=TPopupMenu.Create(AOwner);
  for i:=1 to 12 do
  begin
    MI:=TMenuItem.Create(Result);
    MI.Caption := LongMonthNames[i];
    MI.OnClick:=AOnClick;
    MI.Tag:=i;
    Result.Items.Add(MI);
  end;

  MI:=TMenuItem.Create(Result);
  MI.Caption:='-';
  Result.Items.Add(MI);

  MI:=TMenuItem.Create(Result);
  MI.Caption:=sToCurDate;
  MI.OnClick:=AOnClick;
  MI.Tag:=-1;
  Result.Items.Add(MI);
end;

{ TRxTimerSpeedButton }

type
  TRxTimerSpeedButton = class(TRxSpeedButton)
  public
    constructor Create(AOwner: TComponent); override;
  published
    property AllowTimer default True;
  end;

constructor TRxTimerSpeedButton.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  AllowTimer := True;
  ControlStyle := ControlStyle + [csReplicatable];
end;


  { TCustomRxCalendar }
  
constructor TCustomRxCalendar.Create(AOwner: TComponent);
var
  ADefaultTextStyle: TTextStyle;
begin
  inherited Create(AOwner);
  FShortDaysOfWeek := TStringList.Create;
  FUseCurrentDate := True;
  FStartOfWeek := Mon;
  FWeekends := [Sun];
  FWeekendColor := clRed;
  FNotInThisMonthColor:=clSilver;
  FixedCols := 0;
  FixedRows := 1;
  ColCount := 7;
  RowCount := 7;
  ScrollBars := ssNone;
  Options := Options - [goRangeSelect] + [goDrawFocusSelected];
  ControlStyle := ControlStyle + [csFramed];
  FDate := Date;
  ADefaultTextStyle:=DefaultTextStyle;
  ADefaultTextStyle.Alignment:=taCenter;
  ADefaultTextStyle.Layout:=tlCenter;
  DefaultTextStyle:=ADefaultTextStyle;
  FocusRectVisible := False;
  OnMouseWheelUp := @RxCalendarMouseWheelUp;
  OnMouseWheelDown := @RxCalendarMouseWheelDown;
  UpdateShortDaysOfWeek;
  UpdateCalendar;
  TitleStyle:=tsNative;
end;

destructor TCustomRxCalendar.Destroy;
begin
  FShortDaysOfWeek.Free;
  inherited Destroy;
end;

procedure TCustomRxCalendar.CreateParams(var Params: TCreateParams);
const
  ClassStylesOff = CS_VREDRAW or CS_HREDRAW;
begin
  inherited CreateParams(Params);
  with Params do
  begin
    WindowClass.Style := WindowClass.Style and DWORD(not ClassStylesOff);
    Style := Style or WS_CLIPCHILDREN;
  end;
end;

procedure TCustomRxCalendar.Change;
begin
  if Assigned(FOnChange) then FOnChange(Self);
end;

procedure TCustomRxCalendar.Click;
var
  TheCellText: string;
begin
  FDate := FDaysArray[Col, Row].DayDate;
  FUseCurrentDate := False;
  CalendarUpdate(false);
  Change;
  inherited Click;
end;

function TCustomRxCalendar.DaysThisMonth: Integer;
begin
  Result := DaysPerMonth(Year, Month);
end;

procedure TCustomRxCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect;
  AState: TGridDrawState);
var
  DayNum:integer;
  R: TRect;
begin
  PrepareCanvas(aCol, aRow, aState);

  if (gdSelected in aState) and (gdFocused in aState) then
    Canvas.Brush.Color:=SelectedColor;

  Canvas.FillRect(aRect);
  DrawCellGrid(aCol,aRow,aRect,aState);

  if ARow>0 then
  begin
    if not ((gdSelected in aState) and (gdFocused in aState)) then
    begin
      if (FDaysArray[ACol, ARow].DayDate = Date) and (FDaysArray[ACol, ARow].DayColor <> FNotInThisMonthColor) then
      begin
        R := ARect;
        // Variant 1
        //Dec(R.Bottom, 1);
        //Dec(R.Right, 1);
        //Canvas.Frame3d(R, 1, bvLowered);

        // Variant 2
        RxFrame3D(Canvas, R, clWindowFrame, clBtnHighlight, 1);
        RxFrame3D(Canvas, R, clBtnShadow, clBtnFace, 1);
      end;
      Canvas.Font.Color:=FDaysArray[ACol, ARow].DayColor;
    end
    else
      Canvas.Font.Color := clHighlightText  // clWindow
    ;
    DrawCellText(ACol, ARow, ARect, AState, IntToStr(FDaysArray[ACol, ARow].DayNum));

  end
  else
  begin
    Canvas.Font.Color:=clWindowText;
    //DrawCellText(ACol, ARow, ARect, AState, ShortDayNames[(Ord(StartOfWeek) + ACol) mod 7 + 1]);
    if FShortDaysOfWeek <> nil then begin
      if ACol <= FShortDaysOfWeek.Count - 1 then
        DrawCellText(ACol, ARow, ARect, AState, FShortDaysOfWeek.Strings[(Ord(StartOfWeek) + ACol) mod 7]);
    end;
  end;
end;

procedure TCustomRxCalendar.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if Shift = [] then
    case Key of
      VK_UP:
        begin
          DecWeek;
          Exit;
        end;
      VK_DOWN:
        begin
          AddWeek;
          Exit;
        end;
      VK_LEFT, VK_SUBTRACT:
        begin
          if (Day > 1) then Day := Day - 1
          else CalendarDate := CalendarDate - 1;
          Exit;
        end;
      VK_RIGHT, VK_ADD:
        begin
          if (Day < DaysThisMonth) then Day := Day + 1
          else CalendarDate := CalendarDate + 1;
          Exit;
        end;
      VK_PRIOR:
        begin
          ChangeMonth(-1);
          Exit;
        end;
      VK_NEXT:
        begin
          ChangeMonth(+1);
          Exit;
        end;
    end;
  inherited KeyDown(Key, Shift);
end;

procedure TCustomRxCalendar.KeyPress(var Key: Char);
begin
  if Key in ['T', 't'] then begin
    CalendarDate := Trunc(Now);
    Key := #0;
  end;
  inherited KeyPress(Key);
end;

procedure TCustomRxCalendar.LMSize(var Message: TLMSize);
var
  GridLinesH, GridLinesW: Integer;
begin
  GridLinesH := 6 * GridLineWidth;
  if (goVertLine in Options) or (goFixedVertLine in Options) then
    GridLinesW := 6 * GridLineWidth
  else GridLinesW := 0;
  DefaultColWidth := (Message.Width - GridLinesW) div 7;
  DefaultRowHeight := (Message.Height - GridLinesH) div 7;
end;

procedure TCustomRxCalendar.RxCalendarMouseWheelUp(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  DecWeek;
  Handled := True;
end;

procedure TCustomRxCalendar.RxCalendarMouseWheelDown(Sender: TObject;
  Shift: TShiftState; MousePos: TPoint; var Handled: Boolean);
begin
  AddWeek;
  Handled := True;
end;

procedure TCustomRxCalendar.SetCalendarDate(Value: TDateTime);
begin
  if FDate <> Value then
  begin
    FDate := Value;
    UpdateCalendar;
    Change;
  end;
end;

function TCustomRxCalendar.StoreCalendarDate: Boolean;
begin
  Result := not FUseCurrentDate;
end;

procedure TCustomRxCalendar.AddWeek;
begin
  if (Day + 7 <= DaysThisMonth) then
    Day := Day + 7
  else
    CalendarDate := CalendarDate + 7;
end;

procedure TCustomRxCalendar.DecWeek;
begin
  if (Day - 7 >= 1) then
    Day := Day - 7
  else
    CalendarDate := CalendarDate - 7;
end;

function TCustomRxCalendar.GetDateElement(Index: Integer): Integer;
var
  AYear, AMonth, ADay: Word;
begin
  DecodeDate(FDate, AYear, AMonth, ADay);
  case Index of
    1: Result := AYear;
    2: Result := AMonth;
    3: Result := ADay;
    else Result := -1;
  end;
end;

procedure TCustomRxCalendar.FillDaysArray;
var
  x,y:integer;
  DayNum: Integer;
  FirstDate:TDateTime;
  AYear, AMonth, ADay:Word;
begin
  DecodeDate(FDate, AYear, AMonth, ADay);
  FirstDate := EncodeDate(AYear, AMonth, 1) + FMonthOffset-1;
  DayNum:=FMonthOffset;
  for y:=1 to 6 do
  begin
    for x:=0 to 6 do
    begin
      FDaysArray[x,y].DayDate:=FirstDate;
      if DayNum < 1 then
      begin
        FDaysArray[x,y].DayColor:=FNotInThisMonthColor;
        DecodeDate(FirstDate, AYear, AMonth, ADay);
        FDaysArray[x,y].DayNum:=ADay;
      end
      else
      if DayNum > DaysThisMonth then
      begin
        FDaysArray[x,y].DayColor:=FNotInThisMonthColor;
        DecodeDate(FirstDate, AYear, AMonth, ADay);
        FDaysArray[x,y].DayNum:=ADay;
      end
      else
      begin
        if IsWeekend(x, y) then
          FDaysArray[x,y].DayColor:=WeekendColor
        else
          FDaysArray[x,y].DayColor:=clWindowText;
        FDaysArray[x,y].DayNum:=DayNum;
      end;
      FirstDate:=FirstDate+1;
      DayNum:=DayNum+1;
    end;
  end;
end;

procedure TCustomRxCalendar.UpdateShortDaysOfWeek;
var
  Ind: Integer;
  OldNotify: TNotifyEvent;
begin
  if (FShortDaysOfWeek <> nil) and (FShortDaysOfWeek.Count = 0) then
  begin
    OldNotify := TStringList(FShortDaysOfWeek).OnChange;
    TStringList(FShortDaysOfWeek).OnChange := nil;
    for Ind := 1 to 7 do
      FShortDaysOfWeek.Add(DefaultFormatSettings.ShortDayNames[Ind]);
    TStringList(FShortDaysOfWeek).OnChange := OldNotify;
  end;
end;

function TCustomRxCalendar.GetShortDaysOfWeek: TStrings;
begin
  Result := FShortDaysOfWeek;
end;

procedure TCustomRxCalendar.SetDateElement(Index: Integer; Value: Integer);
var
  AYear, AMonth, ADay: Word;
begin
  if Value > 0 then begin
    DecodeDate(FDate, AYear, AMonth, ADay);
    case Index of
      1: if AYear <> Value then AYear := Value else Exit;
      2: if (Value <= 12) and (Value <> AMonth) then begin
           AMonth := Value;
           if ADay > DaysPerMonth(Year, Value) then
             ADay := DaysPerMonth(Year, Value);
         end else Exit;
      3: if (Value <= DaysThisMonth) and (Value <> ADay) then
           ADay := Value
         else Exit;
      else Exit;
    end;
    FDate := EncodeDate(AYear, AMonth, ADay);
    FUseCurrentDate := False;
    CalendarUpdate(Index = 3);
    Change;
  end;
end;

procedure TCustomRxCalendar.SetNotInThisMonthColor(const AValue: TColor);
begin
  if AValue <> FNotInThisMonthColor then
  begin
    FNotInThisMonthColor:=AValue;
    FillDaysArray;
    Invalidate;
  end;
end;

procedure TCustomRxCalendar.SetShortDaysOfWeek(const AValue: TStrings);
begin
  if AValue.Text <> FShortDaysOfWeek.Text then begin
    FShortDaysOfWeek.Assign(AValue);
    Invalidate; //
  end;
end;

procedure TCustomRxCalendar.SetWeekendColor(Value: TColor);
begin
  if Value <> FWeekendColor then
  begin
    FWeekendColor := Value;
    FillDaysArray;
    Invalidate;
  end;
end;

procedure TCustomRxCalendar.SetWeekends(Value: TDaysOfWeek);
begin
  if Value <> FWeekends then
  begin
    FWeekends := Value;
    UpdateCalendar;
  end;
end;

function TCustomRxCalendar.IsWeekend(ACol, ARow: Integer): Boolean;
begin
  Result := TDayOfWeekName((Integer(StartOfWeek) + ACol) mod 7) in FWeekends;
end;

procedure TCustomRxCalendar.SetStartOfWeek(Value: TDayOfWeekName);
begin
  if Value <> FStartOfWeek then
  begin
    FStartOfWeek := Value;
    UpdateCalendar;
  end;
end;

procedure TCustomRxCalendar.SetUseCurrentDate(Value: Boolean);
begin
  if Value <> FUseCurrentDate then
  begin
    FUseCurrentDate := Value;
    if Value then
    begin
      FDate := Date; { use the current date, then }
      UpdateCalendar;
    end;
  end;
end;

{ Given a value of 1 or -1, moves to Next or Prev month accordingly }
procedure TCustomRxCalendar.ChangeMonth(Delta: Integer);
var
  AYear, AMonth, ADay: Word;
  NewDate: TDateTime;
  CurDay: Integer;
begin
  DecodeDate(FDate, AYear, AMonth, ADay);
  CurDay := ADay;
  if Delta > 0 then ADay := DaysPerMonth(AYear, AMonth)
  else ADay := 1;
  NewDate := EncodeDate(AYear, AMonth, ADay);
  NewDate := NewDate + Delta;
  DecodeDate(NewDate, AYear, AMonth, ADay);
  if DaysPerMonth(AYear, AMonth) > CurDay then
    ADay := CurDay
  else
    ADay := DaysPerMonth(AYear, AMonth);
  CalendarDate := EncodeDate(AYear, AMonth, ADay);
end;

procedure TCustomRxCalendar.PrevMonth;
begin
  ChangeMonth(-1);
end;

procedure TCustomRxCalendar.NextMonth;
begin
  ChangeMonth(1);
end;

procedure TCustomRxCalendar.NextYear;
begin
  if IsLeapYear(Year) and (Month = 2) and (Day = 29) then Day := 28;
  Year := Year + 1;
end;

procedure TCustomRxCalendar.PrevYear;
begin
  if IsLeapYear(Year) and (Month = 2) and (Day = 29) then Day := 28;
  Year := Year - 1;
end;

procedure TCustomRxCalendar.CalendarUpdate(DayOnly: Boolean);
var
  AYear, AMonth, ADay: Word;
  FirstDate: TDateTime;
begin
  FUpdating := True;
  try
    DecodeDate(FDate, AYear, AMonth, ADay);
    FirstDate := EncodeDate(AYear, AMonth, 1);
    FMonthOffset := 2 - ((DayOfWeek(FirstDate) - Ord(StartOfWeek) + 7) mod 7);
      { day of week for 1st of month }
    if FMonthOffset = 2 then FMonthOffset := -5;

    FillDaysArray;
    MoveExtend(false, (ADay - FMonthOffset) mod 7, (ADay - FMonthOffset) div 7 + 1);
    TopRow:=1; //Правим ошибку для автоскрола календаря после 15 числа...
    VisualChange;

    if DayOnly then Update else Invalidate;
  finally
    FUpdating := False;
  end;
end;

procedure TCustomRxCalendar.UpdateCalendar;
begin
  CalendarUpdate(False);
end;

{ TLocCalendar }

type
  TLocCalendar = class(TCustomRxCalendar)
  private
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
    procedure CMParentColorChanged(var Message: TMessage); message CM_PARENTCOLORCHANGED;
  protected
    procedure CreateParams(var Params: TCreateParams); override;
    procedure DrawCell(ACol, ARow: Longint; ARect: TRect; AState: TGridDrawState); override;
  public
    constructor Create(AOwner: TComponent); override;
    procedure MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
    property GridLineWidth;
    property DefaultColWidth;
    property DefaultRowHeight;
  end;

constructor TLocCalendar.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  ControlStyle := [csCaptureMouse, csClickEvents, csDoubleClicks];
  ControlStyle := ControlStyle + [csReplicatable];
//  Enabled := False;
  BorderStyle := bsNone;
  ParentColor := True;
  CalendarDate := Trunc(Now);
  UseCurrentDate := False;
  FixedColor := Color;
  Options := [goFixedHorzLine];
  TabStop := False;
end;

procedure TLocCalendar.CMParentColorChanged(var Message: TMessage);
begin
  inherited;
  if ParentColor then FixedColor := Self.Color;
end;

procedure TLocCalendar.CMEnabledChanged(var Message: TMessage);
begin
  if HandleAllocated and not (csDesigning in ComponentState) then
//    EnableWindow(Handle, True);
end;

procedure TLocCalendar.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    Style := Style and not (WS_BORDER or WS_TABSTOP or WS_DISABLED);
end;

procedure TLocCalendar.MouseToCell(X, Y: Integer; var ACol, ARow: Longint);
var
  Coord: TGridCoord;
begin
  Coord := MouseCoord(X, Y);
  ACol := Coord.X;
  ARow := Coord.Y;
end;

procedure TLocCalendar.DrawCell(ACol, ARow: Longint; ARect: TRect;
  AState: TGridDrawState);
var
  D, M, Y: Word;
begin
  inherited DrawCell(ACol, ARow, ARect, AState);
  
  if FDaysArray[ACol, ARow].DayDate = SysUtils.Date then
      rxFrame3D(Canvas, ARect, clBtnShadow, clBtnHighlight, 1);
end;


function CreatePopupCalendar(AOwner: TComponent
  {$IFDEF USED_BiDi}; ABiDiMode: TBiDiMode = bdLeftToRight {$ENDIF}): TPopupCalendar;
begin
  Result := TPopupCalendar.Create(AOwner);

  if (AOwner <> nil) and not (csDesigning in AOwner.ComponentState) and
    (Screen.PixelsPerInch <> 96) then
  begin { scale to screen res }
//    Result.ScaleBy(Screen.PixelsPerInch, 96);
    { The ScaleBy method does not scale the font well, so set the
      font back to the original info. }
    TPopupCalendar(Result).FCalendar.ParentFont := True;
    FontSetDefault(TPopupCalendar(Result).Font);
{$IFDEF USED_BiDi}
    Result.BiDiMode := ABiDiMode;
{$ENDIF}
  end;
end;

procedure SetupPopupCalendar(PopupCalendar: TWinControl;
  AStartOfWeek: TDayOfWeekName; AWeekends: TDaysOfWeek;
  AWeekendColor: TColor; BtnHints: TStrings; FourDigitYear: Boolean);
var
  I: Integer;
begin
  if (PopupCalendar = nil) or not (PopupCalendar is TPopupCalendar) then
    Exit;
  TPopupCalendar(PopupCalendar).FFourDigitYear := FourDigitYear;
  if TPopupCalendar(PopupCalendar).FCalendar <> nil then
  begin
    with TPopupCalendar(PopupCalendar).FCalendar do
    begin
      StartOfWeek := AStartOfWeek;
      WeekendColor := AWeekendColor;
      Weekends := AWeekends;
    end;
    if (BtnHints <> nil) then
      for I := 0 to Min(BtnHints.Count - 1, 3) do
      begin
        if BtnHints[I] <> '' then
          TPopupCalendar(PopupCalendar).FBtns[I].Hint := BtnHints[I];
      end;
  end;
end;

constructor TPopupCalendar.Create(AOwner: TComponent);
const
  BtnSide = 14;
var
  BackPanel: TWinControl;
  MI:TMenuItem;
  i:integer;
  TmpBitmap:TBitmap;
begin
  inherited CreateNew(AOwner);

  BorderStyle:=bsNone;

  FFourDigitYear := FourDigitYear;
  Height := Max(PopupCalendarSize.Y, 120);
  Width := Max(PopupCalendarSize.X, 180);
  Color := clBtnFace;
  FontSetDefault(Font);
  KeyPreview:=true;

  if AOwner is TControl then ShowHint := TControl(AOwner).ShowHint
  else ShowHint := True;
  
//  if (csDesigning in ComponentState) then Exit;

  FMonthNames := TStringList.Create;
  if FMonthNames.Count = 0 then
  begin
    for i := Low(DefaultFormatSettings.LongMonthNames) to High(DefaultFormatSettings.LongMonthNames) do
      FMonthNames.Add(DefaultFormatSettings.LongMonthNames[i]);
  end;

  BackPanel := TPanel.Create(Self);
  BackPanel.Anchors:=[akLeft, akRight, akTop, akBottom];

  with BackPanel as TPanel do
  begin
    Parent := Self;
//    Align := alClient;
    ParentColor := True;
    ControlStyle := ControlStyle + [csReplicatable];
  end;

  FControlPanel := TPanel.Create(Self);
  with FControlPanel do
  begin
    Parent := BackPanel;
    Align := alTop;
    Width := Self.Width - 4;
    Height := 18;
    BevelOuter := bvNone;
    ParentColor := True;
    ControlStyle := ControlStyle + [csReplicatable];
    Color:=clSkyBlue;
  end;

  FCalendar := TLocCalendar.Create(Self);
  with TLocCalendar(FCalendar) do
  begin
    Parent := BackPanel;
    Align := alClient;
    OnChange := @CalendarChange;
    OnMouseUp := @CalendarMouseUp;
    OnDblClick := @CalendarDblClick;
  end;

  FCloseBtn:=TBitBtn.Create(Self);
  FCloseBtn.Parent := BackPanel;
  FCloseBtn.Kind:=bkCancel;
  FCloseBtn.Align:=alBottom;
  FCloseBtn.AutoSize:=true;

  BackPanel.Top:=2;
  BackPanel.Left:=2;
  BackPanel.Width:=Width - 4;

  BackPanel.Height:=Height - 4;

  FBtns[0] := TRxTimerSpeedButton.Create(Self);
  with FBtns[0] do
  begin
    Parent := FControlPanel;
    SetBounds(-1, -1, BtnSide, BtnSide);
    //loaded bitmap should be freed as Glyph just takes a copy of it
    TmpBitmap:=LoadBitmapFromLazarusResource('prev2');
    Glyph := TmpBitmap;
    FreeAndNil(TmpBitmap);

    OnClick := @PrevYearBtnClick;
    Hint := sPrevYear;
    Align:=alLeft;
  end;

  FBtns[1] := TRxTimerSpeedButton.Create(Self);
  with FBtns[1] do
  begin
    Parent := FControlPanel;
    SetBounds(BtnSide - 2, -1, BtnSide, BtnSide);

    TmpBitmap:=LoadBitmapFromLazarusResource('prev1');
    Glyph := TmpBitmap;
    FreeAndNil(TmpBitmap);

    OnClick := @PrevMonthBtnClick;
    Hint := sPrevMonth;
    Align:=alLeft;
  end;

  FBtns[2] := TRxTimerSpeedButton.Create(Self);
  with FBtns[2] do
  begin
    Parent := FControlPanel;
    SetBounds(FControlPanel.Width - 2 * BtnSide + 2, -1, BtnSide, BtnSide);
    TmpBitmap:=LoadBitmapFromLazarusResource('next1');
    Glyph := TmpBitmap;
    FreeAndNil(TmpBitmap);
    OnClick := @NextMonthBtnClick;
    Hint := sNextMonth;
    Align:=alRight;
  end;

  FBtns[3] := TRxTimerSpeedButton.Create(Self);
  with FBtns[3] do
  begin
    Parent := FControlPanel;
    SetBounds(FControlPanel.Width - BtnSide + 1, -1, BtnSide, BtnSide);
    TmpBitmap:=LoadBitmapFromLazarusResource('next2');
    Glyph := TmpBitmap;
    FreeAndNil(TmpBitmap);
    OnClick := @NextYearBtnClick;
    Hint := sNextYear;
    Align:=alRight;
  end;

  FTitleLabel := TLabel.Create(Self);
  with FTitleLabel do
  begin
    Parent := FControlPanel;
    AutoSize := False;
    Alignment := taCenter;
    SetBounds(BtnSide * 2 + 1, 1, FControlPanel.Width - 4 * BtnSide - 2, 14);
    Transparent := True;
    OnDblClick := @TopPanelDblClick;
    ControlStyle := ControlStyle + [csReplicatable];
    Align:=alClient;
  end;

  FMonthMenu:=CreateRxCalendarPopupMenu(Self, @MonthMenuClick);

  FTitleLabel.PopupMenu:=FMonthMenu;
  ActiveControl:=FCalendar;
  CalendarChange(nil);
end;

destructor TPopupCalendar.Destroy;
begin
  FMonthNames.Free;
  inherited Destroy;
end;

procedure TPopupCalendar.AutoSizeForm;
begin
  FControlPanel.Height:=FCalendar.Canvas.TextHeight('Wg')+4;
  Height:=(FCalendar.Canvas.TextHeight('Wg')+4)*7+FControlPanel.Height + FCloseBtn.Height;
  Width:=FCalendar.Canvas.TextWidth(' WWW')*7;
  FCalendar.AutoFillColumns:=true;
end;

procedure TPopupCalendar.CalendarMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  Col, Row: Longint;
begin
  if (Button = mbLeft) and (Shift = []) then
  begin
    TLocCalendar(FCalendar).MouseToCell(X, Y, Col, Row);
    if (Row > 0) and (FCalendar.FDaysArray[Col, Row].DayColor <> FCalendar.FNotInThisMonthColor) then
      ModalResult:=mrOk;
  end;
end;

function TPopupCalendar.GetDate: TDateTime;
begin
  Result:=FCalendar.CalendarDate;
end;

procedure TPopupCalendar.TopPanelDblClick(Sender: TObject);
begin
  FCalendar.CalendarDate := Trunc(Now);
end;

procedure TPopupCalendar.MonthMenuClick(Sender: TObject);
var
  Cmd:integer;
begin
  Cmd:=(Sender as TComponent).Tag;
  if Cmd = -1 then
    FCalendar.SetCalendarDate(Sysutils.Date)
  else
    FCalendar.Month:=Cmd;
end;

procedure TPopupCalendar.CalendarDblClick(Sender: TObject);
begin
  ModalResult:=mrOk;
end;

procedure TPopupCalendar.KeyDown(var Key: Word; Shift: TShiftState);
begin
  if FCalendar <> nil then
    case Key of
      VK_NEXT:
        begin
          if ssCtrl in Shift then FCalendar.NextYear;
        end;
      VK_PRIOR:
        begin
          if ssCtrl in Shift then FCalendar.PrevYear;
        end;
      VK_ESCAPE:ModalResult:=mrCancel;
    end;
  inherited KeyDown(Key, Shift);
end;

procedure TPopupCalendar.KeyPress(var Key: Char);
begin
  inherited KeyPress(Key);
  if (FCalendar <> nil) and (Key <> #0) then
    FCalendar.KeyPress(Key);
end;

procedure TPopupCalendar.Paint;
var
  CR:TRect;
begin
  inherited Paint;
  
    CR:=ClientRect;
    RxFrame3D(Canvas, CR, clBtnHighlight, clWindowFrame, 1);
    RxFrame3D(Canvas, CR, clBtnFace, clBtnShadow, 1);
end;

procedure TPopupCalendar.Deactivate;
begin
  inherited Deactivate;
{  if Assigned(FOnPopUpCloseEvent) then
    FOnPopUpCloseEvent(FFindResult);}
//  Close;
end;

procedure TPopupCalendar.PrevYearBtnClick(Sender: TObject);
begin
  FCalendar.PrevYear;
  FCalendar.SetFocus;
end;

procedure TPopupCalendar.NextYearBtnClick(Sender: TObject);
begin
  FCalendar.NextYear;
  FCalendar.SetFocus;
end;

procedure TPopupCalendar.PrevMonthBtnClick(Sender: TObject);
begin
  FCalendar.PrevMonth;
  FCalendar.SetFocus;
end;

procedure TPopupCalendar.NextMonthBtnClick(Sender: TObject);
begin
  FCalendar.NextMonth;
  FCalendar.SetFocus;
end;

procedure TPopupCalendar.CalendarChange(Sender: TObject);
var
  AYear, AMonth, ADay: Word;
begin
  DecodeDate(FCalendar.CalendarDate, AYear, AMonth, ADay);
  FTitleLabel.Caption := Format('%s, %d', [DefaultFormatSettings.LongMonthNames[AMonth], AYear]);
end;

procedure TPopupCalendar.SetDate(const AValue: TDateTime);
begin
  FCalendar.CalendarDate:=AValue;
end;

procedure TPopupCalendar.SetMonthNames(const AValue: TStrings);
begin
  if AValue.Text <> FMonthNames.Text then
  begin
    FMonthNames.Assign(AValue);
    CalendarChange(Self);
  end;
end;

  { TSelectDateDlg }
  
constructor TSelectDateDlg.Create(AOwner: TComponent);
var
  Control: TWinControl;
  MI:TMenuItem;
  i:integer;
  TmpBitmap:TBitmap;
begin
  inherited CreateNew(AOwner, 0);
  Caption := sDateDlgTitle;

  BorderStyle := bsToolWindow;

  BorderIcons := [biSystemMenu];
  ClientHeight := 154;
  ClientWidth := 222;
  FontSetDefault(Font);
  Color := clBtnFace;
  Position := poScreenCenter;
  ShowHint := True;
  KeyPreview := True;

  Control := TPanel.Create(Self);
  with Control as TPanel do
  begin
    Parent := Self;
    SetBounds(0, 0, 222, 22);
    Align := alTop;
    BevelInner := bvLowered;
    ParentColor := True;
    ParentFont := True;
  end;

  TitleLabel := TLabel.Create(Self);
  with TitleLabel do
  begin
    Parent := Control;
    SetBounds(35, 4, 152, 14);
    Alignment := taCenter;
    AutoSize := False;
    Caption := '';
    ParentFont := True;
    Font.Color := clBlue;
    Font.Style := [fsBold];
    Transparent := True;
    OnDblClick := @TopPanelDblClick;
  end;

  FBtns[0] := TRxTimerSpeedButton.Create(Self);
  with FBtns[0] do
  begin
    Parent := Control;
    SetBounds(3, 3, 16, 16);

    TmpBitmap:=LoadBitmapFromLazarusResource('prev2');
    Glyph := TmpBitmap;
    FreeAndNil(TmpBitmap);

    OnClick := @PrevYearBtnClick;
    Hint := sPrevYear;
  end;

  FBtns[1] := TRxTimerSpeedButton.Create(Self);
  with FBtns[1] do begin
    Parent := Control;
    SetBounds(18, 3, 16, 16);

    TmpBitmap:=LoadBitmapFromLazarusResource('prev1');
    Glyph := TmpBitmap;
    FreeAndNil(TmpBitmap);

    OnClick := @PrevMonthBtnClick;
    Hint := sPrevMonth;
  end;

  FBtns[2] := TRxTimerSpeedButton.Create(Self);
  with FBtns[2] do
  begin
    Parent := Control;
    SetBounds(188, 3, 16, 16);

    TmpBitmap:=LoadBitmapFromLazarusResource('next1');
    Glyph := TmpBitmap;
    FreeAndNil(TmpBitmap);

    OnClick := @NextMonthBtnClick;
    Hint := sNextMonth;
  end;

  FBtns[3] := TRxTimerSpeedButton.Create(Self);
  with FBtns[3] do begin
    Parent := Control;
    SetBounds(203, 3, 16, 16);

    TmpBitmap:=LoadBitmapFromLazarusResource('next2');
    Glyph := TmpBitmap;
    FreeAndNil(TmpBitmap);

    OnClick := @NextYearBtnClick;
    Hint := sNextYear;
  end;

  Control := TPanel.Create(Self);
  with Control as TPanel do
  begin
    Parent := Self;
    SetBounds(0, 133, 222, 21);
    Align := alBottom;
    BevelInner := bvNone;
    BevelOuter := bvNone;
    ParentFont := True;
    ParentColor := True;
  end;

  with TButton.Create(Self) do
  begin
    Parent := Control;
    SetBounds(0, 0, 112, 21);
    Caption := rsmbOK;
    ModalResult := mrOk;
  end;

  with TButton.Create(Self) do
  begin
    Parent := Control;
    SetBounds(111, 0, 111, 21);
    Caption := rsmbCancel;
    ModalResult := mrCancel;
    Cancel := True;
  end;

  Calendar := TCustomRxCalendar.Create(Self);
  with Calendar do
  begin
    Parent := Self;
    Align := alClient;
    ParentFont := True;
    SetBounds(2, 2, 218, 113);
    Color := clWhite;
    TabOrder := 0;
    UseCurrentDate := False;
    OnChange := @CalendarChange;
    OnDblClick := @CalendarDblClick;
  end;

  OnKeyDown := @FormKeyDown;
  Calendar.CalendarDate := Trunc(Now);
  ActiveControl := Calendar;
  
  FMonthMenu:=CreateRxCalendarPopupMenu(Self, @MonthMenuClick);

  TitleLabel.PopupMenu:=FMonthMenu;
end;

procedure TSelectDateDlg.SetDate(Date: TDateTime);
begin
  if Date = NullDate then Date := SysUtils.Date;
  try
    Calendar.CalendarDate := Date;
    CalendarChange(nil);
  except
    Calendar.CalendarDate := SysUtils.Date;
  end;
end;

function TSelectDateDlg.GetDate: TDateTime;
begin
  Result := Calendar.CalendarDate;
end;

procedure TSelectDateDlg.TopPanelDblClick(Sender: TObject);
begin
  SetDate(Trunc(Now));
end;

procedure TSelectDateDlg.PrevYearBtnClick(Sender: TObject);
begin
  Calendar.PrevYear;
end;

procedure TSelectDateDlg.NextYearBtnClick(Sender: TObject);
begin
  Calendar.NextYear;
end;

procedure TSelectDateDlg.PrevMonthBtnClick(Sender: TObject);
begin
  Calendar.PrevMonth;
end;

procedure TSelectDateDlg.NextMonthBtnClick(Sender: TObject);
begin
  Calendar.NextMonth;
end;

procedure TSelectDateDlg.CalendarChange(Sender: TObject);
begin
  TitleLabel.Caption := FormatDateTime('MMMM, YYYY', Calendar.CalendarDate);
end;

procedure TSelectDateDlg.CalendarDblClick(Sender: TObject);
begin
  ModalResult := mrOK;
end;

procedure TSelectDateDlg.FormKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
begin
  case Key of
    VK_RETURN: ModalResult := mrOK;
    VK_ESCAPE: ModalResult := mrCancel;
    VK_NEXT:
      begin
        if ssCtrl in Shift then Calendar.NextYear;
        //else Calendar.NextMonth;
        TitleLabel.Update;
      end;
    VK_PRIOR:
      begin
        if ssCtrl in Shift then Calendar.PrevYear;
        //else Calendar.PrevMonth;
        TitleLabel.Update;
      end;
    VK_TAB:
      begin
        if Shift = [ssShift] then Calendar.PrevMonth
        else Calendar.NextMonth;
        TitleLabel.Update;
      end;
  end; {case}
end;

procedure TSelectDateDlg.MonthMenuClick(Sender: TObject);
var
  Cmd:integer;
begin
  Cmd:=(Sender as TComponent).Tag;
  if Cmd = -1 then
    Calendar.SetCalendarDate(Sysutils.Date)
  else
    Calendar.Month:=Cmd;
end;

{ SelectDate routines }

function CreateDateDialog(const DlgCaption: TCaption): TSelectDateDlg;
begin
  Result := TSelectDateDlg.Create(Application);
  try
    if DlgCaption <> '' then Result.Caption := DlgCaption;
{    if Screen.PixelsPerInch <> 96  then begin { scale to screen res }
//      Result.ScaleBy(Screen.PixelsPerInch, 96);
      { The ScaleBy method does not scale the font well, so set the
        font back to the original info. }
      Result.Calendar.ParentFont := True;
      FontSetDefault(Result.Font);
      Result.Left := (Screen.Width div 2) - (Result.Width div 2);
      Result.Top := (Screen.Height div 2) - (Result.Height div 2);
    end;}
  except
    FreeAndNil(Result);
    raise;
  end;
end;

function PopupDate(var Date: TDateTime; Edit: TWinControl): Boolean;
var
  D: TSelectDateDlg;
  P: TPoint;
  W, H, X, Y: Integer;
begin
  Result := False;
  D := CreateDateDialog('');
  try
    D.BorderIcons := [];
    D.HandleNeeded;
    D.Position := poDesigned;
    W := D.Width;
    H := D.Height;
    P := (Edit.ClientOrigin);
    Y := P.Y + Edit.Height - 1;
    if (Y + H) > Screen.Height then Y := P.Y - H + 1;
    if Y < 0 then Y := P.Y + Edit.Height - 1;
    X := (P.X + Edit.Width) - W;
    if X < 0 then X := P.X;
    D.Left := X;
    D.Top := Y;
    D.Date := Date;
    
    if D.ShowModal = mrOk then
    begin
      Date := D.Date;
      Result := True;
    end;
  finally
    D.Free;
  end;
end;

function SelectDate(var Date: TDateTime; const DlgCaption: TCaption;
  AStartOfWeek: TDayOfWeekName; AWeekends: TDaysOfWeek;
  AWeekendColor: TColor; BtnHints: TStrings): Boolean;
var
  D: TSelectDateDlg;
  I: Integer;
begin
  Result := False;
  D := CreateDateDialog(DlgCaption);
  try
    D.Date := Date;
    with D.Calendar do begin
      StartOfWeek := AStartOfWeek;
      Weekends := AWeekends;
      WeekendColor := AWeekendColor;
    end;
    if (BtnHints <> nil) then
      for I := 0 to Min(BtnHints.Count - 1, 3) do begin
        if BtnHints[I] <> '' then
          D.FBtns[I].Hint := BtnHints[I];
      end;
    if D.ShowModal = mrOk then begin
      Date := D.Date;
      Result := True;
    end;
  finally
    D.Free;
  end;
end;

function SelectDateStr(var StrDate: string; const DlgCaption: TCaption;
  AStartOfWeek: TDayOfWeekName; AWeekends: TDaysOfWeek;
  AWeekendColor: TColor; BtnHints: TStrings): Boolean;
var
  DateValue: TDateTime;
begin
  if StrDate <> '' then begin
    try
      DateValue := StrToDateFmt(DefaultFormatSettings.ShortDateFormat, StrDate);
    except
      DateValue := Date;
    end;
  end
  else DateValue := Date;
  Result := SelectDate(DateValue, DlgCaption, AStartOfWeek, AWeekends,
    AWeekendColor, BtnHints);
  if Result then StrDate := FormatDateTime(DefaultFormatSettings.ShortDateFormat, DateValue);
end;

{ TRxCalendarGrid }

procedure TRxCalendarGrid.SetBounds(aLeft, aTop, aWidth, aHeight: integer);
var
  GridLinesH, GridLinesW: Integer;
begin
  inherited SetBounds(aLeft, aTop, aWidth, aHeight);

  GridLinesH := 6 * GridLineWidth;
  if (goVertLine in Options) or (goFixedVertLine in Options) then
    GridLinesW := 6 * GridLineWidth
  else GridLinesW := 0;
  DefaultColWidth := (aWidth - GridLinesW) div 7;
  DefaultRowHeight := (aHeight - GridLinesH) div 7;
end;

initialization
  {$I pickdate.lrs}
end.