Solved

Calendar component with multiple day selection

Posted on 2009-07-07
9
917 Views
Last Modified: 2013-11-23
Can you recommend a preferably free calendar component where the user can select multiple days, probably using Ctrl or Shift.
I will then need to be able to iterate through the selected dates?
0
Comment
Question by:rfwoolf
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 3
9 Comments
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24796982
this calendar allows a date range select.
http://www.maxcomponents.net/index.php?id=1&page=1#TmxCalendar

I'm having a look for myself too if it can multiselect ...
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24797143
it'll need to be extended with a list of selected dates
but it's possible, all the source is included
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24805628
i got a draft version working
you'll need to download the tmxcalendar
here is the changed unit:

 // ****************************************************************************
 // * Calendar component for Delphi.
 // ****************************************************************************
 // * Copyright 2001-2006, Bitvadász Kft. All Rights Reserved.
 // ****************************************************************************
 // * This component can be freely used and distributed in commercial and
 // * private environments, provied this notice is not modified in any way.
 // ****************************************************************************
 // * Feel free to contact me if you have any questions, comments or suggestions
 // * at support@maxcomponents.net
 // ****************************************************************************
 // * Web page: www.maxcomponents.net
 // ****************************************************************************
 
unit mxCalendar;
 
interface
 
uses
  Windows, Messages, SysUtils, StdCtrls, Classes, Graphics, Controls, ExtCtrls,
  Forms, Buttons;
 
{$I MAX.INC}
 
const
  mxCalendarVersion   = $020B;
  NavigateButtonWidth = 23;
 
type
  TmxCustomCalendar = class;
 
  TmxItemType  = (itHeader, itFooter, itCW, itWeek, itDay, itCalendar);
  TmxStyleType = (stSelected, stToday, stDay, stWeekEnd, stIndirect );
 
  TmxOnGetCursorEvent = procedure(Sender: TmxCustomCalendar;
    ItemType: TmxItemType; var ACursor: TCursor) of object;
  TmxOnGetItemStyleEvent = procedure(Sender: TmxCustomCalendar;
    AStyleType: TmxStyleType; ADate: TDate; var AFont: TFont;
    var AColor: TColor) of object;
 
  {CustomPanel to resolve the XP Theme problem}
  TmxPanel = class(TCustomControl)
  Private
    FFlat: Boolean;
    procedure SetFlat( AValue: boolean );
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  Protected
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
  Public
    constructor Create(AOwner: TComponent); override;
    Property Flat: Boolean read FFlat Write SetFlat Default False;
  end;
 
  TmxCalendarOption = (
    coClearButtonVisible,
    coFlatButtons,
    csFlatDays,
    coFlatHeaders,
    coMonthButtonVisible,
    csSelectionEnabled,
    csMultiSelect,
    csSetTodayOnStartup,
    coShowDateLabel,
    coShowFooter,
    coShowNextMonth,
    coShowPreviousMonth,
    coShowHeader,
    coShowWeekDays,
    coShowWeeks,
    coTransparentButtons,
    coTodayButtonVisible,
    csUseWeekEndColor,
    csUseWeekEndFont,
    coYearButtonVisible);
 
  TmxCalendarOptions = set of TmxCalendarOption;
  TmxFirstDayOfWeek  = (fdSunday, fdMonday {, fdTuesday, fdWednesday, fdThursday, fdFriday, fdSaturday });
  TmxHeaderFormat    = (hfMMMMYYYY, hfYYYYMMMM, hfMMYYYY, hfYYYYMM);
 
  TmxHints = class(TPersistent)
  Private
    FHints: array[0..6] of String;
    FOnChange: TNotifyEvent;
    procedure SetHint(Index: integer; AValue: String);
    function GetHint(Index: integer): String;
  Protected
    procedure Change; virtual;
  Public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    property Hints[Index: integer]: String Read GetHint; default;
  Published
    property OnChange: TNotifyEvent Read FOnChange Write FOnChange;
    property NextMonth: String Index 0 Read GetHint Write SetHint;
    property PreviousMonth: String Index 1 Read GetHint Write SetHint;
    property NextYear: String Index 2 Read GetHint Write SetHint;
    property PreviousYear: String Index 3 Read GetHint Write SetHint;
    property TodayButton: String Index 4 Read GetHint Write SetHint;
    property Today: String Index 5 Read GetHint Write SetHint;
    property ClearButton: String Index 6 Read GetHint Write SetHint;
  end;
 
  TmxMessages = class(TPersistent)
  Private
    FMonthNames: array[1..12] of String;
    FMessages: array[0..7] of String;
    FHints: TmxHints;
    FOnChange: TNotifyEvent;
 
    procedure SetMessage(Index: integer; AValue: String);
    function GetMessage(Index: integer): String;
    procedure SetMonthName(Index: integer; AValue: String);
    function GetMonthName(Index: integer): String;
    procedure SetOnChange(AOnChange: TNotifyEvent);
  Protected
    procedure Change; virtual;
  Public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property Messages[Index: integer]: String Read GetMessage; default;
    property MonthNames[Index: integer]: String Read GetMonthName;
  Published
    property OnChange: TNotifyEvent Read FOnChange Write SetOnChange;
    property Hints: TmxHints Read FHints Write FHints;
    property Week: String Index 0 Read GetMessage Write SetMessage;
    property Sunday: String Index 1 Read GetMessage Write SetMessage;
    property Monday: String Index 2 Read GetMessage Write SetMessage;
    property Tuesday: String Index 3 Read GetMessage Write SetMessage;
    property Wednesday: String Index 4 Read GetMessage Write SetMessage;
    property Thursday: String Index 5 Read GetMessage Write SetMessage;
    property Friday: String Index 6 Read GetMessage Write SetMessage;
    property Saturday: String Index 7 Read GetMessage Write SetMessage;
    property January: String Index 1 Read GetMonthName Write SetMonthName;
    property February: String Index 2 Read GetMonthName Write SetMonthName;
    property March: String Index 3 Read GetMonthName Write SetMonthName;
    property April: String Index 4 Read GetMonthName Write SetMonthName;
    property May: String Index 5 Read GetMonthName Write SetMonthName;
    property June: String Index 6 Read GetMonthName Write SetMonthName;
    property July: String Index 7 Read GetMonthName Write SetMonthName;
    property August: String Index 8 Read GetMonthName Write SetMonthName;
    property September: String Index 9 Read GetMonthName Write SetMonthName;
    property October: String Index 10 Read GetMonthName Write SetMonthName;
    property November: String Index 11 Read GetMonthName Write SetMonthName;
    property December: String Index 12 Read GetMonthName Write SetMonthName;
  end;
 
  TmxCalendarButton = class(TSpeedButton)
  Private
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
  end;
 
  TmxDateSelection = class(TObject)
  private
    fDateStart: TDateTime;
    fDateEnd: TDateTime;
    fIsRange: Boolean;
    procedure SetDateEnd(const Value: TDateTime);
    procedure SetDateStart(const Value: TDateTime);
    procedure DetermineRange;
  public
    constructor Create;
    property DateStart: TDateTime read fDateStart write SetDateStart;
    property DateEnd: TDateTime read fDateEnd write SetDateEnd;
    property IsRange: Boolean read fIsRange;
  end;
 
  TmxDateSelections = class(TList)
  private
    function GetItems(Index: Integer): TmxDateSelection;
    procedure _AddItem(aDateStart, aDateEnd: TDateTime);
  protected
  public
    procedure AddDate(aDateStart: TDateTime);
    procedure AddRange(aDateStart, aDateEnd: TDateTime);
    procedure RemoveRange(aDateStart: TDateTime; aDateEnd: TDateTime = 0);
    function RangeIndex(aDate: TDateTime): Integer;
    function DateInList(aDate: TDateTime): Boolean;
    procedure RemoveDate(aDate: TDateTime; SplitRange: Boolean = True);
    property Items[Index: Integer]: TmxDateSelection read GetItems;
  end;
 
  TmxCustomCalendar = class(TCustomPanel)
  Private
    FOnGetItemStyleEvent: TmxOnGetItemStyleEvent;
    FOnGetCursor: TmxOnGetCursorEvent;
    FYear: integer;
    FMonth: integer;
    FDay: integer;
    FDateLabel: TLabel;
    FPanel_Header: TmxPanel;
    FPanel_Footer: TmxPanel;
    FPanel_Calendar: TmxPanel;
    FPanel_Days: array[0..6, 0..7] of TmxPanel;
    FYear_Plus: TmxCalendarButton;
    FYear_Minus: TmxCalendarButton;
    FMonth_Plus: TmxCalendarButton;
    FMonth_Minus: TmxCalendarButton;
    FTodayButton: TmxCalendarButton;
    FClearButton: TmxCalendarButton;
    FDayColor: TColor;
    FSelectedColor: TColor;
    FDayNameColor: TColor;
    FWeekColor: TColor;
    FTodayColor: TColor;
    FIndirectColor: TColor;
    FWeekEndColor: TColor;
    FDateFormat: string;
    FOptions: TmxCalendarOptions;
    FMessages: TmxMessages;
    FFirstDayOfWeek: TmxFirstDayOfWeek;
    FHeaderFormat: TmxHeaderFormat;
    FVersion: integer;
    FSelectedFont: TFont;
    FTodayFont: TFont;
    FDayFont: TFont;
    FIndirectFont: TFont;
    FWeekDaysFont: TFont;
    FWeeksFont: TFont;
    FWeekEndFont: TFont;
    FSelections: TmxDateSelections;
    FSelectionStart: TDateTime;
    FSelectionEnd: TDateTime;
    FCursor: TCursor;
 
    procedure SetVersion(AValue: string);
    function GetVersion: string;
 
    procedure SetCursor(AValue: TCursor);
    procedure SetSelectedColor(AValue: TColor);
    procedure SetWeekEndColor(AValue: TColor);
    procedure SetDayColor(AValue: TColor);
    procedure SetWeekColor(AValue: TColor);
    procedure SetTodayColor(AValue: TColor);
    procedure SetDayNameColor(AValue: TColor);
    procedure SetHeaderColor(AValue: TColor);
    procedure SetFooterColor(AValue: TColor);
    procedure SetIndirectColor(AValue: TColor);
    function GetHeaderColor: TColor;
    function GetFooterColor: TColor;
 
    procedure SetOptions(AValue: TmxCalendarOptions);
    procedure SetWeekDaysFont(AValue: TFont);
    procedure SetIndirectFont(AValue: TFont);
    procedure SetWeeksFont(AValue: TFont);
    procedure SetWeekEndFont(AValue: TFont);
    function GetDateLabelFont: TFont;
    procedure SetDateLabelFont(AValue: TFont);
    procedure SetSelectedFont(AValue: TFont);
    procedure SetTodayFont(AValue: TFont);
    procedure SetDayFont(AValue: TFont);
 
    procedure SetDateFormat(AValue: string);
 
    function GetClearButtonGlyph: TBitmap;
    procedure SetClearButtonGlyph(AValue: TBitmap);
    function GetTodayButtonGlyph: TBitmap;
    procedure SetTodayButtonGlyph(AValue: TBitmap);
    function GetYearMinusGlyph: TBitmap;
    procedure SetYearMinusGlyph(AValue: TBitmap);
    function GetYearPlusGlyph: TBitmap;
    procedure SetYearPlusGlyph(AValue: TBitmap);
    function GetMonthMinusGlyph: TBitmap;
    procedure SetMonthMinusGlyph(AValue: TBitmap);
    function GetMonthPlusGlyph: TBitmap;
    procedure SetMonthPlusGlyph(AValue: TBitmap);
    procedure SetFirstDayOfWeek(AValue: TmxFirstDayOfWeek);
 
    procedure SetYear(AValue: integer);
    procedure SetMonth(AValue: integer);
    procedure SetDay(AValue: integer);
    procedure _SetDate(AValue: TDateTime);
    procedure SetDate(AValue: TDateTime);
    function GetDate: TDateTime;
 
    procedure SetHeaderFormat(AValue: TmxHeaderFormat);
 
{$IFDEF DELPHI4_UP}
    Procedure CMBorderChanged( Var Message: TMessage ); Message CM_BORDERCHANGED;
 
 
{$ENDIF}
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
 
  Protected
 
    procedure SetPanelColor(APanel: TmxPanel; AYear, AMonth: integer); virtual;
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
    procedure CreateParams(var Params: TCreateParams); override;
 
    procedure OnChangeMessages(Sender: TObject);
    procedure OnResizePanels(Sender: TObject);
    procedure OnCanResizePanels(Sender: TObject; var NewWidth, NewHeight: integer;
      var Resize: boolean);
    procedure SetButtonPositions;
    procedure SetButtonCaptions;
    procedure Loaded; override;
    procedure RepaintCalendar; virtual;
    function SetWeekStart(ADayIndex: integer): integer;
    procedure DoClick(Sender: TObject);
    procedure DoDblClick(Sender: TObject);
    procedure YearButtonClick(Sender: TObject);
    procedure MonthButtonClick(Sender: TObject);
    procedure TodayButtonClick(Sender: TObject);
    procedure ClearButtonClick(Sender: TObject);
 
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer); virtual;
    procedure SetSelectionStart(AValue: TDateTime);
    procedure SetSelectionEnd(AValue: TDateTime);
 
    procedure Paint; override;
    procedure DoGetCursor(ItemType: TmxItemType; var ACursor: TCursor); virtual;
    procedure DoGetItemStyle(ItemStyle: TmxStyleType; ADate: TDate;
      var AFont: TFont; var AColor: TColor); virtual;
 
    // *** Published ***
 
    property Year: integer Read FYear Write SetYear;
    property Month: integer Read FMonth Write SetMonth;
    property Day: integer Read FDay Write SetDay;
    property DateFormat: string Read FDateFormat Write SetDateFormat;
 
    property OnGetItemStyle: TmxOnGetItemStyleEvent
      Read FOnGetItemStyleEvent Write FOnGetItemStyleEvent;
    property OnGetCursor: TmxOnGetCursorEvent Read FOnGetCursor Write FOnGetCursor;
    property Cursor: TCursor Read FCursor Write SetCursor;
    property DayColor: TColor Read FDayColor Write SetDayColor;
    property WeekEndColor: TColor Read FWeekEndColor Write SetWeekEndColor;
    property SelectedColor: TColor Read FSelectedColor Write SetSelectedColor;
    property DayNameColor: TColor Read FDayNameColor Write SetDayNameColor;
    property WeekColor: TColor Read FWeekColor Write SetWeekColor;
    property TodayColor: TColor Read FTodayColor Write SetTodayColor;
    property IndirectColor: TColor Read FIndirectColor Write SetIndirectColor;
    property HeaderColor: TColor Read GetHeaderColor Write SetHeaderColor;
    property FooterColor: TColor Read GetFooterColor Write SetFooterColor;
    property Options: TmxCalendarOptions Read FOptions Write SetOptions;
    property Messages: TmxMessages Read FMessages Write FMessages;
    property SelectedFont: TFont Read FSelectedFont Write SetSelectedFont;
    property DayFont: TFont Read FDayFont Write SetDayFont;
    property TodayFont: TFont Read FTodayFont Write SetTodayFont;
    property WeeksFont: TFont Read FWeeksFont Write SetWeeksFont;
    property WeekEndFont: TFont Read FWeekEndFont Write SetWeekEndFont;
    property DateLabelFont: TFont Read GetDateLabelFont Write SetDateLabelFont;
    property WeekDaysFont: TFont Read FWeekDaysFont Write SetWeekDaysFont;
    property IndirectFont: TFont Read FIndirectFont Write SetIndirectFont;
    property ClearButtonGlyph: TBitmap Read GetClearButtonGlyph
      Write SetClearButtonGlyph;
    property TodayButtonGlyph: TBitmap Read GetTodayButtonGlyph
      Write SetTodayButtonGlyph;
    property YearMinusGlyph: TBitmap Read GetYearMinusGlyph Write SetYearMinusGlyph;
    property YearPlusGlyph: TBitmap Read GetYearPlusGlyph Write SetYearPlusGlyph;
    property MonthMinusGlyph: TBitmap Read GetMonthMinusGlyph Write SetMonthMinusGlyph;
    property MonthPlusGlyph: TBitmap Read GetMonthPlusGlyph Write SetMonthPlusGlyph;
    property HeaderFormat: TmxHeaderFormat Read FHeaderFormat
      Write SetHeaderFormat Default hfMMMMYYYY;
    property FirstDayOfWeek: TmxFirstDayOfWeek
      Read FFirstDayOfWeek Write SetFirstDayOfWeek Default fdMonday;
 
  Public
 
    property Date: TDateTime Read GetDate Write SetDate;
    property Selections: TmxDateSelections read fSelections;
    property SelectionStart: TDateTime Read FSelectionStart;
    property SelectionEnd: TDateTime Read FSelectionEnd;
 
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
 
    procedure ClearSelection;
 
    function DaysInMonth(AYear, AMonth: integer): integer;
    function WeeksInYear(AYear: integer): integer;
    function MonthToWeek(AMonth: integer): integer;
 
  Published
    property Version: string Read GetVersion Write SetVersion;
  end;
 
  TmxCalendar = class(TmxCustomCalendar)
  Public
    property DockManager;
  Published
    property OnGetItemStyle;
    property OnGetCursor;
    property Align;
    property Anchors;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderWidth;
    property BorderStyle;
    property Cursor;
    property Color;
    property Constraints;
    property Ctl3D;
    property UseDockManager Default true;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ParentColor;
    property ParentCtl3D;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
 
    property Year;
    property Month;
    property Day;
    property DateFormat;
    property DayColor;
    property WeekEndColor;
    property SelectedColor;
    property DayNameColor;
    property WeekColor;
    property TodayColor;
    property IndirectColor;
    property HeaderColor;
    property FooterColor;
    property Options;
    property Messages;
    property SelectedFont;
    property DayFont;
    property TodayFont;
    property WeeksFont;
    property WeekEndFont;
    property DateLabelFont;
    property WeekDaysFont;
    property IndirectFont;
    property ClearButtonGlyph;
    property TodayButtonGlyph;
    property YearMinusGlyph;
    property YearPlusGlyph;
    property MonthMinusGlyph;
    property MonthPlusGlyph;
    property HeaderFormat;
    property FirstDayOfWeek;
    property Selections;
  end;
 
implementation
 
constructor TmxPanel.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csAcceptsControls];
  FFlat:=False;
end;
 
procedure TmxPanel.WMSize(var Message: TWMSize);
begin
  inherited;
  Invalidate;
end;
 
procedure TmxPanel.SetFlat( AValue: boolean );
Begin
  If FFlat <> AValue Then
  Begin
    FFlat:=AValue;
    Invalidate;
  End;
End;
 
procedure TmxPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);
end;
 
procedure TmxPanel.Paint;
var
  Flags: longint;
  X:     integer;
  CalcRect, ARect: TRect;
begin
  inherited;
  ARect := ClientRect;
 
  Canvas.Pen.Style   := psSolid;
  Canvas.Pen.Mode    := pmCopy;
  Canvas.Pen.Color   := clWindowFrame;
  Canvas.Pen.Width   := 1;
  Canvas.Brush.Color := clBtnFace;
  Canvas.Brush.Style := bsClear;
 
  If Not FFlat Then
    Frame3D(Canvas, ARect, clBtnHighlight, clBtnShadow, 1);
 
  Canvas.Font.Assign(Font);
  CalcRect := ARect;
  Flags    := DrawTextBiDiModeFlags(DT_EXPANDTABS or DT_CENTER);
{$WARNINGS OFF}
  DrawText(Canvas.Handle, pchar(Text), Length(Text), CalcRect,
    Flags or DT_CALCRECT);
{$WARNINGS ON}
 
  X := CalcRect.Bottom - CalcRect.Top;
  if (ARect.Bottom - ARect.Top) > X then
  begin
    ARect.Top    := ARect.Top + ((ARect.Bottom - ARect.Top - X) div 2);
    ARect.Bottom := ARect.Top + (CalcRect.Bottom - CalcRect.Top);
{$WARNINGS OFF}
    DrawText(Canvas.Handle, pchar(Text), Length(Text), ARect, Flags);
{$WARNINGS ON}
  end;
end;
 
{TmxHints}
 
constructor TmxHints.Create;
begin
  inherited Create;
  FHints[0] := 'Go to next month';
  FHints[1] := 'Go to previous month';
  FHints[2] := 'Go to next year';
  FHints[3] := 'Go to previous year';
  FHints[4] := 'Set date to today';
  FHints[5] := 'This date is today';
  FHints[6] := 'Clear date selection';
end;
 
procedure TmxHints.Assign(Source: TPersistent);
var
  I: integer;
begin
  if Source is TmxHints then
  begin
    for I := 0 to 6 do
      FHints[I] := TmxHints(Source).Hints[I];
  end
  else
    inherited Assign(Source);
end;
 
function TmxHints.GetHint(Index: integer): String;
begin
  Result := FHints[Index];
end;
 
procedure TmxHints.SetHint(Index: integer; AValue: String);
begin
  if FHints[Index] <> AValue then
  begin
    FHints[Index] := AValue;
    Change;
  end;
end;
 
procedure TmxHints.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;
 
{TmxMessages}
 
constructor TmxMessages.Create;
var
  I: integer;
begin
  inherited Create;
  FMessages[0] := 'CW';
  for I := 1 to 7 do
    FMessages[I] := ShortDayNames[I];
  for I := 1 to 12 do
    FMonthNames[I] := LongMonthNames[I];
  Hints := TmxHints.Create;
end;
 
destructor TmxMessages.Destroy;
begin
  FHints.Free;
  inherited Destroy;
end;
 
procedure TmxMessages.Assign(Source: TPersistent);
var
  I: integer;
begin
  if Source is TmxMessages then
  begin
    for I := 0 to 7 do
      FMessages[I] := TmxMessages(Source).Messages[I];
    for I := 1 to 12 do
      FMonthNames[I] := TmxMessages(Source).MonthNames[I];
 
    FHints.Assign(TmxMessages(Source).Hints);
  end
  else
    inherited Assign(Source);
end;
 
function TmxMessages.GetMessage(Index: integer): String;
begin
  Result := FMessages[Index];
end;
 
procedure TmxMessages.SetMessage(Index: integer; AValue: String);
begin
  if FMessages[Index] <> AValue then
  begin
    FMessages[Index] := AValue;
    Change;
  end;
end;
 
function TmxMessages.GetMonthName(Index: integer): String;
begin
  Result := FMonthNames[Index];
end;
 
procedure TmxMessages.SetOnChange(AOnChange: TNotifyEvent);
begin
  FOnChange := AOnChange;
  FHints.OnChange := AOnChange;
end;
 
procedure TmxMessages.SetMonthName(Index: integer; AValue: String);
begin
  if FMonthNames[Index] <> AValue then
  begin
    FMonthNames[Index] := AValue;
    Change;
  end;
end;
 
procedure TmxMessages.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;
 
{TmxCalendarButton}
 
procedure TmxCalendarButton.CMDesignHitTest(var Msg: TCMDesignHitTest);
begin
  if Parent.CanFocus and
    PtInRect(Rect(0, 0, Width, Height), SmallPointToPoint(Msg.Pos)) then
    Msg.Result := 1;
end;
 
{TmxCustomCalendar}
 
constructor TmxCustomCalendar.Create(AOwner: TComponent);
var
  I, X: byte;
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csSetCaption];
 
  Height  := 230;
  Width   := 250;
  Caption := '';
 
  BorderWidth := 1;
  BevelInner  := bvNone;
  BevelOuter  := bvLowered;
 
  OnResize    := OnResizePanels;
  OnCanResize := OnCanResizePanels;
 
  FIndirectColor := Color;
  FSelectedColor := clNavy;
  FDayColor      := clYellow;
  FDayNameColor  := $00FF8000;
  FWeekColor     := $00FF8000;
  FTodayColor    := $004080FF;
 
  FOptions := [
    coShowDateLabel,
    coShowHeader,
    coShowFooter,
    coShowWeekDays,
    coShowWeeks,
    coFlatButtons,
    coTransparentButtons,
    coYearButtonVisible,
    coMonthButtonVisible,
    coTodayButtonVisible,
    csUseWeekEndFont,
    csUseWeekEndColor,
    coShowNextMonth,
    coShowPreviousMonth
    ];
 
  Messages := TmxMessages.Create;
  Messages.OnChange := OnChangeMessages;
 
  FSelectedFont := TFont.Create;
  FSelectedFont.Color := clWhite;
  FSelectedFont.OnChange := OnChangeMessages;
 
  FTodayFont := TFont.Create;
  FTodayFont.OnChange := OnChangeMessages;
 
  FIndirectFont := TFont.Create;
  FIndirectFont.OnChange := OnChangeMessages;
 
  FDayFont := TFont.Create;
  FDayFont.OnChange := OnChangeMessages;
 
  FWeekDaysFont := TFont.Create;
  FWeekDaysFont.Color := clWhite;
  FWeekDaysFont.OnChange := OnChangeMessages;
 
  FWeeksFont := TFont.Create;
  FWeeksFont.Color := clWhite;
  FWeeksFont.OnChange := OnChangeMessages;
 
  FWeekEndFont := TFont.Create;
  FWeekEndFont.Color := clBlack;
  FWeekEndFont.OnChange := OnChangeMessages;
 
  FWeekEndColor := clAqua;
 
  FFirstDayOfWeek := fdMonday;
  FHeaderFormat   := hfMMMMYYYY;
 
  FDateFormat := 'dd.mm.yyyy';
 
  FPanel_Header := TmxPanel.Create(Self);
  with FPanel_Header do
  begin
    Parent     := Self;
    Height     := 26;
    Align      := alTop;
    Alignment  := taCenter;
    BevelInner := bvNone;
    BevelOuter := bvRaised;
    Font.Style := [fsBold];
    OnClick    := DoClick;
    OnDblClick := DoDblClick;
  end;
 
  FPanel_Footer := TmxPanel.Create(Self);
  with FPanel_Footer do
  begin
    Parent     := Self;
    Height     := 26;
    Align      := alBottom;
    Alignment  := taCenter;
    BevelInner := bvNone;
    BevelOuter := bvRaised;
    OnClick    := DoClick;
    OnDblClick := DoDblClick;
  end;
 
  FDateLabel := TLabel.Create(Self);
  with FDateLabel do
  begin
    Parent := FPanel_Footer;
    Left   := 3;
    Font.Style := [fsBold];
    SetDateLabelFont(Font);
    OnClick    := DoClick;
    OnDblClick := DoDblClick;
  end;
 
  FPanel_Calendar := TmxPanel.Create(Self);
  with FPanel_Calendar do
  begin
    Parent  := Self;
    Top     := FPanel_Header.Top + FPanel_Header.Height + 1;
    Align   := alClient;
    Alignment := taCenter;
    BevelInner := bvNone;
    BevelOuter := bvRaised;
    ParentColor := true;
    OnClick := DoClick;
    OnDblClick := DoDblClick;
  end;
 
  FYear_Plus := TmxCalendarButton.Create(Self);
  with FYear_Plus do
  begin
    Parent  := FPanel_Header;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := '>>';
    Flat    := true;
    OnClick := YearButtonClick;
  end;
 
  FYear_Minus := TmxCalendarButton.Create(Self);
  with FYear_Minus do
  begin
    Parent  := FPanel_Header;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := '<<';
    Flat    := true;
    OnClick := YearButtonClick;
  end;
 
  FMonth_Plus := TmxCalendarButton.Create(Self);
  with FMonth_Plus do
  begin
    Parent  := FPanel_Header;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := '>';
    Flat    := true;
    OnClick := MonthButtonClick;
  end;
 
  FMonth_Minus := TmxCalendarButton.Create(Self);
  with FMonth_Minus do
  begin
    Parent  := FPanel_Header;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := '<';
    Flat    := true;
    OnClick := MonthButtonClick;
  end;
 
  FTodayButton := TmxCalendarButton.Create(Self);
  with FTodayButton do
  begin
    Parent  := FPanel_Footer;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := 'T';
    Flat    := true;
    OnClick := TodayButtonClick;
  end;
 
  FClearButton := TmxCalendarButton.Create(Self);
  with FClearButton do
  begin
    Parent  := FPanel_Footer;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := 'C';
    Flat    := true;
    Visible := false;
    OnClick := ClearButtonClick;
  end;
 
  for I := 0 to 6 do
  begin
    for X := 0 to 7 do
    begin
      FPanel_Days[I, X] := TmxPanel.Create(Self);
      with FPanel_Days[I, X] do
      begin
        Parent    := FPanel_Calendar;
        Alignment := taCenter;
 
        if I = 0 then
          Color := FWeekColor
        else if X = 0 then
          Color := DayNameColor
        else
          Color := FDayColor;
 
        if (X <> 0) and (I <> 0) then
        begin
          OnMouseDown := DoMouseDown;
          OnClick     := DoClick;
          OnDblClick  := DoDblClick;
        end;
      end;
    end;
  end;
 
  FSelectionStart := 0;
  FSelectionEnd   := 0;
  FSelections := TmxDateSelections.Create;
 
  _SetDate(SysUtils.Date);
 
  FVersion := mxCalendarVersion;
end;
 
destructor TmxCustomCalendar.Destroy;
var
  I, X: byte;
begin
  FSelections.Free;
  FDateLabel.Free;
  FMessages.Free;
  FSelectedFont.Free;
  FTodayFont.Free;
  FDayFont.Free;
  FWeekDaysFont.Free;
  FWeeksFont.Free;
  FWeekEndFont.Free;
  FIndirectFont.Free;
 
  for I := 0 to 6 do
    for X := 0 to 7 do
      FPanel_Days[I, X].Free;
 
  FYear_Plus.Free;
  FYear_Minus.Free;
  FMonth_Plus.Free;
  FMonth_Minus.Free;
  FPanel_Calendar.Free;
  FPanel_Header.Free;
  FPanel_Footer.Free;
 
  inherited Destroy;
end;
 
procedure TmxCustomCalendar.Loaded;
begin
  inherited;
 
     {Try
        EncodeDate( FYear, FMonth, FDay );
     Except
        Date:=Now;
     End;}
 
  SetYearPlusGlyph(FYear_Plus.Glyph);
  SetYearMinusGlyph(FYear_Minus.Glyph);
  SetMonthPlusGlyph(FMonth_Plus.Glyph);
  SetMonthMinusGlyph(FMonth_Minus.Glyph);
  SetTodayButtonGlyph(FTodayButton.Glyph);
  SetClearButtonGlyph(FClearButton.Glyph);
 
  if csSetTodayOnStartup in FOptions then
    _SetDate(SysUtils.Date);
 
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.SetVersion(AValue: string);
begin
    // *** Does nothing ***
end;
 
function TmxCustomCalendar.GetVersion: string;
begin
{$WARNINGS OFF}
  Result := Format('%d.%d', [Hi(FVersion), Lo(FVersion)]);
{$WARNINGS ON}
end;
 
procedure TmxCustomCalendar.SetButtonCaptions;
var
  X, I, Y: shortint;
begin
  FPanel_Days[0, 0].Caption := Messages[0];
  for I := 0 to 6 do
  begin
    FPanel_Days[I, 0].Font.Assign(FWeeksFont);
  end;
                          
  X := byte(FFirstDayOfWeek);
  Y := 0;
 
  for I := X to 6 do
  begin
    Inc(Y);
    FPanel_Days[0, Y].Caption := Messages[I + 1];
    FPanel_Days[0, Y].Font.Assign(FWeekDaysFont);
  end;
 
  for I := 0 to X - 1 do
  begin
    Inc(Y);
    FPanel_Days[0, Y].Caption := Messages[I + 1];
    FPanel_Days[0, Y].Font.Assign(FWeekDaysFont);
  end;
 
  FMonth_Minus.Hint := FMessages.Hints[1];
  FMonth_Plus.Hint  := FMessages.Hints[0];
  FYear_Minus.Hint  := FMessages.Hints[3];
  FYear_Plus.Hint   := FMessages.Hints[2];
  FTodayButton.Hint := FMessages.Hints[4];
  FClearButton.Hint := FMessages.Hints[6];
end;
 
procedure TmxCustomCalendar.SetButtonPositions;
var
  I, X: byte;
  PanelHeight: integer;
  PanelWidth: integer;
  DifferenceWidth: byte;
  DifferenceHeight: byte;
  NumberOfRows: byte;
  NumberOfCols: byte;
  Correction: byte;
  ButtonPosition: integer;
begin
  ButtonPosition := FPanel_Footer.ClientWidth - FTodayButton.ClientWidth - 3;
  if not FTodayButton.Visible then
    ButtonPosition := -100;
  FTodayButton.Left := ButtonPosition;
 
  ButtonPosition := FTodayButton.Left - FClearButton.Width - 3;
  if not FClearButton.Visible then
    ButtonPosition := -100;
  FClearButton.Left := ButtonPosition;
 
  ButtonPosition := FPanel_Header.ClientWidth - FYear_Plus.ClientWidth - 3;
  if not FYear_Plus.Visible then
    ButtonPosition := -100;
  FYear_Plus.Left := ButtonPosition;
 
  ButtonPosition := 3;
  if not FYear_Minus.Visible then
    ButtonPosition := -100;
  FYear_Minus.Left := ButtonPosition;
 
  if FYear_Plus.Visible then
    ButtonPosition := FYear_Plus.Left - FMonth_Plus.Width - 2
  else
    ButtonPosition := FPanel_Header.ClientWidth - FMonth_Plus.ClientWidth - 3;
 
  if not FMonth_Plus.Visible then
    ButtonPosition := -100;
  FMonth_Plus.Left := ButtonPosition;
 
  if FYear_Minus.Visible then
    ButtonPosition := FYear_Minus.Left + FYear_Minus.Width + 2
  else
    ButtonPosition := 3;
 
  if not FMonth_Minus.Visible then
    ButtonPosition := -100;
  FMonth_Minus.Left := ButtonPosition;
 
  NumberOfRows := 7;
  NumberOfCols := 8;
 
  if not (coShowWeeks in Options) then
    Dec(NumberOfCols);
  if not (coShowWeekDays in Options) then
    Dec(NumberOfRows);
 
  PanelHeight := FPanel_Calendar.ClientHeight div NumberOfRows;
  PanelWidth  := FPanel_Calendar.ClientWidth div NumberOfCols;
 
  DifferenceHeight := ((FPanel_Calendar.ClientHeight) mod NumberOfRows) div 2;
  DifferenceWidth  := ((FPanel_Calendar.ClientWidth) mod NumberOfCols) div 2;
 
  for I := 0 to 6 do
  begin
    for X := 0 to 7 do
    begin
      with FPanel_Days[I, X] do
      begin
        Width  := PanelWidth;
        Height := PanelHeight;
 
        if (coShowWeeks in Options) then
          Correction := 0
        else
          Correction := 1;
 
        if (coShowWeeks in Options) or
          ( not (coShowWeeks in Options) and (X <> 0)) then
          Left := ((X - Correction) * PanelWidth) + DifferenceWidth
        else
          Left := -100;
 
        if (coShowWeekDays in Options) then
          Correction := 0
        else
          Correction := 1;
 
        if (coShowWeekDays in Options) or
          ( not (coShowWeekDays in Options) and (I <> 0)) then
          Top := ((I - Correction) * PanelHeight) + DifferenceHeight
        else
          Top := -100;
      end;
    end;
  end;
end;
 
procedure TmxCustomCalendar.OnResizePanels(Sender: TObject);
begin
  SetButtonPositions;
end;
 
procedure TmxCustomCalendar.OnChangeMessages(Sender: TObject);
begin
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.OnCanResizePanels(Sender: TObject;
  var NewWidth, NewHeight: integer; var Resize: boolean);
begin
  if NewWidth < (NavigateButtonWidth * 4) + 6 then
  begin
    NewWidth := (NavigateButtonWidth * 4) + 16;
    Resize   := true;
  end;
end;
 
{$IFDEF DELPHI4_UP}
 
Procedure TmxCustomCalendar.CMBorderChanged( Var Message: TMessage );
Begin
     Inherited;
     RepaintCalendar;
End;
 
{$ENDIF}
 
procedure TmxCustomCalendar.CMCtl3DChanged(var Message: TMessage);
begin
  if NewStyleControls and (BorderStyle = bsSingle) then
    RecreateWnd;
  inherited;
end;
 
procedure TmxCustomCalendar.CMSysColorChange(var Message: TMessage);
begin
  inherited;
  if not (csLoading in ComponentState) then
  begin
    Message.Msg := WM_SYSCOLORCHANGE;
    DefaultHandler(Message);
  end;
end;
 
procedure TmxCustomCalendar.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.CMColorChanged(var Message: TMessage);
begin
  inherited;
  RecreateWnd;
end;
 
procedure TmxCustomCalendar.CMFontChanged(var Msg: TMessage);
begin
  inherited;
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[BorderStyle];
    if NewStyleControls and Ctl3D and (BorderStyle = bsSingle) then
    begin
      Style   := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
    WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);
  end;
end;
 
procedure TmxCustomCalendar.DoGetItemStyle(ItemStyle: TmxStyleType;
  ADate: TDate; var AFont: TFont; var AColor: TColor);
begin
  if assigned(FOnGetItemStyleEvent) then
    FOnGetItemStyleEvent(Self, ItemStyle, ADate, AFont, AColor);
end;
 
procedure TmxCustomCalendar.DoGetCursor(ItemType: TmxItemType; var ACursor: TCursor);
begin
  if assigned(FOnGetCursor) then
    FOnGetCursor(Self, ItemType, ACursor);
end;
 
procedure TmxCustomCalendar.Paint;
begin
  inherited;
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.SetSelectedColor(AValue: TColor);
begin
  if FSelectedColor <> AValue then
  begin
    FSelectedColor := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetWeekEndColor(AValue: TColor);
begin
  if FWeekEndColor <> AValue then
  begin
    FWeekEndColor := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetHeaderColor(AValue: TColor);
begin
  if FPanel_Header.Color <> AValue then
    FPanel_Header.Color := AValue;
end;
 
function TmxCustomCalendar.GetHeaderColor: TColor;
begin
  Result := FPanel_Header.Color;
end;
 
procedure TmxCustomCalendar.SetFooterColor(AValue: TColor);
begin
  if FPanel_Footer.Color <> AValue then
    FPanel_Footer.Color := AValue;
end;
 
function TmxCustomCalendar.GetFooterColor: TColor;
begin
  Result := FPanel_Footer.Color;
end;
 
procedure TmxCustomCalendar.SetDayNameColor(AValue: TColor);
var
  I: byte;
begin
  if FDayNameColor <> AValue then
  begin
    FDayNameColor := AValue;
    for I := 1 to 7 do
      FPanel_Days[0, I].Color := FDayNameColor;
  end;
end;
 
procedure TmxCustomCalendar.SetWeekColor(AValue: TColor);
var
  I: byte;
begin
  if FWeekColor <> AValue then
  begin
    FWeekColor := AValue;
    for I := 0 to 6 do
      FPanel_Days[I, 0].Color := FWeekColor;
  end;
end;
 
procedure TmxCustomCalendar.SetTodayColor(AValue: TColor);
begin
  if FTodayColor <> AValue then
  begin
    FTodayColor := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetIndirectColor(AValue: TColor);
begin
  if FIndirectColor <> AValue then
  begin
    FIndirectColor := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetCursor(AValue: TCursor);
begin
  if FCursor <> AValue then
  begin
    FCursor := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetDayColor(AValue: TColor);
var
  I, X: byte;
begin
  if FDayColor <> AValue then
  begin
    FDayColor := AValue;
 
    for I := 1 to 6 do
    begin
      for X := 1 to 7 do
      begin
        FPanel_Days[I, X].Color := FDayColor;
      end;
    end;
 
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetOptions(AValue: TmxCalendarOptions);
var
  X, Y: integer;
begin
  if FOptions <> AValue then
  begin
    FOptions := AValue;
 
    if not (coShowHeader in Options) then
    begin
      FPanel_Header.Align := alNone;
      FPanel_Header.Top   := -1000;
    end
    else
      FPanel_Header.Align := alTop;
 
    if not (coShowFooter in Options) then
    begin
      FPanel_Footer.Align := alNone;
      FPanel_Footer.Top   := -1000;
    end
    else
      FPanel_Footer.Align := alBottom;
 
    FYear_Plus.Flat   := coFlatButtons in FOptions;
    FYear_Minus.Flat  := coFlatButtons in FOptions;
    FMonth_Plus.Flat  := coFlatButtons in FOptions;
    FMonth_Minus.Flat := coFlatButtons in FOptions;
    FTodayButton.Flat := coFlatButtons in FOptions;
 
    FYear_Plus.Transparent   := coTransparentButtons in FOptions;
    FYear_Minus.Transparent  := coTransparentButtons in FOptions;
    FMonth_Plus.Transparent  := coTransparentButtons in FOptions;
    FMonth_Minus.Transparent := coTransparentButtons in FOptions;
 
    FYear_Plus.Visible   := coYearButtonVisible in FOptions;
    FYear_Minus.Visible  := coYearButtonVisible in FOptions;
    FMonth_Plus.Visible  := coMonthButtonVisible in FOptions;
    FMonth_Minus.Visible := coMonthButtonVisible in FOptions;
    FTodayButton.Visible := coTodayButtonVisible in FOptions;
    FClearButton.Visible := coClearButtonVisible in FOptions;
 
    SetDateLabelFont(FDateLabel.Font);
 
    for X := 1 to 6 do
      for Y := 1 to 7 do
        FPanel_Days[X, Y].Flat:=csFlatDays in FOptions;
 
    for X := 0 to 6 do
      FPanel_Days[X, 0].Flat:=coFlatHeaders in FOptions;
 
    for Y := 1 to 7 do
      FPanel_Days[0,Y].Flat:=coFlatHeaders in FOptions;
 
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetWeekDaysFont(AValue: TFont);
begin
  FWeekDaysFont.Assign(AValue);
end;
 
procedure TmxCustomCalendar.SetIndirectFont(AValue: TFont);
begin
  FIndirectFont.Assign(AValue);
end;
 
procedure TmxCustomCalendar.SetSelectedFont(AValue: TFont);
begin
  FSelectedFont.Assign(AValue);
end;
 
procedure TmxCustomCalendar.SetTodayFont(AValue: TFont);
begin
  FTodayFont.Assign(AValue);
end;
 
function TmxCustomCalendar.GetDateLabelFont: TFont;
begin
  Result := FDateLabel.Font;
end;
 
procedure TmxCustomCalendar.SetDateLabelFont(AValue: TFont);
begin
  FDateLabel.Font.Assign(AValue);
 
  if coShowDateLabel in FOptions then
    FDateLabel.Top := (FPanel_Footer.Height - FDateLabel.Height) div 2
  else
    FDateLabel.Top := -100;
end;
 
procedure TmxCustomCalendar.SetDayFont(AValue: TFont);
begin
  FDayFont.Assign(AValue);
end;
 
procedure TmxCustomCalendar.SetWeeksFont(AValue: TFont);
begin
  FWeeksFont.Assign(AValue);
end;
 
procedure TmxCustomCalendar.SetWeekEndFont(AValue: TFont);
begin
  FWeekEndFont.Assign(AValue);
end;
 
function TmxCustomCalendar.GetYearMinusGlyph: TBitmap;
begin
  Result := FYear_Minus.Glyph;
end;
 
procedure TmxCustomCalendar.SetYearMinusGlyph(AValue: TBitmap);
begin
  with FYear_Minus do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := '<<'
    else
      Caption := '';
  end;
end;
 
function TmxCustomCalendar.GetTodayButtonGlyph: TBitmap;
begin
  Result := FTodayButton.Glyph;
end;
 
procedure TmxCustomCalendar.SetTodayButtonGlyph(AValue: TBitmap);
begin
  with FTodayButton do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := 'T'
    else
      Caption := '';
  end;
end;
 
function TmxCustomCalendar.GetClearButtonGlyph: TBitmap;
begin
  Result := FClearButton.Glyph;
end;
 
procedure TmxCustomCalendar.SetClearButtonGlyph(AValue: TBitmap);
begin
  with FClearButton do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := 'C'
    else
      Caption := '';
  end;
end;
 
function TmxCustomCalendar.GetYearPlusGlyph: TBitmap;
begin
  Result := FYear_Plus.Glyph;
end;
 
procedure TmxCustomCalendar.SetYearPlusGlyph(AValue: TBitmap);
begin
  with FYear_Plus do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := '>>'
    else
      Caption := '';
  end;
end;
 
function TmxCustomCalendar.GetMonthMinusGlyph: TBitmap;
begin
  Result := FMonth_Minus.Glyph;
end;
 
procedure TmxCustomCalendar.SetMonthMinusGlyph(AValue: TBitmap);
begin
  with FMonth_Minus do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := '<'
    else
      Caption := '';
  end;
end;
 
function TmxCustomCalendar.GetMonthPlusGlyph: TBitmap;
begin
  Result := FMonth_Plus.Glyph;
end;
 
procedure TmxCustomCalendar.SetMonthPlusGlyph(AValue: TBitmap);
begin
  with FMonth_Plus do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := '>'
    else
      Caption := '';
  end;
end;
 
procedure TmxCustomCalendar.SetFirstDayOfWeek(AValue: TmxFirstDayOfWeek);
begin
  if FFirstDayOfWeek <> AValue then
  begin
    FFirstDayOfWeek := AValue;
    RecreateWnd;
  end;
end;
 
function TmxCustomCalendar.DaysInMonth(AYear, AMonth: integer): integer;
const
  NumberOfDays: array[1..12] of integer =
    (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  Result := 0;
  if not (AMonth in [1..12]) then
    Exit;
  Result := NumberOfDays[AMonth];
  if (AMonth = 2) and IsLeapYear(AYear) then
    Inc(Result);
end;
 
function TmxCustomCalendar.MonthToWeek(AMonth: integer): integer;
var
  I, _DayOfWeek: integer;
begin
  Result := 0;
  for I := 1 to FMonth - 1 do
    Inc(Result, DaysInMonth(FYear, I));
 
  _DayOfWeek := SetWeekStart(DayOfWeek(EncodeDate(FYear, 1, 1)));
  if _DayOfWeek > 4 then
    Dec(Result, 7 - _DayOfWeek)
  else
    Inc(Result, _DayOfWeek - 1);
 
  Result := (Result div 7) + 1;
  if (FFirstDayOfWeek = fdSunday) and
    (DayOfWeek(EncodeDate(FYear, AMonth, 1)) = 7) then
    Dec(Result);
end;
 
Function TmxCustomCalendar.SetWeekStart( ADayIndex: Integer ): Integer;
Begin
     Result := ADayIndex;
     If FFirstDayOfWeek = fdMonday Then 
	If Result = 1 Then Result := 7 Else Dec( Result );
End;
 
function TmxCustomCalendar.WeeksInYear(AYear: integer): integer;
var
  _DayOfWeek: integer;
begin
  if IsLeapYear(AYear) then
    Result := 366
  else
    Result := 365;
 
  _DayOfWeek := SetWeekStart(DayOfWeek(EncodeDate(AYear, 1, 1)));
  if _DayOfWeek > 4 then
    Dec(Result, _DayOfWeek)
  else
    Inc(Result, 7 - _DayOfWeek);
 
  _DayOfWeek := SetWeekStart(DayOfWeek(EncodeDate(AYear, 12, 31)));
  if _DayOfWeek > 3 then
    Inc(Result, 7 - _DayOfWeek)
  else
    Dec(Result, _DayOfWeek);
 
  Result := Result div 7;
  if Result = 51 then
    Result := 52;
end;
 
procedure TmxCustomCalendar.SetYear(AValue: integer);
begin
  if AValue <> FYear then
  begin
    if AValue < 1900 then
      FYear := 1900
    else if AValue > 2100 then
      FYear := 2100
    else
      FYear := AValue;
 
    if not (csLoading in ComponentState) then
      RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetMonth(AValue: integer);
begin
  if AValue <> FMonth then
  begin
    if AValue < 1 then
      FMonth := 1
    else if AValue > 12 then
      FMonth := 12
    else
      FMonth := AValue;
 
    if DaysInMonth(FYear, FMonth) < FDay then
      FDay := DaysInMonth(FYear, FMonth);
 
    if not (csLoading in ComponentState) then
      RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetDay(AValue: integer);
begin
  if AValue <> FDay then
  begin
    if AValue < 1 then
      FDay := 1
    else if AValue > DaysInMonth(FYear, FMonth) then
      FDay := DaysInMonth(FYear, FMonth)
    else
      FDay := AValue;
 
    if not (csLoading in ComponentState) then
      RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar._SetDate(AValue: TDateTime);
var
  Year, Month, Day: word;
begin
  DecodeDate(AValue, Year, Month, Day);
  FYear  := Year;
  FMonth := Month;
  FDay   := Day;
end;
 
procedure TmxCustomCalendar.SetDate(AValue: TDateTime);
begin
  _SetDate(AValue);
  RepaintCalendar;
end;
 
function TmxCustomCalendar.GetDate: TDateTime;
begin
  Result := EncodeDate(FYear, FMonth, FDay);
end;
 
procedure TmxCustomCalendar.SetHeaderFormat(AValue: TmxHeaderFormat);
begin
  if AValue <> FHeaderFormat then
  begin
    FHeaderFormat := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetPanelColor(APanel: TmxPanel; AYear, AMonth: integer);
var
  PanelDate:  TDateTime;
  IsSelected: boolean;
  MonthNumber: Byte;
 
  Procedure InternalSetPanel( APanel: TmxPanel; ItemStyle: TmxStyleType );
  Var
    FFont:      TFont;
    FColor:     TColor;
  Begin
    FFont := TFont.Create;
    try
      Case ItemStyle Of
        stSelected:
          Begin
            FColor:=FSelectedColor;
            FFont.Assign( FSelectedFont );
          End;
        stToday:
          Begin
            FColor:=FTodayColor;
            FFont.Assign( FTodayFont );
          End;
        stDay:
          Begin
            FColor:=FDayColor;
            FFont.Assign( FDayFont );
          End;
        stWeekEnd:
          Begin
            if csUseWeekEndFont in FOptions then
              APanel.Font.Assign(FWeekEndFont) Else
              APanel.Font.Assign(FDayFont);
 
            if csUseWeekEndColor in FOptions then
              FColor:=FWeekEndColor Else
              FColor:=FDayColor;
          End;
        stIndirect:
          Begin
            FColor:=FIndirectColor;
            FFont.Assign( FIndirectFont );
          End;
      End;
 
      DoGetItemStyle( ItemStyle, PanelDate, FFont, FColor);
      APanel.Font.Assign(FFont);
      APanel.Color:=FColor;
    finally
      FFont.Free;
    end;
  End;
 
begin
  APanel.Tag := AMonth;
 
  PanelDate  := EncodeDate(AYear, AMonth, StrToInt(APanel.Caption));
  IsSelected := FSelections.DateInList(PanelDate);
    // (PanelDate >= Trunc(FSelectionStart)) and
    //(PanelDate <= FSelectionEnd);
 
  APanel.Hint := '';
 
  if IsSelected then
    InternalSetPanel( APanel, stSelected ) Else
    begin
      if PanelDate = SysUtils.Date then // today
      begin
        InternalSetPanel( APanel, stToday );
        APanel.Hint  := FMessages.Hints[5];
      end
      else
      begin
        if AMonth = FMonth then
        begin
          if DayOfWeek(PanelDate) in [1, 7] then
            InternalSetPanel( APanel, stWeekEnd ) Else
            InternalSetPanel( APanel, stDay );
        end
        else
        begin
          InternalSetPanel( APanel, stIndirect );
 
          MonthNumber := FMonth + 1;
          if MonthNumber > 12 then
            MonthNumber := 1;
 
          if ( not (coShowNextMonth in FOptions)) and
            (AMonth = MonthNumber) then
            APanel.Font.Color := APanel.Color;
 
          MonthNumber := FMonth - 1;
          if MonthNumber < 1 then
            MonthNumber := 12;
 
          if ( not (coShowPreviousMonth in FOptions)) and
            (AMonth = MonthNumber) then
            APanel.Font.Color := APanel.Color;
        end;
      end;
    end;
 
  APanel.Hint := 'adadaa';
 
  APanel.Invalidate;
end;
 
procedure TmxCustomCalendar.RepaintCalendar;
var
  AType:  TmxItemType;
  ACursor: TCursor;
  FirstDate: TDateTime;
  TotalDays: integer;
  WeekDay: integer;
  CurrentDay: integer;
  WeekNumber: integer;
  WeeksYear: integer;
  X, Y:   integer;
  SMonth: String;
begin
  SetButtonPositions;
  SetButtonCaptions;
 
  // *** Update View ***
 
  FirstDate := EncodeDate(FYear, FMonth, 1);
  WeekDay   := SetWeekStart(DayOfWeek(FirstDate));
  TotalDays := DaysInMonth(FYear, FMonth);
 
  If FDay > TotalDays Then FDay:=TotalDays;
 
  CurrentDay := 1;
 
  for X := 0 to 5 do
  begin
    for Y := 0 to 6 do
    begin
      if (X = 0) and (Y + 1 < WeekDay) then
      begin
        if FMonth = 1 then
        begin
          FPanel_Days[X + 1, Y + 1].Caption :=
            IntToStr(DaysInMonth(FYear - 1, 12) - WeekDay + Y + 2);
 
          SetPanelColor(FPanel_Days[X + 1, Y + 1], FYear - 1, 12);
        end
        else
        begin
          FPanel_Days[X + 1, Y + 1].Caption :=
            IntToStr(DaysInMonth(FYear, FMonth - 1) - WeekDay + Y + 2);
 
          SetPanelColor(FPanel_Days[X + 1, Y + 1], FYear, FMonth - 1);
        end;
      end
      else
      begin
        if CurrentDay > TotalDays then
        begin
          FPanel_Days[X + 1, Y + 1].Caption :=
            IntToStr(CurrentDay - TotalDays);
 
          if FMonth = 12 then
            SetPanelColor(FPanel_Days[X + 1, Y + 1], FYear + 1, 1) Else
            SetPanelColor(FPanel_Days[X + 1, Y + 1], FYear, FMonth + 1);
        end
        else
        begin
          FPanel_Days[X + 1, Y + 1].Caption := IntToStr(CurrentDay);
          SetPanelColor(FPanel_Days[X + 1, Y + 1], FYear, FMonth);
        end;
 
        Inc(CurrentDay);
      end;
    end;
  end;
 
  // *** Set Caption ***
 
  SMonth := IntToStr(FMonth);
  if Length(SMonth) = 1 then
    SMonth := '0' + SMonth;
 
  case FHeaderFormat of
    hfMMMMYYYY: FPanel_Header.Caption :=
        Format('%s, %d', [FMessages.FMonthNames[FMonth], FYear]);
    hfYYYYMMMM: FPanel_Header.Caption :=
        Format('%d, %s', [FYear, FMessages.FMonthNames[FMonth]]);
    hfMMYYYY: FPanel_Header.Caption   := Format('%s.%d', [SMonth, FYear]);
    hfYYYYMM: FPanel_Header.Caption   := Format('%d.%s', [FYear, SMonth]);
  end;
 
  FPanel_Header.Invalidate;
  // *** Set Week Numbers ***
 
  WeeksYear := WeeksInYear(FYear);
 
  for X := 0 to 5 do
  begin
    WeekNumber := MonthToWeek(FMonth) + X;
    if WeekNumber > WeeksYear then
      WeekNumber := WeekNumber - WeeksYear;
    FPanel_Days[X + 1, 0].Caption := IntToStr(WeekNumber);
  end;
 
  // *** Set Cursor
 
  ACursor := Cursor;
  DoGetCursor(itHeader, ACursor);
  FPanel_Header.Cursor := ACursor;
 
  ACursor := Cursor;
  DoGetCursor(itFooter, ACursor);
  FPanel_Footer.Cursor := ACursor;
 
  ACursor := Cursor;
  FPanel_Calendar.Cursor := ACursor;
 
  for X := 0 to 6 do
  begin
    for Y := 0 to 7 do
    begin
      ACursor := Cursor;
 
      if (X = 0) and (Y = 0) then
        AType := itCW
      else if (X = 0) and (Y <> 0) then
        AType := itWeek
      else if (X <> 0) and (Y = 0) then
        AType := itDay
      else
        AType := itCalendar;
 
      DoGetCursor(AType, ACursor);
      FPanel_Days[X, Y].Cursor := ACursor;
    end;
  end;
 
  // *** Set Label Caption ***
 
  if FSelectionStart = 0 then
  begin
    FDateLabel.Caption := FormatDateTime(FDateFormat, EncodeDate(FYear, FMonth, FDay));
  end
  else
  begin
    if FSelectionStart = FSelectionEnd then
    begin
      try
        FDateLabel.Caption := FormatDateTime(FDateFormat, FSelectionStart);
      except
        FDateLabel.Caption :=
          FormatDateTime('yyyy.mm.dd', FSelectionStart);
      end;
    end
    else
    begin
      try
        FDateLabel.Caption :=
          FormatDateTime(FDateFormat, FSelectionStart) + '-' +
          FormatDateTime(FDateFormat, FSelectionEnd);
      except
        FDateLabel.Caption :=
          FormatDateTime('yyyy.mm.dd', FSelectionStart) + '-' +
          FormatDateTime('yyyy.mm.dd', FSelectionEnd);
      end;
    end;
  end;
end;
 
procedure TmxCustomCalendar.MonthButtonClick(Sender: TObject);
begin
  if Sender = FMonth_Plus then
  begin
    if FMonth = 12 then
    begin
      Inc(FYear);
      FMonth := 1;
    end
    else
      Inc(FMonth)
  end
  else
  begin
    if FMonth = 1 then
    begin
      Dec(FYear);
      FMonth := 12;
    end
    else
      Dec(FMonth)
  end;
 
  RepaintCalendar;
  Click;
end;
 
procedure TmxCustomCalendar.DoDblClick(Sender: TObject);
begin
  DblClick;
end;
 
procedure TmxCustomCalendar.DoClick(Sender: TObject);
begin
  Click;
end;
 
procedure TmxCustomCalendar.YearButtonClick(Sender: TObject);
begin
  if Sender = FYear_Plus then
    Inc(FYear)
  else
    Dec(FYear);
  RepaintCalendar;
  Click;
end;
 
procedure TmxCustomCalendar.TodayButtonClick(Sender: TObject);
begin
  SetDate(SysUtils.Date);
  Click;
end;
 
procedure TmxCustomCalendar.ClearButtonClick(Sender: TObject);
begin
  FSelectionStart := 0;
  FSelectionEnd   := 0;
  RepaintCalendar;
  Click;
end;
 
procedure TmxCustomCalendar.SetSelectionStart(AValue: TDateTime);
begin
  //if AValue <> FSelectionStart then
  //begin
    FSelectionStart := AValue;
 
    if (FSelectionStart > FSelectionEnd) or
      (( not (csSelectionEnabled in FOptions)) and
      (FSelectionStart <> FSelectionEnd)) then
      SetSelectionEnd(FSelectionStart);
 
    _SetDate(AValue);
 
    RepaintCalendar;
  //end;
end;
 
procedure TmxCustomCalendar.SetSelectionEnd(AValue: TDateTime);
begin
  //if AValue <> FSelectionEnd then
  //begin
    FSelectionEnd := AValue;
 
    if (FSelectionEnd < FSelectionStart) or
      (( not (csSelectionEnabled in FOptions)) and
      (FSelectionStart <> FSelectionEnd)) then
      SetSelectionStart(FSelectionEnd);
 
    RepaintCalendar;
  //end;
end;
 
procedure TmxCustomCalendar.DoMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
var
  _Year:     word;
  PanelDate: TDateTime;
  APanel:    TmxPanel;
begin
  APanel := (Sender as TmxPanel);
 
  if (APanel.Tag = 12) and (FMonth = 1) then
    _Year := FYear - 1
  else if (APanel.Tag = 1) and (FMonth = 12) then
    _Year := FYear + 1
  else
    _Year := FYear;
 
  PanelDate := Trunc(EncodeDate(_Year, APanel.Tag, StrToInt(APanel.Caption)));
 
  if (ssCtrl in Shift) and not (ssShift in Shift) then // Add single date
  begin
    FSelections.AddDate(PanelDate);
    RepaintCalendar;
  end;
 
  if not (ssCtrl in Shift) and not (ssShift in Shift) then
  begin
    FSelections.Clear;
    if ssLeft in Shift then
      SetSelectionStart(PanelDate + Frac(FSelectionStart));
 
    if ssRight in Shift then
      if (csSelectionEnabled in FOptions) then
      begin
        SetSelectionEnd(PanelDate + Frac(FSelectionEnd));
      end;
  end;
end;
 
procedure TmxCustomCalendar.ClearSelection;
begin
  ClearButtonClick(Self);
end;
 
procedure TmxCustomCalendar.SetDateFormat(AValue: string);
begin
  if FDateFormat <> AValue then
  begin
    FDateFormat := AValue;
    RepaintCalendar;
  end;
end;
 
{ TmxDateSelections }
 
procedure TmxDateSelections._AddItem(aDateStart, aDateEnd: TDateTime);
var item: TmxDateSelection;
begin
  item := TmxDateSelection.Create;
  item.DateStart := aDateStart;
  item.DateEnd := aDateEnd;
  Add(item)
end;
 
procedure TmxDateSelections.AddDate(aDateStart: TDateTime);
begin
  _AddItem(aDateStart, 0);
end;
 
procedure TmxDateSelections.AddRange(aDateStart, aDateEnd: TDateTime);
begin
  _AddItem(aDateStart, aDateEnd);
end;
 
function TmxDateSelections.DateInList(aDate: TDateTime): Boolean;
begin
  Result := RangeIndex(aDate) <> -1;
end;
 
function TmxDateSelections.GetItems(Index: Integer): TmxDateSelection;
begin
  Result := TmxDateSelection(inherited Items[Index]);
end;
 
function TmxDateSelections.RangeIndex(aDate: TDateTime): Integer;
var I: integer;
  item: TmxDateSelection;
begin
  Result := -1;
  for I := 0 to Count - 1 do
  begin
    item := Items[I];
    if (item.IsRange and (Item.DateStart <= aDate) and (item.DateEnd <= aDate)) or
      (not item.IsRange and (Item.DateStart = aDate)) then
    begin
      Result := I;
      Break;
    end;
  end;
end;
 
procedure TmxDateSelections.RemoveDate(aDate: TDateTime; SplitRange: Boolean);
begin
 
end;
 
procedure TmxDateSelections.RemoveRange(aDateStart, aDateEnd: TDateTime);
begin
 
end;
 
{ TmxDateSelection }
 
constructor TmxDateSelection.Create;
begin
  inherited Create;
  fDateStart := 0;
  fDateEnd := 0;
end;
 
procedure TmxDateSelection.SetDateEnd(const Value: TDateTime);
begin
  fDateEnd := Value;
  DetermineRange;
end;
 
procedure TmxDateSelection.DetermineRange;
begin
  fIsRange := (fDateStart <> 0) and (fDateEnd <> 0)
    and (Trunc(fDateStart) <> Trunc(fDateEnd));
end;
 
procedure TmxDateSelection.SetDateStart(const Value: TDateTime);
begin
  fDateStart := Value;
  fIsRange := (fDateStart <> 0) and (fDateEnd <> 0)
    and (Trunc(fDateStart) <> Trunc(fDateEnd));
end;
 
end.

Open in new window

0
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24809270
here is a update, got most of it working

use Ctrl to select mulitple dates
 // ****************************************************************************
 // * Calendar component for Delphi.
 // ****************************************************************************
 // * Copyright 2001-2006, Bitvadász Kft. All Rights Reserved.
 // ****************************************************************************
 // * This component can be freely used and distributed in commercial and
 // * private environments, provied this notice is not modified in any way.
 // ****************************************************************************
 // * Feel free to contact me if you have any questions, comments or suggestions
 // * at support@maxcomponents.net
 // ****************************************************************************
 // * Web page: www.maxcomponents.net
 // ****************************************************************************
 
unit mxCalendar;
 
interface
 
uses
  Windows, Messages, SysUtils, StdCtrls, Classes, Graphics, Controls, ExtCtrls,
  Forms, Buttons;
 
{$I MAX.INC}
 
const
  mxCalendarVersion   = $020B;
  NavigateButtonWidth = 23;
 
type
  TmxCustomCalendar = class;
 
  TmxItemType  = (itHeader, itFooter, itCW, itWeek, itDay, itCalendar);
  TmxStyleType = (stSelected, stToday, stDay, stWeekEnd, stIndirect );
 
  TmxOnGetCursorEvent = procedure(Sender: TmxCustomCalendar;
    ItemType: TmxItemType; var ACursor: TCursor) of object;
  TmxOnGetItemStyleEvent = procedure(Sender: TmxCustomCalendar;
    AStyleType: TmxStyleType; ADate: TDate; var AFont: TFont;
    var AColor: TColor) of object;
 
  {CustomPanel to resolve the XP Theme problem}
  TmxPanel = class(TCustomControl)
  Private
    FFlat: Boolean;
    procedure SetFlat( AValue: boolean );
    procedure WMSize(var Message: TWMSize); message WM_SIZE;
  Protected
    procedure Paint; override;
    procedure CreateParams(var Params: TCreateParams); override;
  Public
    constructor Create(AOwner: TComponent); override;
    Property Flat: Boolean read FFlat Write SetFlat Default False;
  end;
 
  TmxCalendarOption = (
    coClearButtonVisible,
    coFlatButtons,
    csFlatDays,
    coFlatHeaders,
    coMonthButtonVisible,
    csSelectionEnabled,
    csMultiSelect,
    csSetTodayOnStartup,
    coShowDateLabel,
    coShowFooter,
    coShowNextMonth,
    coShowPreviousMonth,
    coShowHeader,
    coShowWeekDays,
    coShowWeeks,
    coTransparentButtons,
    coTodayButtonVisible,
    csUseWeekEndColor,
    csUseWeekEndFont,
    coYearButtonVisible);
 
  TmxCalendarOptions = set of TmxCalendarOption;
  TmxFirstDayOfWeek  = (fdSunday, fdMonday {, fdTuesday, fdWednesday, fdThursday, fdFriday, fdSaturday });
  TmxHeaderFormat    = (hfMMMMYYYY, hfYYYYMMMM, hfMMYYYY, hfYYYYMM);
 
  TmxHints = class(TPersistent)
  Private
    FHints: array[0..6] of String;
    FOnChange: TNotifyEvent;
    procedure SetHint(Index: integer; AValue: String);
    function GetHint(Index: integer): String;
  Protected
    procedure Change; virtual;
  Public
    constructor Create;
    procedure Assign(Source: TPersistent); override;
    property Hints[Index: integer]: String Read GetHint; default;
  Published
    property OnChange: TNotifyEvent Read FOnChange Write FOnChange;
    property NextMonth: String Index 0 Read GetHint Write SetHint;
    property PreviousMonth: String Index 1 Read GetHint Write SetHint;
    property NextYear: String Index 2 Read GetHint Write SetHint;
    property PreviousYear: String Index 3 Read GetHint Write SetHint;
    property TodayButton: String Index 4 Read GetHint Write SetHint;
    property Today: String Index 5 Read GetHint Write SetHint;
    property ClearButton: String Index 6 Read GetHint Write SetHint;
  end;
 
  TmxMessages = class(TPersistent)
  Private
    FMonthNames: array[1..12] of String;
    FMessages: array[0..7] of String;
    FHints: TmxHints;
    FOnChange: TNotifyEvent;
 
    procedure SetMessage(Index: integer; AValue: String);
    function GetMessage(Index: integer): String;
    procedure SetMonthName(Index: integer; AValue: String);
    function GetMonthName(Index: integer): String;
    procedure SetOnChange(AOnChange: TNotifyEvent);
  Protected
    procedure Change; virtual;
  Public
    constructor Create;
    destructor Destroy; override;
    procedure Assign(Source: TPersistent); override;
    property Messages[Index: integer]: String Read GetMessage; default;
    property MonthNames[Index: integer]: String Read GetMonthName;
  Published
    property OnChange: TNotifyEvent Read FOnChange Write SetOnChange;
    property Hints: TmxHints Read FHints Write FHints;
    property Week: String Index 0 Read GetMessage Write SetMessage;
    property Sunday: String Index 1 Read GetMessage Write SetMessage;
    property Monday: String Index 2 Read GetMessage Write SetMessage;
    property Tuesday: String Index 3 Read GetMessage Write SetMessage;
    property Wednesday: String Index 4 Read GetMessage Write SetMessage;
    property Thursday: String Index 5 Read GetMessage Write SetMessage;
    property Friday: String Index 6 Read GetMessage Write SetMessage;
    property Saturday: String Index 7 Read GetMessage Write SetMessage;
    property January: String Index 1 Read GetMonthName Write SetMonthName;
    property February: String Index 2 Read GetMonthName Write SetMonthName;
    property March: String Index 3 Read GetMonthName Write SetMonthName;
    property April: String Index 4 Read GetMonthName Write SetMonthName;
    property May: String Index 5 Read GetMonthName Write SetMonthName;
    property June: String Index 6 Read GetMonthName Write SetMonthName;
    property July: String Index 7 Read GetMonthName Write SetMonthName;
    property August: String Index 8 Read GetMonthName Write SetMonthName;
    property September: String Index 9 Read GetMonthName Write SetMonthName;
    property October: String Index 10 Read GetMonthName Write SetMonthName;
    property November: String Index 11 Read GetMonthName Write SetMonthName;
    property December: String Index 12 Read GetMonthName Write SetMonthName;
  end;
 
  TmxCalendarButton = class(TSpeedButton)
  Private
    procedure CMDesignHitTest(var Msg: TCMDesignHitTest); message CM_DESIGNHITTEST;
  end;
 
  TmxDateSelection = class(TObject)
  private
    fDateStart: TDateTime;
    fDateEnd: TDateTime;
    fIsRange: Boolean;
    procedure SetDateEnd(const Value: TDateTime);
    procedure SetDateStart(const Value: TDateTime);
    procedure DetermineRange;
  public
    constructor Create;
    property DateStart: TDateTime read fDateStart write SetDateStart;
    property DateEnd: TDateTime read fDateEnd write SetDateEnd;
    property IsRange: Boolean read fIsRange;
  end;
 
  TmxDateSelections = class(TList)
  private
    function GetItems(Index: Integer): TmxDateSelection;
    procedure _AddItem(aDateStart, aDateEnd: TDateTime);
    procedure OptimizeRanges;
  protected
  public
    procedure AddDate(aDateStart: TDateTime);
    procedure AddRange(aDateStart, aDateEnd: TDateTime);
    procedure RemoveRange(aDateStart: TDateTime; aDateEnd: TDateTime = 0; SplitRange: Boolean = True);
    function RangeIndex(aDate: TDateTime): Integer;
    function DateInList(aDate: TDateTime): Boolean;
    procedure RemoveDate(aDate: TDateTime; SplitRange: Boolean = True);
    property Items[Index: Integer]: TmxDateSelection read GetItems;
  end;
 
  TmxCustomCalendar = class(TCustomPanel)
  Private
    FOnGetItemStyleEvent: TmxOnGetItemStyleEvent;
    FOnGetCursor: TmxOnGetCursorEvent;
    FYear: integer;
    FMonth: integer;
    FDay: integer;
    FDateLabel: TLabel;
    FPanel_Header: TmxPanel;
    FPanel_Footer: TmxPanel;
    FPanel_Calendar: TmxPanel;
    FPanel_Days: array[0..6, 0..7] of TmxPanel;
    FYear_Plus: TmxCalendarButton;
    FYear_Minus: TmxCalendarButton;
    FMonth_Plus: TmxCalendarButton;
    FMonth_Minus: TmxCalendarButton;
    FTodayButton: TmxCalendarButton;
    FClearButton: TmxCalendarButton;
    FDayColor: TColor;
    FSelectedColor: TColor;
    FDayNameColor: TColor;
    FWeekColor: TColor;
    FTodayColor: TColor;
    FIndirectColor: TColor;
    FWeekEndColor: TColor;
    FDateFormat: string;
    FOptions: TmxCalendarOptions;
    FMessages: TmxMessages;
    FFirstDayOfWeek: TmxFirstDayOfWeek;
    FHeaderFormat: TmxHeaderFormat;
    FVersion: integer;
    FSelectedFont: TFont;
    FTodayFont: TFont;
    FDayFont: TFont;
    FIndirectFont: TFont;
    FWeekDaysFont: TFont;
    FWeeksFont: TFont;
    FWeekEndFont: TFont;
    FSelections: TmxDateSelections;
    FSelectionStart: TDateTime;
    FSelectionEnd: TDateTime;
    FCursor: TCursor;
 
    procedure SetVersion(AValue: string);
    function GetVersion: string;
 
    procedure SetCursor(AValue: TCursor);
    procedure SetSelectedColor(AValue: TColor);
    procedure SetWeekEndColor(AValue: TColor);
    procedure SetDayColor(AValue: TColor);
    procedure SetWeekColor(AValue: TColor);
    procedure SetTodayColor(AValue: TColor);
    procedure SetDayNameColor(AValue: TColor);
    procedure SetHeaderColor(AValue: TColor);
    procedure SetFooterColor(AValue: TColor);
    procedure SetIndirectColor(AValue: TColor);
    function GetHeaderColor: TColor;
    function GetFooterColor: TColor;
 
    procedure SetOptions(AValue: TmxCalendarOptions);
    procedure SetWeekDaysFont(AValue: TFont);
    procedure SetIndirectFont(AValue: TFont);
    procedure SetWeeksFont(AValue: TFont);
    procedure SetWeekEndFont(AValue: TFont);
    function GetDateLabelFont: TFont;
    procedure SetDateLabelFont(AValue: TFont);
    procedure SetSelectedFont(AValue: TFont);
    procedure SetTodayFont(AValue: TFont);
    procedure SetDayFont(AValue: TFont);
 
    procedure SetDateFormat(AValue: string);
 
    function GetClearButtonGlyph: TBitmap;
    procedure SetClearButtonGlyph(AValue: TBitmap);
    function GetTodayButtonGlyph: TBitmap;
    procedure SetTodayButtonGlyph(AValue: TBitmap);
    function GetYearMinusGlyph: TBitmap;
    procedure SetYearMinusGlyph(AValue: TBitmap);
    function GetYearPlusGlyph: TBitmap;
    procedure SetYearPlusGlyph(AValue: TBitmap);
    function GetMonthMinusGlyph: TBitmap;
    procedure SetMonthMinusGlyph(AValue: TBitmap);
    function GetMonthPlusGlyph: TBitmap;
    procedure SetMonthPlusGlyph(AValue: TBitmap);
    procedure SetFirstDayOfWeek(AValue: TmxFirstDayOfWeek);
 
    procedure SetYear(AValue: integer);
    procedure SetMonth(AValue: integer);
    procedure SetDay(AValue: integer);
    procedure _SetDate(AValue: TDateTime);
    procedure SetDate(AValue: TDateTime);
    function GetDate: TDateTime;
 
    procedure SetHeaderFormat(AValue: TmxHeaderFormat);
 
{$IFDEF DELPHI4_UP}
    Procedure CMBorderChanged( Var Message: TMessage ); Message CM_BORDERCHANGED;
 
 
{$ENDIF}
    procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
    procedure CMSysColorChange(var Message: TMessage); message CM_SYSCOLORCHANGE;
    procedure CMColorChanged(var Message: TMessage); message CM_COLORCHANGED;
    procedure CMEnabledChanged(var Message: TMessage); message CM_ENABLEDCHANGED;
 
  Protected
 
    procedure SetPanelColor(APanel: TmxPanel; AYear, AMonth: integer); virtual;
    procedure CMFontChanged(var Msg: TMessage); message CM_FONTCHANGED;
    procedure CreateParams(var Params: TCreateParams); override;
 
    procedure OnChangeMessages(Sender: TObject);
    procedure OnResizePanels(Sender: TObject);
    procedure OnCanResizePanels(Sender: TObject; var NewWidth, NewHeight: integer;
      var Resize: boolean);
    procedure SetButtonPositions;
    procedure SetButtonCaptions;
    procedure Loaded; override;
    procedure RepaintCalendar; virtual;
    function SetWeekStart(ADayIndex: integer): integer;
    procedure DoClick(Sender: TObject);
    procedure DoDblClick(Sender: TObject);
    procedure YearButtonClick(Sender: TObject);
    procedure MonthButtonClick(Sender: TObject);
    procedure TodayButtonClick(Sender: TObject);
    procedure ClearButtonClick(Sender: TObject);
 
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer); virtual;
    procedure SetSelectionStart(AValue: TDateTime);
    procedure SetSelectionEnd(AValue: TDateTime);
 
    procedure Paint; override;
    procedure DoGetCursor(ItemType: TmxItemType; var ACursor: TCursor); virtual;
    procedure DoGetItemStyle(ItemStyle: TmxStyleType; ADate: TDate;
      var AFont: TFont; var AColor: TColor); virtual;
 
    // *** Published ***
 
    property Year: integer Read FYear Write SetYear;
    property Month: integer Read FMonth Write SetMonth;
    property Day: integer Read FDay Write SetDay;
    property DateFormat: string Read FDateFormat Write SetDateFormat;
 
    property OnGetItemStyle: TmxOnGetItemStyleEvent
      Read FOnGetItemStyleEvent Write FOnGetItemStyleEvent;
    property OnGetCursor: TmxOnGetCursorEvent Read FOnGetCursor Write FOnGetCursor;
    property Cursor: TCursor Read FCursor Write SetCursor;
    property DayColor: TColor Read FDayColor Write SetDayColor;
    property WeekEndColor: TColor Read FWeekEndColor Write SetWeekEndColor;
    property SelectedColor: TColor Read FSelectedColor Write SetSelectedColor;
    property DayNameColor: TColor Read FDayNameColor Write SetDayNameColor;
    property WeekColor: TColor Read FWeekColor Write SetWeekColor;
    property TodayColor: TColor Read FTodayColor Write SetTodayColor;
    property IndirectColor: TColor Read FIndirectColor Write SetIndirectColor;
    property HeaderColor: TColor Read GetHeaderColor Write SetHeaderColor;
    property FooterColor: TColor Read GetFooterColor Write SetFooterColor;
    property Options: TmxCalendarOptions Read FOptions Write SetOptions;
    property Messages: TmxMessages Read FMessages Write FMessages;
    property SelectedFont: TFont Read FSelectedFont Write SetSelectedFont;
    property DayFont: TFont Read FDayFont Write SetDayFont;
    property TodayFont: TFont Read FTodayFont Write SetTodayFont;
    property WeeksFont: TFont Read FWeeksFont Write SetWeeksFont;
    property WeekEndFont: TFont Read FWeekEndFont Write SetWeekEndFont;
    property DateLabelFont: TFont Read GetDateLabelFont Write SetDateLabelFont;
    property WeekDaysFont: TFont Read FWeekDaysFont Write SetWeekDaysFont;
    property IndirectFont: TFont Read FIndirectFont Write SetIndirectFont;
    property ClearButtonGlyph: TBitmap Read GetClearButtonGlyph
      Write SetClearButtonGlyph;
    property TodayButtonGlyph: TBitmap Read GetTodayButtonGlyph
      Write SetTodayButtonGlyph;
    property YearMinusGlyph: TBitmap Read GetYearMinusGlyph Write SetYearMinusGlyph;
    property YearPlusGlyph: TBitmap Read GetYearPlusGlyph Write SetYearPlusGlyph;
    property MonthMinusGlyph: TBitmap Read GetMonthMinusGlyph Write SetMonthMinusGlyph;
    property MonthPlusGlyph: TBitmap Read GetMonthPlusGlyph Write SetMonthPlusGlyph;
    property HeaderFormat: TmxHeaderFormat Read FHeaderFormat
      Write SetHeaderFormat Default hfMMMMYYYY;
    property FirstDayOfWeek: TmxFirstDayOfWeek
      Read FFirstDayOfWeek Write SetFirstDayOfWeek Default fdMonday;
 
  Public
 
    property Date: TDateTime Read GetDate Write SetDate;
    property Selections: TmxDateSelections read fSelections;
    property SelectionStart: TDateTime Read FSelectionStart;
    property SelectionEnd: TDateTime Read FSelectionEnd;
 
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
 
    procedure ClearSelection;
 
    function DaysInMonth(AYear, AMonth: integer): integer;
    function WeeksInYear(AYear: integer): integer;
    function MonthToWeek(AMonth: integer): integer;
 
  Published
    property Version: string Read GetVersion Write SetVersion;
  end;
 
  TmxCalendar = class(TmxCustomCalendar)
  Public
    property DockManager;
  Published
    property OnGetItemStyle;
    property OnGetCursor;
    property Align;
    property Anchors;
    property BevelInner;
    property BevelOuter;
    property BevelWidth;
    property BorderWidth;
    property BorderStyle;
    property Cursor;
    property Color;
    property Constraints;
    property Ctl3D;
    property UseDockManager Default true;
    property DockSite;
    property DragCursor;
    property DragKind;
    property DragMode;
    property Enabled;
    property ParentColor;
    property ParentCtl3D;
    property ParentShowHint;
    property PopupMenu;
    property ShowHint;
    property TabOrder;
    property TabStop;
    property Visible;
    property OnCanResize;
    property OnClick;
    property OnConstrainedResize;
    property OnContextPopup;
    property OnDockDrop;
    property OnDockOver;
    property OnDblClick;
    property OnDragDrop;
    property OnDragOver;
    property OnEndDock;
    property OnEndDrag;
    property OnEnter;
    property OnExit;
    property OnGetSiteInfo;
    property OnMouseDown;
    property OnMouseMove;
    property OnMouseUp;
    property OnResize;
    property OnStartDock;
    property OnStartDrag;
    property OnUnDock;
 
    property Year;
    property Month;
    property Day;
    property DateFormat;
    property DayColor;
    property WeekEndColor;
    property SelectedColor;
    property DayNameColor;
    property WeekColor;
    property TodayColor;
    property IndirectColor;
    property HeaderColor;
    property FooterColor;
    property Options;
    property Messages;
    property SelectedFont;
    property DayFont;
    property TodayFont;
    property WeeksFont;
    property WeekEndFont;
    property DateLabelFont;
    property WeekDaysFont;
    property IndirectFont;
    property ClearButtonGlyph;
    property TodayButtonGlyph;
    property YearMinusGlyph;
    property YearPlusGlyph;
    property MonthMinusGlyph;
    property MonthPlusGlyph;
    property HeaderFormat;
    property FirstDayOfWeek;
    property Selections;
  end;
 
implementation
 
uses Math;
 
constructor TmxPanel.Create(AOwner: TComponent);
begin
  inherited;
  ControlStyle := ControlStyle + [csAcceptsControls];
  FFlat:=False;
end;
 
procedure TmxPanel.WMSize(var Message: TWMSize);
begin
  inherited;
  Invalidate;
end;
 
procedure TmxPanel.SetFlat( AValue: boolean );
Begin
  If FFlat <> AValue Then
  Begin
    FFlat:=AValue;
    Invalidate;
  End;
End;
 
procedure TmxPanel.CreateParams(var Params: TCreateParams);
begin
  inherited CreateParams(Params);
  with Params do
    WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);
end;
 
procedure TmxPanel.Paint;
var
  Flags: longint;
  X:     integer;
  CalcRect, ARect: TRect;
begin
  inherited;
  ARect := ClientRect;
 
  Canvas.Pen.Style   := psSolid;
  Canvas.Pen.Mode    := pmCopy;
  Canvas.Pen.Color   := clWindowFrame;
  Canvas.Pen.Width   := 1;
  Canvas.Brush.Color := clBtnFace;
  Canvas.Brush.Style := bsClear;
 
  If Not FFlat Then
    Frame3D(Canvas, ARect, clBtnHighlight, clBtnShadow, 1);
 
  Canvas.Font.Assign(Font);
  CalcRect := ARect;
  Flags    := DrawTextBiDiModeFlags(DT_EXPANDTABS or DT_CENTER);
{$WARNINGS OFF}
  DrawText(Canvas.Handle, pchar(Text), Length(Text), CalcRect,
    Flags or DT_CALCRECT);
{$WARNINGS ON}
 
  X := CalcRect.Bottom - CalcRect.Top;
  if (ARect.Bottom - ARect.Top) > X then
  begin
    ARect.Top    := ARect.Top + ((ARect.Bottom - ARect.Top - X) div 2);
    ARect.Bottom := ARect.Top + (CalcRect.Bottom - CalcRect.Top);
{$WARNINGS OFF}
    DrawText(Canvas.Handle, pchar(Text), Length(Text), ARect, Flags);
{$WARNINGS ON}
  end;
end;
 
{TmxHints}
 
constructor TmxHints.Create;
begin
  inherited Create;
  FHints[0] := 'Go to next month';
  FHints[1] := 'Go to previous month';
  FHints[2] := 'Go to next year';
  FHints[3] := 'Go to previous year';
  FHints[4] := 'Set date to today';
  FHints[5] := 'This date is today';
  FHints[6] := 'Clear date selection';
end;
 
procedure TmxHints.Assign(Source: TPersistent);
var
  I: integer;
begin
  if Source is TmxHints then
  begin
    for I := 0 to 6 do
      FHints[I] := TmxHints(Source).Hints[I];
  end
  else
    inherited Assign(Source);
end;
 
function TmxHints.GetHint(Index: integer): String;
begin
  Result := FHints[Index];
end;
 
procedure TmxHints.SetHint(Index: integer; AValue: String);
begin
  if FHints[Index] <> AValue then
  begin
    FHints[Index] := AValue;
    Change;
  end;
end;
 
procedure TmxHints.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;
 
{TmxMessages}
 
constructor TmxMessages.Create;
var
  I: integer;
begin
  inherited Create;
  FMessages[0] := 'CW';
  for I := 1 to 7 do
    FMessages[I] := ShortDayNames[I];
  for I := 1 to 12 do
    FMonthNames[I] := LongMonthNames[I];
  Hints := TmxHints.Create;
end;
 
destructor TmxMessages.Destroy;
begin
  FHints.Free;
  inherited Destroy;
end;
 
procedure TmxMessages.Assign(Source: TPersistent);
var
  I: integer;
begin
  if Source is TmxMessages then
  begin
    for I := 0 to 7 do
      FMessages[I] := TmxMessages(Source).Messages[I];
    for I := 1 to 12 do
      FMonthNames[I] := TmxMessages(Source).MonthNames[I];
 
    FHints.Assign(TmxMessages(Source).Hints);
  end
  else
    inherited Assign(Source);
end;
 
function TmxMessages.GetMessage(Index: integer): String;
begin
  Result := FMessages[Index];
end;
 
procedure TmxMessages.SetMessage(Index: integer; AValue: String);
begin
  if FMessages[Index] <> AValue then
  begin
    FMessages[Index] := AValue;
    Change;
  end;
end;
 
function TmxMessages.GetMonthName(Index: integer): String;
begin
  Result := FMonthNames[Index];
end;
 
procedure TmxMessages.SetOnChange(AOnChange: TNotifyEvent);
begin
  FOnChange := AOnChange;
  FHints.OnChange := AOnChange;
end;
 
procedure TmxMessages.SetMonthName(Index: integer; AValue: String);
begin
  if FMonthNames[Index] <> AValue then
  begin
    FMonthNames[Index] := AValue;
    Change;
  end;
end;
 
procedure TmxMessages.Change;
begin
  if Assigned(FOnChange) then
    FOnChange(Self);
end;
 
{TmxCalendarButton}
 
procedure TmxCalendarButton.CMDesignHitTest(var Msg: TCMDesignHitTest);
begin
  if Parent.CanFocus and
    PtInRect(Rect(0, 0, Width, Height), SmallPointToPoint(Msg.Pos)) then
    Msg.Result := 1;
end;
 
{TmxCustomCalendar}
 
constructor TmxCustomCalendar.Create(AOwner: TComponent);
var
  I, X: byte;
begin
  inherited Create(AOwner);
  ControlStyle := ControlStyle - [csSetCaption];
 
  Height  := 230;
  Width   := 250;
  Caption := '';
 
  BorderWidth := 1;
  BevelInner  := bvNone;
  BevelOuter  := bvLowered;
 
  OnResize    := OnResizePanels;
  OnCanResize := OnCanResizePanels;
 
  FIndirectColor := Color;
  FSelectedColor := clNavy;
  FDayColor      := clYellow;
  FDayNameColor  := $00FF8000;
  FWeekColor     := $00FF8000;
  FTodayColor    := $004080FF;
 
  FOptions := [
    coShowDateLabel,
    coShowHeader,
    coShowFooter,
    coShowWeekDays,
    coShowWeeks,
    coFlatButtons,
    coTransparentButtons,
    coYearButtonVisible,
    coMonthButtonVisible,
    coTodayButtonVisible,
    csUseWeekEndFont,
    csUseWeekEndColor,
    coShowNextMonth,
    coShowPreviousMonth
    ];
 
  Messages := TmxMessages.Create;
  Messages.OnChange := OnChangeMessages;
 
  FSelectedFont := TFont.Create;
  FSelectedFont.Color := clWhite;
  FSelectedFont.OnChange := OnChangeMessages;
 
  FTodayFont := TFont.Create;
  FTodayFont.OnChange := OnChangeMessages;
 
  FIndirectFont := TFont.Create;
  FIndirectFont.OnChange := OnChangeMessages;
 
  FDayFont := TFont.Create;
  FDayFont.OnChange := OnChangeMessages;
 
  FWeekDaysFont := TFont.Create;
  FWeekDaysFont.Color := clWhite;
  FWeekDaysFont.OnChange := OnChangeMessages;
 
  FWeeksFont := TFont.Create;
  FWeeksFont.Color := clWhite;
  FWeeksFont.OnChange := OnChangeMessages;
 
  FWeekEndFont := TFont.Create;
  FWeekEndFont.Color := clBlack;
  FWeekEndFont.OnChange := OnChangeMessages;
 
  FWeekEndColor := clAqua;
 
  FFirstDayOfWeek := fdMonday;
  FHeaderFormat   := hfMMMMYYYY;
 
  FDateFormat := 'dd.mm.yyyy';
 
  FPanel_Header := TmxPanel.Create(Self);
  with FPanel_Header do
  begin
    Parent     := Self;
    Height     := 26;
    Align      := alTop;
    Alignment  := taCenter;
    BevelInner := bvNone;
    BevelOuter := bvRaised;
    Font.Style := [fsBold];
    OnClick    := DoClick;
    OnDblClick := DoDblClick;
  end;
 
  FPanel_Footer := TmxPanel.Create(Self);
  with FPanel_Footer do
  begin
    Parent     := Self;
    Height     := 26;
    Align      := alBottom;
    Alignment  := taCenter;
    BevelInner := bvNone;
    BevelOuter := bvRaised;
    OnClick    := DoClick;
    OnDblClick := DoDblClick;
  end;
 
  FDateLabel := TLabel.Create(Self);
  with FDateLabel do
  begin
    Parent := FPanel_Footer;
    Left   := 3;
    Font.Style := [fsBold];
    SetDateLabelFont(Font);
    OnClick    := DoClick;
    OnDblClick := DoDblClick;
  end;
 
  FPanel_Calendar := TmxPanel.Create(Self);
  with FPanel_Calendar do
  begin
    Parent  := Self;
    Top     := FPanel_Header.Top + FPanel_Header.Height + 1;
    Align   := alClient;
    Alignment := taCenter;
    BevelInner := bvNone;
    BevelOuter := bvRaised;
    ParentColor := true;
    OnClick := DoClick;
    OnDblClick := DoDblClick;
  end;
 
  FYear_Plus := TmxCalendarButton.Create(Self);
  with FYear_Plus do
  begin
    Parent  := FPanel_Header;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := '>>';
    Flat    := true;
    OnClick := YearButtonClick;
  end;
 
  FYear_Minus := TmxCalendarButton.Create(Self);
  with FYear_Minus do
  begin
    Parent  := FPanel_Header;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := '<<';
    Flat    := true;
    OnClick := YearButtonClick;
  end;
 
  FMonth_Plus := TmxCalendarButton.Create(Self);
  with FMonth_Plus do
  begin
    Parent  := FPanel_Header;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := '>';
    Flat    := true;
    OnClick := MonthButtonClick;
  end;
 
  FMonth_Minus := TmxCalendarButton.Create(Self);
  with FMonth_Minus do
  begin
    Parent  := FPanel_Header;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := '<';
    Flat    := true;
    OnClick := MonthButtonClick;
  end;
 
  FTodayButton := TmxCalendarButton.Create(Self);
  with FTodayButton do
  begin
    Parent  := FPanel_Footer;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := 'T';
    Flat    := true;
    OnClick := TodayButtonClick;
  end;
 
  FClearButton := TmxCalendarButton.Create(Self);
  with FClearButton do
  begin
    Parent  := FPanel_Footer;
    Width   := NavigateButtonWidth;
    Top     := 2;
    Caption := 'C';
    Flat    := true;
    Visible := false;
    OnClick := ClearButtonClick;
  end;
 
  for I := 0 to 6 do
  begin
    for X := 0 to 7 do
    begin
      FPanel_Days[I, X] := TmxPanel.Create(Self);
      with FPanel_Days[I, X] do
      begin
        Parent    := FPanel_Calendar;
        Alignment := taCenter;
 
        if I = 0 then
          Color := FWeekColor
        else if X = 0 then
          Color := DayNameColor
        else
          Color := FDayColor;
 
        if (X <> 0) and (I <> 0) then
        begin
          OnMouseDown := DoMouseDown;
          OnClick     := DoClick;
          OnDblClick  := DoDblClick;
        end;
      end;
    end;
  end;
 
  FSelectionStart := 0;
  FSelectionEnd   := 0;
  FSelections := TmxDateSelections.Create;
 
  _SetDate(SysUtils.Date);
 
  FVersion := mxCalendarVersion;
end;
 
destructor TmxCustomCalendar.Destroy;
var
  I, X: byte;
begin
  FSelections.Free;
  FDateLabel.Free;
  FMessages.Free;
  FSelectedFont.Free;
  FTodayFont.Free;
  FDayFont.Free;
  FWeekDaysFont.Free;
  FWeeksFont.Free;
  FWeekEndFont.Free;
  FIndirectFont.Free;
 
  for I := 0 to 6 do
    for X := 0 to 7 do
      FPanel_Days[I, X].Free;
 
  FYear_Plus.Free;
  FYear_Minus.Free;
  FMonth_Plus.Free;
  FMonth_Minus.Free;
  FPanel_Calendar.Free;
  FPanel_Header.Free;
  FPanel_Footer.Free;
 
  inherited Destroy;
end;
 
procedure TmxCustomCalendar.Loaded;
begin
  inherited;
 
     {Try
        EncodeDate( FYear, FMonth, FDay );
     Except
        Date:=Now;
     End;}
 
  SetYearPlusGlyph(FYear_Plus.Glyph);
  SetYearMinusGlyph(FYear_Minus.Glyph);
  SetMonthPlusGlyph(FMonth_Plus.Glyph);
  SetMonthMinusGlyph(FMonth_Minus.Glyph);
  SetTodayButtonGlyph(FTodayButton.Glyph);
  SetClearButtonGlyph(FClearButton.Glyph);
 
  if csSetTodayOnStartup in FOptions then
    _SetDate(SysUtils.Date);
 
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.SetVersion(AValue: string);
begin
    // *** Does nothing ***
end;
 
function TmxCustomCalendar.GetVersion: string;
begin
{$WARNINGS OFF}
  Result := Format('%d.%d', [Hi(FVersion), Lo(FVersion)]);
{$WARNINGS ON}
end;
 
procedure TmxCustomCalendar.SetButtonCaptions;
var
  X, I, Y: shortint;
begin
  FPanel_Days[0, 0].Caption := Messages[0];
  for I := 0 to 6 do
  begin
    FPanel_Days[I, 0].Font.Assign(FWeeksFont);
  end;
                          
  X := byte(FFirstDayOfWeek);
  Y := 0;
 
  for I := X to 6 do
  begin
    Inc(Y);
    FPanel_Days[0, Y].Caption := Messages[I + 1];
    FPanel_Days[0, Y].Font.Assign(FWeekDaysFont);
  end;
 
  for I := 0 to X - 1 do
  begin
    Inc(Y);
    FPanel_Days[0, Y].Caption := Messages[I + 1];
    FPanel_Days[0, Y].Font.Assign(FWeekDaysFont);
  end;
 
  FMonth_Minus.Hint := FMessages.Hints[1];
  FMonth_Plus.Hint  := FMessages.Hints[0];
  FYear_Minus.Hint  := FMessages.Hints[3];
  FYear_Plus.Hint   := FMessages.Hints[2];
  FTodayButton.Hint := FMessages.Hints[4];
  FClearButton.Hint := FMessages.Hints[6];
end;
 
procedure TmxCustomCalendar.SetButtonPositions;
var
  I, X: byte;
  PanelHeight: integer;
  PanelWidth: integer;
  DifferenceWidth: byte;
  DifferenceHeight: byte;
  NumberOfRows: byte;
  NumberOfCols: byte;
  Correction: byte;
  ButtonPosition: integer;
begin
  ButtonPosition := FPanel_Footer.ClientWidth - FTodayButton.ClientWidth - 3;
  if not FTodayButton.Visible then
    ButtonPosition := -100;
  FTodayButton.Left := ButtonPosition;
 
  ButtonPosition := FTodayButton.Left - FClearButton.Width - 3;
  if not FClearButton.Visible then
    ButtonPosition := -100;
  FClearButton.Left := ButtonPosition;
 
  ButtonPosition := FPanel_Header.ClientWidth - FYear_Plus.ClientWidth - 3;
  if not FYear_Plus.Visible then
    ButtonPosition := -100;
  FYear_Plus.Left := ButtonPosition;
 
  ButtonPosition := 3;
  if not FYear_Minus.Visible then
    ButtonPosition := -100;
  FYear_Minus.Left := ButtonPosition;
 
  if FYear_Plus.Visible then
    ButtonPosition := FYear_Plus.Left - FMonth_Plus.Width - 2
  else
    ButtonPosition := FPanel_Header.ClientWidth - FMonth_Plus.ClientWidth - 3;
 
  if not FMonth_Plus.Visible then
    ButtonPosition := -100;
  FMonth_Plus.Left := ButtonPosition;
 
  if FYear_Minus.Visible then
    ButtonPosition := FYear_Minus.Left + FYear_Minus.Width + 2
  else
    ButtonPosition := 3;
 
  if not FMonth_Minus.Visible then
    ButtonPosition := -100;
  FMonth_Minus.Left := ButtonPosition;
 
  NumberOfRows := 7;
  NumberOfCols := 8;
 
  if not (coShowWeeks in Options) then
    Dec(NumberOfCols);
  if not (coShowWeekDays in Options) then
    Dec(NumberOfRows);
 
  PanelHeight := FPanel_Calendar.ClientHeight div NumberOfRows;
  PanelWidth  := FPanel_Calendar.ClientWidth div NumberOfCols;
 
  DifferenceHeight := ((FPanel_Calendar.ClientHeight) mod NumberOfRows) div 2;
  DifferenceWidth  := ((FPanel_Calendar.ClientWidth) mod NumberOfCols) div 2;
 
  for I := 0 to 6 do
  begin
    for X := 0 to 7 do
    begin
      with FPanel_Days[I, X] do
      begin
        Width  := PanelWidth;
        Height := PanelHeight;
 
        if (coShowWeeks in Options) then
          Correction := 0
        else
          Correction := 1;
 
        if (coShowWeeks in Options) or
          ( not (coShowWeeks in Options) and (X <> 0)) then
          Left := ((X - Correction) * PanelWidth) + DifferenceWidth
        else
          Left := -100;
 
        if (coShowWeekDays in Options) then
          Correction := 0
        else
          Correction := 1;
 
        if (coShowWeekDays in Options) or
          ( not (coShowWeekDays in Options) and (I <> 0)) then
          Top := ((I - Correction) * PanelHeight) + DifferenceHeight
        else
          Top := -100;
      end;
    end;
  end;
end;
 
procedure TmxCustomCalendar.OnResizePanels(Sender: TObject);
begin
  SetButtonPositions;
end;
 
procedure TmxCustomCalendar.OnChangeMessages(Sender: TObject);
begin
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.OnCanResizePanels(Sender: TObject;
  var NewWidth, NewHeight: integer; var Resize: boolean);
begin
  if NewWidth < (NavigateButtonWidth * 4) + 6 then
  begin
    NewWidth := (NavigateButtonWidth * 4) + 16;
    Resize   := true;
  end;
end;
 
{$IFDEF DELPHI4_UP}
 
Procedure TmxCustomCalendar.CMBorderChanged( Var Message: TMessage );
Begin
     Inherited;
     RepaintCalendar;
End;
 
{$ENDIF}
 
procedure TmxCustomCalendar.CMCtl3DChanged(var Message: TMessage);
begin
  if NewStyleControls and (BorderStyle = bsSingle) then
    RecreateWnd;
  inherited;
end;
 
procedure TmxCustomCalendar.CMSysColorChange(var Message: TMessage);
begin
  inherited;
  if not (csLoading in ComponentState) then
  begin
    Message.Msg := WM_SYSCOLORCHANGE;
    DefaultHandler(Message);
  end;
end;
 
procedure TmxCustomCalendar.CMEnabledChanged(var Message: TMessage);
begin
  inherited;
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.CMColorChanged(var Message: TMessage);
begin
  inherited;
  RecreateWnd;
end;
 
procedure TmxCustomCalendar.CMFontChanged(var Msg: TMessage);
begin
  inherited;
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.CreateParams(var Params: TCreateParams);
const
  BorderStyles: array[TBorderStyle] of DWORD = (0, WS_BORDER);
begin
  inherited CreateParams(Params);
  with Params do
  begin
    Style := Style or BorderStyles[BorderStyle];
    if NewStyleControls and Ctl3D and (BorderStyle = bsSingle) then
    begin
      Style   := Style and not WS_BORDER;
      ExStyle := ExStyle or WS_EX_CLIENTEDGE;
    end;
    WindowClass.Style := WindowClass.Style and not (CS_HREDRAW or CS_VREDRAW);
  end;
end;
 
procedure TmxCustomCalendar.DoGetItemStyle(ItemStyle: TmxStyleType;
  ADate: TDate; var AFont: TFont; var AColor: TColor);
begin
  if assigned(FOnGetItemStyleEvent) then
    FOnGetItemStyleEvent(Self, ItemStyle, ADate, AFont, AColor);
end;
 
procedure TmxCustomCalendar.DoGetCursor(ItemType: TmxItemType; var ACursor: TCursor);
begin
  if assigned(FOnGetCursor) then
    FOnGetCursor(Self, ItemType, ACursor);
end;
 
procedure TmxCustomCalendar.Paint;
begin
  inherited;
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.SetSelectedColor(AValue: TColor);
begin
  if FSelectedColor <> AValue then
  begin
    FSelectedColor := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetWeekEndColor(AValue: TColor);
begin
  if FWeekEndColor <> AValue then
  begin
    FWeekEndColor := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetHeaderColor(AValue: TColor);
begin
  if FPanel_Header.Color <> AValue then
    FPanel_Header.Color := AValue;
end;
 
function TmxCustomCalendar.GetHeaderColor: TColor;
begin
  Result := FPanel_Header.Color;
end;
 
procedure TmxCustomCalendar.SetFooterColor(AValue: TColor);
begin
  if FPanel_Footer.Color <> AValue then
    FPanel_Footer.Color := AValue;
end;
 
function TmxCustomCalendar.GetFooterColor: TColor;
begin
  Result := FPanel_Footer.Color;
end;
 
procedure TmxCustomCalendar.SetDayNameColor(AValue: TColor);
var
  I: byte;
begin
  if FDayNameColor <> AValue then
  begin
    FDayNameColor := AValue;
    for I := 1 to 7 do
      FPanel_Days[0, I].Color := FDayNameColor;
  end;
end;
 
procedure TmxCustomCalendar.SetWeekColor(AValue: TColor);
var
  I: byte;
begin
  if FWeekColor <> AValue then
  begin
    FWeekColor := AValue;
    for I := 0 to 6 do
      FPanel_Days[I, 0].Color := FWeekColor;
  end;
end;
 
procedure TmxCustomCalendar.SetTodayColor(AValue: TColor);
begin
  if FTodayColor <> AValue then
  begin
    FTodayColor := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetIndirectColor(AValue: TColor);
begin
  if FIndirectColor <> AValue then
  begin
    FIndirectColor := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetCursor(AValue: TCursor);
begin
  if FCursor <> AValue then
  begin
    FCursor := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetDayColor(AValue: TColor);
var
  I, X: byte;
begin
  if FDayColor <> AValue then
  begin
    FDayColor := AValue;
 
    for I := 1 to 6 do
    begin
      for X := 1 to 7 do
      begin
        FPanel_Days[I, X].Color := FDayColor;
      end;
    end;
 
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetOptions(AValue: TmxCalendarOptions);
var
  X, Y: integer;
begin
  if FOptions <> AValue then
  begin
    FOptions := AValue;
 
    if not (coShowHeader in Options) then
    begin
      FPanel_Header.Align := alNone;
      FPanel_Header.Top   := -1000;
    end
    else
      FPanel_Header.Align := alTop;
 
    if not (coShowFooter in Options) then
    begin
      FPanel_Footer.Align := alNone;
      FPanel_Footer.Top   := -1000;
    end
    else
      FPanel_Footer.Align := alBottom;
 
    FYear_Plus.Flat   := coFlatButtons in FOptions;
    FYear_Minus.Flat  := coFlatButtons in FOptions;
    FMonth_Plus.Flat  := coFlatButtons in FOptions;
    FMonth_Minus.Flat := coFlatButtons in FOptions;
    FTodayButton.Flat := coFlatButtons in FOptions;
 
    FYear_Plus.Transparent   := coTransparentButtons in FOptions;
    FYear_Minus.Transparent  := coTransparentButtons in FOptions;
    FMonth_Plus.Transparent  := coTransparentButtons in FOptions;
    FMonth_Minus.Transparent := coTransparentButtons in FOptions;
 
    FYear_Plus.Visible   := coYearButtonVisible in FOptions;
    FYear_Minus.Visible  := coYearButtonVisible in FOptions;
    FMonth_Plus.Visible  := coMonthButtonVisible in FOptions;
    FMonth_Minus.Visible := coMonthButtonVisible in FOptions;
    FTodayButton.Visible := coTodayButtonVisible in FOptions;
    FClearButton.Visible := coClearButtonVisible in FOptions;
 
    SetDateLabelFont(FDateLabel.Font);
 
    for X := 1 to 6 do
      for Y := 1 to 7 do
        FPanel_Days[X, Y].Flat:=csFlatDays in FOptions;
 
    for X := 0 to 6 do
      FPanel_Days[X, 0].Flat:=coFlatHeaders in FOptions;
 
    for Y := 1 to 7 do
      FPanel_Days[0,Y].Flat:=coFlatHeaders in FOptions;
 
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetWeekDaysFont(AValue: TFont);
begin
  FWeekDaysFont.Assign(AValue);
end;
 
procedure TmxCustomCalendar.SetIndirectFont(AValue: TFont);
begin
  FIndirectFont.Assign(AValue);
end;
 
procedure TmxCustomCalendar.SetSelectedFont(AValue: TFont);
begin
  FSelectedFont.Assign(AValue);
end;
 
procedure TmxCustomCalendar.SetTodayFont(AValue: TFont);
begin
  FTodayFont.Assign(AValue);
end;
 
function TmxCustomCalendar.GetDateLabelFont: TFont;
begin
  Result := FDateLabel.Font;
end;
 
procedure TmxCustomCalendar.SetDateLabelFont(AValue: TFont);
begin
  FDateLabel.Font.Assign(AValue);
 
  if coShowDateLabel in FOptions then
    FDateLabel.Top := (FPanel_Footer.Height - FDateLabel.Height) div 2
  else
    FDateLabel.Top := -100;
end;
 
procedure TmxCustomCalendar.SetDayFont(AValue: TFont);
begin
  FDayFont.Assign(AValue);
end;
 
procedure TmxCustomCalendar.SetWeeksFont(AValue: TFont);
begin
  FWeeksFont.Assign(AValue);
end;
 
procedure TmxCustomCalendar.SetWeekEndFont(AValue: TFont);
begin
  FWeekEndFont.Assign(AValue);
end;
 
function TmxCustomCalendar.GetYearMinusGlyph: TBitmap;
begin
  Result := FYear_Minus.Glyph;
end;
 
procedure TmxCustomCalendar.SetYearMinusGlyph(AValue: TBitmap);
begin
  with FYear_Minus do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := '<<'
    else
      Caption := '';
  end;
end;
 
function TmxCustomCalendar.GetTodayButtonGlyph: TBitmap;
begin
  Result := FTodayButton.Glyph;
end;
 
procedure TmxCustomCalendar.SetTodayButtonGlyph(AValue: TBitmap);
begin
  with FTodayButton do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := 'T'
    else
      Caption := '';
  end;
end;
 
function TmxCustomCalendar.GetClearButtonGlyph: TBitmap;
begin
  Result := FClearButton.Glyph;
end;
 
procedure TmxCustomCalendar.SetClearButtonGlyph(AValue: TBitmap);
begin
  with FClearButton do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := 'C'
    else
      Caption := '';
  end;
end;
 
function TmxCustomCalendar.GetYearPlusGlyph: TBitmap;
begin
  Result := FYear_Plus.Glyph;
end;
 
procedure TmxCustomCalendar.SetYearPlusGlyph(AValue: TBitmap);
begin
  with FYear_Plus do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := '>>'
    else
      Caption := '';
  end;
end;
 
function TmxCustomCalendar.GetMonthMinusGlyph: TBitmap;
begin
  Result := FMonth_Minus.Glyph;
end;
 
procedure TmxCustomCalendar.SetMonthMinusGlyph(AValue: TBitmap);
begin
  with FMonth_Minus do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := '<'
    else
      Caption := '';
  end;
end;
 
function TmxCustomCalendar.GetMonthPlusGlyph: TBitmap;
begin
  Result := FMonth_Plus.Glyph;
end;
 
procedure TmxCustomCalendar.SetMonthPlusGlyph(AValue: TBitmap);
begin
  with FMonth_Plus do
  begin
    Glyph.Assign(AValue);
    if Glyph.Empty then
      Caption := '>'
    else
      Caption := '';
  end;
end;
 
procedure TmxCustomCalendar.SetFirstDayOfWeek(AValue: TmxFirstDayOfWeek);
begin
  if FFirstDayOfWeek <> AValue then
  begin
    FFirstDayOfWeek := AValue;
    RecreateWnd;
  end;
end;
 
function TmxCustomCalendar.DaysInMonth(AYear, AMonth: integer): integer;
const
  NumberOfDays: array[1..12] of integer =
    (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
begin
  Result := 0;
  if not (AMonth in [1..12]) then
    Exit;
  Result := NumberOfDays[AMonth];
  if (AMonth = 2) and IsLeapYear(AYear) then
    Inc(Result);
end;
 
function TmxCustomCalendar.MonthToWeek(AMonth: integer): integer;
var
  I, _DayOfWeek: integer;
begin
  Result := 0;
  for I := 1 to FMonth - 1 do
    Inc(Result, DaysInMonth(FYear, I));
 
  _DayOfWeek := SetWeekStart(DayOfWeek(EncodeDate(FYear, 1, 1)));
  if _DayOfWeek > 4 then
    Dec(Result, 7 - _DayOfWeek)
  else
    Inc(Result, _DayOfWeek - 1);
 
  Result := (Result div 7) + 1;
  if (FFirstDayOfWeek = fdSunday) and
    (DayOfWeek(EncodeDate(FYear, AMonth, 1)) = 7) then
    Dec(Result);
end;
 
Function TmxCustomCalendar.SetWeekStart( ADayIndex: Integer ): Integer;
Begin
     Result := ADayIndex;
     If FFirstDayOfWeek = fdMonday Then 
	If Result = 1 Then Result := 7 Else Dec( Result );
End;
 
function TmxCustomCalendar.WeeksInYear(AYear: integer): integer;
var
  _DayOfWeek: integer;
begin
  if IsLeapYear(AYear) then
    Result := 366
  else
    Result := 365;
 
  _DayOfWeek := SetWeekStart(DayOfWeek(EncodeDate(AYear, 1, 1)));
  if _DayOfWeek > 4 then
    Dec(Result, _DayOfWeek)
  else
    Inc(Result, 7 - _DayOfWeek);
 
  _DayOfWeek := SetWeekStart(DayOfWeek(EncodeDate(AYear, 12, 31)));
  if _DayOfWeek > 3 then
    Inc(Result, 7 - _DayOfWeek)
  else
    Dec(Result, _DayOfWeek);
 
  Result := Result div 7;
  if Result = 51 then
    Result := 52;
end;
 
procedure TmxCustomCalendar.SetYear(AValue: integer);
begin
  if AValue <> FYear then
  begin
    if AValue < 1900 then
      FYear := 1900
    else if AValue > 2100 then
      FYear := 2100
    else
      FYear := AValue;
 
    if not (csLoading in ComponentState) then
      RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetMonth(AValue: integer);
begin
  if AValue <> FMonth then
  begin
    if AValue < 1 then
      FMonth := 1
    else if AValue > 12 then
      FMonth := 12
    else
      FMonth := AValue;
 
    if DaysInMonth(FYear, FMonth) < FDay then
      FDay := DaysInMonth(FYear, FMonth);
 
    if not (csLoading in ComponentState) then
      RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetDay(AValue: integer);
begin
  if AValue <> FDay then
  begin
    if AValue < 1 then
      FDay := 1
    else if AValue > DaysInMonth(FYear, FMonth) then
      FDay := DaysInMonth(FYear, FMonth)
    else
      FDay := AValue;
 
    if not (csLoading in ComponentState) then
      RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar._SetDate(AValue: TDateTime);
var
  Year, Month, Day: word;
begin
  DecodeDate(AValue, Year, Month, Day);
  FYear  := Year;
  FMonth := Month;
  FDay   := Day;
end;
 
procedure TmxCustomCalendar.SetDate(AValue: TDateTime);
begin
  _SetDate(AValue);
  RepaintCalendar;
end;
 
function TmxCustomCalendar.GetDate: TDateTime;
begin
  Result := EncodeDate(FYear, FMonth, FDay);
end;
 
procedure TmxCustomCalendar.SetHeaderFormat(AValue: TmxHeaderFormat);
begin
  if AValue <> FHeaderFormat then
  begin
    FHeaderFormat := AValue;
    RepaintCalendar;
  end;
end;
 
procedure TmxCustomCalendar.SetPanelColor(APanel: TmxPanel; AYear, AMonth: integer);
var
  PanelDate:  TDateTime;
  IsSelected: boolean;
  MonthNumber: Byte;
 
  Procedure InternalSetPanel( APanel: TmxPanel; ItemStyle: TmxStyleType );
  Var
    FFont:      TFont;
    FColor:     TColor;
  Begin
    FFont := TFont.Create;
    try
      Case ItemStyle Of
        stSelected:
          Begin
            FColor:=FSelectedColor;
            FFont.Assign( FSelectedFont );
          End;
        stToday:
          Begin
            FColor:=FTodayColor;
            FFont.Assign( FTodayFont );
          End;
        stDay:
          Begin
            FColor:=FDayColor;
            FFont.Assign( FDayFont );
          End;
        stWeekEnd:
          Begin
            if csUseWeekEndFont in FOptions then
              APanel.Font.Assign(FWeekEndFont) Else
              APanel.Font.Assign(FDayFont);
 
            if csUseWeekEndColor in FOptions then
              FColor:=FWeekEndColor Else
              FColor:=FDayColor;
          End;
        stIndirect:
          Begin
            FColor:=FIndirectColor;
            FFont.Assign( FIndirectFont );
          End;
      End;
 
      DoGetItemStyle( ItemStyle, PanelDate, FFont, FColor);
      APanel.Font.Assign(FFont);
      APanel.Color:=FColor;
    finally
      FFont.Free;
    end;
  End;
 
begin
  APanel.Tag := AMonth;
 
  PanelDate  := EncodeDate(AYear, AMonth, StrToInt(APanel.Caption));
  IsSelected := FSelections.DateInList(PanelDate);
    // (PanelDate >= Trunc(FSelectionStart)) and
    //(PanelDate <= FSelectionEnd);
 
  APanel.Hint := '';
 
  if IsSelected then
    InternalSetPanel( APanel, stSelected ) Else
    begin
      if PanelDate = SysUtils.Date then // today
      begin
        InternalSetPanel( APanel, stToday );
        APanel.Hint  := FMessages.Hints[5];
      end
      else
      begin
        if AMonth = FMonth then
        begin
          if DayOfWeek(PanelDate) in [1, 7] then
            InternalSetPanel( APanel, stWeekEnd ) Else
            InternalSetPanel( APanel, stDay );
        end
        else
        begin
          InternalSetPanel( APanel, stIndirect );
 
          MonthNumber := FMonth + 1;
          if MonthNumber > 12 then
            MonthNumber := 1;
 
          if ( not (coShowNextMonth in FOptions)) and
            (AMonth = MonthNumber) then
            APanel.Font.Color := APanel.Color;
 
          MonthNumber := FMonth - 1;
          if MonthNumber < 1 then
            MonthNumber := 12;
 
          if ( not (coShowPreviousMonth in FOptions)) and
            (AMonth = MonthNumber) then
            APanel.Font.Color := APanel.Color;
        end;
      end;
    end;
 
  APanel.Hint := 'adadaa';
 
  APanel.Invalidate;
end;
 
procedure TmxCustomCalendar.RepaintCalendar;
var
  AType:  TmxItemType;
  ACursor: TCursor;
  FirstDate: TDateTime;
  TotalDays: integer;
  WeekDay: integer;
  CurrentDay: integer;
  WeekNumber: integer;
  WeeksYear: integer;
  X, Y:   integer;
  SMonth: String;
begin
  SetButtonPositions;
  SetButtonCaptions;
 
  // *** Update View ***
 
  FirstDate := EncodeDate(FYear, FMonth, 1);
  WeekDay   := SetWeekStart(DayOfWeek(FirstDate));
  TotalDays := DaysInMonth(FYear, FMonth);
 
  If FDay > TotalDays Then FDay:=TotalDays;
 
  CurrentDay := 1;
 
  for X := 0 to 5 do
  begin
    for Y := 0 to 6 do
    begin
      if (X = 0) and (Y + 1 < WeekDay) then
      begin
        if FMonth = 1 then
        begin
          FPanel_Days[X + 1, Y + 1].Caption :=
            IntToStr(DaysInMonth(FYear - 1, 12) - WeekDay + Y + 2);
 
          SetPanelColor(FPanel_Days[X + 1, Y + 1], FYear - 1, 12);
        end
        else
        begin
          FPanel_Days[X + 1, Y + 1].Caption :=
            IntToStr(DaysInMonth(FYear, FMonth - 1) - WeekDay + Y + 2);
 
          SetPanelColor(FPanel_Days[X + 1, Y + 1], FYear, FMonth - 1);
        end;
      end
      else
      begin
        if CurrentDay > TotalDays then
        begin
          FPanel_Days[X + 1, Y + 1].Caption :=
            IntToStr(CurrentDay - TotalDays);
 
          if FMonth = 12 then
            SetPanelColor(FPanel_Days[X + 1, Y + 1], FYear + 1, 1) Else
            SetPanelColor(FPanel_Days[X + 1, Y + 1], FYear, FMonth + 1);
        end
        else
        begin
          FPanel_Days[X + 1, Y + 1].Caption := IntToStr(CurrentDay);
          SetPanelColor(FPanel_Days[X + 1, Y + 1], FYear, FMonth);
        end;
 
        Inc(CurrentDay);
      end;
    end;
  end;
 
  // *** Set Caption ***
 
  SMonth := IntToStr(FMonth);
  if Length(SMonth) = 1 then
    SMonth := '0' + SMonth;
 
  case FHeaderFormat of
    hfMMMMYYYY: FPanel_Header.Caption :=
        Format('%s, %d', [FMessages.FMonthNames[FMonth], FYear]);
    hfYYYYMMMM: FPanel_Header.Caption :=
        Format('%d, %s', [FYear, FMessages.FMonthNames[FMonth]]);
    hfMMYYYY: FPanel_Header.Caption   := Format('%s.%d', [SMonth, FYear]);
    hfYYYYMM: FPanel_Header.Caption   := Format('%d.%s', [FYear, SMonth]);
  end;
 
  FPanel_Header.Invalidate;
  // *** Set Week Numbers ***
 
  WeeksYear := WeeksInYear(FYear);
 
  for X := 0 to 5 do
  begin
    WeekNumber := MonthToWeek(FMonth) + X;
    if WeekNumber > WeeksYear then
      WeekNumber := WeekNumber - WeeksYear;
    FPanel_Days[X + 1, 0].Caption := IntToStr(WeekNumber);
  end;
 
  // *** Set Cursor
 
  ACursor := Cursor;
  DoGetCursor(itHeader, ACursor);
  FPanel_Header.Cursor := ACursor;
 
  ACursor := Cursor;
  DoGetCursor(itFooter, ACursor);
  FPanel_Footer.Cursor := ACursor;
 
  ACursor := Cursor;
  FPanel_Calendar.Cursor := ACursor;
 
  for X := 0 to 6 do
  begin
    for Y := 0 to 7 do
    begin
      ACursor := Cursor;
 
      if (X = 0) and (Y = 0) then
        AType := itCW
      else if (X = 0) and (Y <> 0) then
        AType := itWeek
      else if (X <> 0) and (Y = 0) then
        AType := itDay
      else
        AType := itCalendar;
 
      DoGetCursor(AType, ACursor);
      FPanel_Days[X, Y].Cursor := ACursor;
    end;
  end;
 
  // *** Set Label Caption ***
 
  if FSelectionStart = 0 then
  begin
    FDateLabel.Caption := FormatDateTime(FDateFormat, EncodeDate(FYear, FMonth, FDay));
  end
  else
  begin
    if FSelectionStart = FSelectionEnd then
    begin
      try
        FDateLabel.Caption := FormatDateTime(FDateFormat, FSelectionStart);
      except
        FDateLabel.Caption :=
          FormatDateTime('yyyy.mm.dd', FSelectionStart);
      end;
    end
    else
    begin
      try
        FDateLabel.Caption :=
          FormatDateTime(FDateFormat, FSelectionStart) + '-' +
          FormatDateTime(FDateFormat, FSelectionEnd);
      except
        FDateLabel.Caption :=
          FormatDateTime('yyyy.mm.dd', FSelectionStart) + '-' +
          FormatDateTime('yyyy.mm.dd', FSelectionEnd);
      end;
    end;
  end;
end;
 
procedure TmxCustomCalendar.MonthButtonClick(Sender: TObject);
begin
  if Sender = FMonth_Plus then
  begin
    if FMonth = 12 then
    begin
      Inc(FYear);
      FMonth := 1;
    end
    else
      Inc(FMonth)
  end
  else
  begin
    if FMonth = 1 then
    begin
      Dec(FYear);
      FMonth := 12;
    end
    else
      Dec(FMonth)
  end;
 
  RepaintCalendar;
  Click;
end;
 
procedure TmxCustomCalendar.DoDblClick(Sender: TObject);
begin
  DblClick;
end;
 
procedure TmxCustomCalendar.DoClick(Sender: TObject);
begin
  Click;
end;
 
procedure TmxCustomCalendar.YearButtonClick(Sender: TObject);
begin
  if Sender = FYear_Plus then
    Inc(FYear)
  else
    Dec(FYear);
  RepaintCalendar;
  Click;
end;
 
procedure TmxCustomCalendar.TodayButtonClick(Sender: TObject);
begin
  SetDate(SysUtils.Date);
  Click;
end;
 
procedure TmxCustomCalendar.ClearButtonClick(Sender: TObject);
begin
  FSelectionStart := 0;
  FSelectionEnd   := 0;
  RepaintCalendar;
  Click;
end;
 
procedure TmxCustomCalendar.SetSelectionStart(AValue: TDateTime);
begin
  //if AValue <> FSelectionStart then
  //begin
    FSelectionStart := AValue;
 
    if (FSelectionStart > FSelectionEnd) or
      (( not (csSelectionEnabled in FOptions)) and
      (FSelectionStart <> FSelectionEnd)) then
      SetSelectionEnd(FSelectionStart);
 
    _SetDate(AValue);
 
    RepaintCalendar;
  //end;
end;
 
procedure TmxCustomCalendar.SetSelectionEnd(AValue: TDateTime);
begin
  //if AValue <> FSelectionEnd then
  //begin
    FSelectionEnd := AValue;
 
    if (FSelectionEnd < FSelectionStart) or
      (( not (csSelectionEnabled in FOptions)) and
      (FSelectionStart <> FSelectionEnd)) then
      SetSelectionStart(FSelectionEnd);
 
    RepaintCalendar;
  //end;
end;
 
procedure TmxCustomCalendar.DoMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
var
  _Year:     word;
  PanelDate: TDateTime;
  APanel:    TmxPanel;
begin
  APanel := (Sender as TmxPanel);
 
  if (APanel.Tag = 12) and (FMonth = 1) then
    _Year := FYear - 1
  else if (APanel.Tag = 1) and (FMonth = 12) then
    _Year := FYear + 1
  else
    _Year := FYear;
 
  PanelDate := Trunc(EncodeDate(_Year, APanel.Tag, StrToInt(APanel.Caption)));
 
  if (ssCtrl in Shift) and not (ssShift in Shift) then // Add single date
  begin
    if FSelections.DateInList(PanelDate) then
      FSelections.RemoveDate(PanelDate)
    else
      FSelections.AddDate(PanelDate);
  end;
 
  if not (ssCtrl in Shift) and not (ssShift in Shift) then
  begin
    FSelections.Clear;
    if ssLeft in Shift then
    begin
      FSelections.AddDate(PanelDate);
    end;
      //SetSelectionStart(PanelDate + Frac(FSelectionStart));
 
    if ssRight in Shift then
      if (csSelectionEnabled in FOptions) then
      begin
        // Find last item and set the end date
        if FSelections.Count > 0 then
          FSelections.Items[FSelections.Count-1].DateEnd := PanelDate
        else
          FSelections.AddDate(PanelDate);
        //SetSelectionEnd(PanelDate + Frac(FSelectionEnd));
      end;
  end;
  RepaintCalendar;
end;
 
procedure TmxCustomCalendar.ClearSelection;
begin
  ClearButtonClick(Self);
end;
 
procedure TmxCustomCalendar.SetDateFormat(AValue: string);
begin
  if FDateFormat <> AValue then
  begin
    FDateFormat := AValue;
    RepaintCalendar;
  end;
end;
 
{ TmxDateSelections }
 
procedure TmxDateSelections._AddItem(aDateStart, aDateEnd: TDateTime);
var item: TmxDateSelection;
begin
  item := TmxDateSelection.Create;
  item.DateStart := aDateStart;
  item.DateEnd := aDateEnd;
  Add(item);
end;
 
procedure TmxDateSelections.AddDate(aDateStart: TDateTime);
begin
  _AddItem(aDateStart, 0);
  OptimizeRanges;
end;
 
procedure TmxDateSelections.AddRange(aDateStart, aDateEnd: TDateTime);
begin
  _AddItem(aDateStart, aDateEnd);
  OptimizeRanges;
end;
 
function SortRanges(Item1, Item2: Pointer): Integer;
begin
  Result := CompareValue(TmxDateSelection(item1).DateStart, TmxDateSelection(item2).DateStart);
  if Result = 0 then
    Result := CompareValue(TmxDateSelection(item1).DateEnd, TmxDateSelection(item2).DateEnd);
end;
 
procedure TmxDateSelections.OptimizeRanges;
var
  I, n: Integer;
  item: TmxDateSelection;
  FindDate: TDateTime;
begin
  if Count > 1 then
  begin
    Sort(SortRanges);
    I := 0;
    repeat
      item := Items[I];
      // Find items that extend this one (next start = this end + 1)
      FindDate := item.DateStart + 1;
      if item.IsRange then
        FindDate := item.DateEnd + 1;
      n := RangeIndex(FindDate);
      if n <> -1 then // Range found, (extend this item and delete that range
      begin
        if Items[n].IsRange then
          item.DateEnd := Items[n].DateEnd
        else
          item.DateEnd := Items[n].DateStart;
        Delete(n);
      end else
        Inc(I);
    until (I >= Count - 1);
    // now work backwards
    I := Count - 1;
    repeat
      item := Items[I];
      // Find items that extend this one (prev end = this start -1)
      FindDate := item.DateStart - 1;
      n := RangeIndex(FindDate);
      if n <> -1 then // Range found, (extend this item and delete that range
      begin
        item.DateStart := Items[n].DateStart ;
        Delete(n);
      end else
        Dec(I);
    until (I < 0);
  end;
end;
 
function TmxDateSelections.DateInList(aDate: TDateTime): Boolean;
begin
  Result := RangeIndex(aDate) <> -1;
end;
 
function TmxDateSelections.GetItems(Index: Integer): TmxDateSelection;
begin
  Result := TmxDateSelection(inherited Items[Index]);
end;
 
function TmxDateSelections.RangeIndex(aDate: TDateTime): Integer;
var I: integer;
  item: TmxDateSelection;
begin
  Result := -1;
  for I := 0 to Count - 1 do
  begin
    item := Items[I];
    if (item.IsRange and (item.DateStart <= aDate) and (aDate <= item.DateEnd)) or
      (not item.IsRange and (item.DateStart = aDate)) then
    begin
      Result := I;
      Break;
    end;
  end;
end;
 
procedure TmxDateSelections.RemoveDate(aDate: TDateTime; SplitRange: Boolean);
var I: Integer;
  item: TmxDateSelection;
begin
  if Count > 0 then
  begin
    I := 0;
    repeat
      item := Items[I];
      if not item.IsRange and (aDate = item.DateStart) then
        Delete(I)
      else if item.IsRange and (item.DateStart <= aDate) and (aDate <= item.DateEnd) then
      begin
        if SplitRange then
        begin
          if item.DateStart = aDate then
          begin
            item.DateStart := item.DateStart + 1;
            Inc(I);
          end
            else if item.DateEnd = aDate then
          begin
            item.DateEnd := item.DateEnd - 1;
            Inc(I);
          end
            else
          begin
            _AddItem(aDate+1, item.DateEnd);
            item.DateEnd := aDate-1;
            Inc(I);
          end;
        end else
          Delete(I);
      end else
        Inc(I);
    until I >= Count;
  end;
end;
 
procedure TmxDateSelections.RemoveRange(aDateStart, aDateEnd: TDateTime; SplitRange: Boolean);
var I: Integer;
  item: TmxDateSelection;
begin
  for I := Count - 1 downto 0 do
  begin
    item := Items[I];
    if not item.IsRange then
    begin
      if (aDateStart <= item.DateStart) and (item.DateStart <= aDateEnd) then
        Delete(I);
    end
      else
    begin
      if ((aDateStart <= item.DateStart) and (item.DateStart <= aDateEnd)
        and (aDateStart <= item.DateEnd) and (item.DateEnd <= aDateEnd)) then
        Delete(I)
        else if (aDateStart <= item.DateStart) and (item.DateStart <= aDateEnd) then
      begin // Only start in range --> move start to end of range
        item.DateStart := aDateEnd + 1;
      end
        else if (aDateStart <= item.DateEnd) and (item.DateEnd <= aDateEnd) then
      begin // Only end in range --> move end to start of range
        item.DateEnd := aDateStart - 1;
      end;
    end;
  end;
end;
 
{ TmxDateSelection }
 
constructor TmxDateSelection.Create;
begin
  inherited Create;
  fDateStart := 0;
  fDateEnd := 0;
end;
 
procedure TmxDateSelection.SetDateEnd(const Value: TDateTime);
begin
  fDateEnd := Value;
  DetermineRange;
end;
 
procedure TmxDateSelection.DetermineRange;
begin
  fIsRange := (fDateStart <> 0) and (fDateEnd <> 0)
    and (Trunc(fDateStart) <> Trunc(fDateEnd));
end;
 
procedure TmxDateSelection.SetDateStart(const Value: TDateTime);
begin
  fDateStart := Value;
  fIsRange := (fDateStart <> 0) and (fDateEnd <> 0)
    and (Trunc(fDateStart) <> Trunc(fDateEnd));
end;
 
end.

Open in new window

0
 
LVL 37

Accepted Solution

by:
Geert Gruwez earned 500 total points
ID: 24809278
this is the small program i used to test it with
unit Unit1;
 
interface
 
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ExtCtrls, mxCalendar;
 
type
  TmxCalendar = class(mxCalendar.TmxCalendar)
  protected
    procedure DoMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: integer); override;
  end;
 
 
type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure FormCreate(Sender: TObject);
  private
    fmxCalendar: TmxCalendar;
  public
  end;
 
var
  Form1: TForm1;
 
implementation
 
{$R *.dfm}
 
procedure TForm1.FormCreate(Sender: TObject);
begin
  fmxCalendar := TmxCalendar.Create(Self);
  with fmxCalendar do
  begin
    Name := 'fmxCalendar';
    Parent := Self;
    Left := 56;
    Top := 32;
    Width := 345;
    Height := 209;
    Cursor := crDefault;
    Version := '2.11';
    BevelOuter := bvLowered;
    BorderWidth := 1;
    TabOrder := 0;
    Year := 2009;
    Month := 7;
    Day := 7;
    DateFormat := 'dd.mm.yyyy';
    DayColor := clYellow;
    WeekEndColor := clAqua;
    SelectedColor := clNavy;
    DayNameColor := 16744448;
    WeekColor := 16744448;
    TodayColor := 4227327;
    IndirectColor := clBtnFace;
    HeaderColor := clBtnFace;
    FooterColor := clBtnFace;
    Options := [coFlatButtons, coMonthButtonVisible, csSelectionEnabled, coShowDateLabel, coShowFooter, coShowNextMonth, coShowPreviousMonth, coShowHeader, coShowWeekDays, coShowWeeks, coTransparentButtons, coTodayButtonVisible, csUseWeekEndColor, csUseWeekEndFont, coYearButtonVisible];
  end;
 
end;
 
{ TmxCalendar }
 
function GetShiftState(Shift: TShiftState): string;
begin
  Result := '';
  if ssShift in Shift then
    Result := Result + 'ssShift ';
  if ssAlt in Shift then
    Result := Result + 'ssAlt ';
  if ssCtrl  in Shift then
    Result := Result + 'ssCtrl ';
  if ssLeft  in Shift then
    Result := Result + 'ssLeft ';
  if ssRight  in Shift then
    Result := Result + 'ssRight ';
  if ssMiddle  in Shift then
    Result := Result + 'ssMiddle ';
  if ssDouble  in Shift then
    Result := Result + 'ssDouble ';
end;
 
procedure TmxCalendar.DoMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: integer);
var I: Integer;
  Temp: String;
begin
  Form1.Memo1.Lines.Add(Format('Button: %d, Shift: %s, X %d, Y: %d',
    [Integer(Button), GetShiftState(Shift), X, Y]));
  inherited DoMouseDown(Sender, Button, Shift, X, Y);
  Form1.Memo1.Lines.Add(Format('SelectionDates : %d', [Selections.Count ]));
  for I := 0 to Selections.Count - 1 do
  begin
    Temp := DateToStr(Selections.Items[I].DateStart);
    if Selections.Items[I].IsRange then
      Temp := Temp + ' to ' + DateToStr(Selections.Items[I].DateEnd);
    Form1.Memo1.Lines.Add(Temp);
  end;
end;
 
end.

Open in new window

0
 
LVL 13

Author Comment

by:rfwoolf
ID: 24811471
Thanks a lot for this Geert.  By the time you came with your posts I had already implemented TRngCalendar which was freeware and opensource but wasn't 100% finished. It would show a "Year planner" for the year (in other words it would show all 12 months on the calendar) and you can  then select multiple dates in that year.
Then to iterate through the selected dates, you have to iterate through all 365 days of that year to see if that Day is True or False.

Anyway, I can't promise that I will find the time to change to your calendar component, but I think my question and your answer is important to the Delphi community and I will probably need this in the future.

I am accepting your answer without testing it.
Thank you so much for your effort :)
0
 
LVL 13

Author Comment

by:rfwoolf
ID: 24811476
Just to review in less words:
this TRngCalendar component was the only freeware multi-select calendar component I could find after much looking and it is not very good,
therefore your answer is very helpful to the community and perhaps for me in the future.
0
 
LVL 37

Expert Comment

by:Geert Gruwez
ID: 24815379
post the link for the TRngCalendar ... maybe we could extend that too  :)
0
 
LVL 13

Author Comment

by:rfwoolf
ID: 24815541
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
A short tutorial showing how to set up an email signature in Outlook on the Web (previously known as OWA). For free email signatures designs, visit https://www.mail-signatures.com/articles/signature-templates/?sts=6651 If you want to manage em…

733 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question