Solved

Calendar component with multiple day selection

Posted on 2009-07-07
9
885 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
  • 6
  • 3
9 Comments
 
LVL 36

Expert Comment

by:Geert Gruwez
Comment Utility
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 36

Expert Comment

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

Expert Comment

by:Geert Gruwez
Comment Utility
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
 
LVL 36

Expert Comment

by:Geert Gruwez
Comment Utility
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
What Security Threats Are You Missing?

Enhance your security with threat intelligence from the web. Get trending threat insights on hackers, exploits, and suspicious IP addresses delivered to your inbox with our free Cyber Daily.

 
LVL 36

Accepted Solution

by:
Geert Gruwez earned 500 total points
Comment Utility
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
Comment Utility
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
Comment Utility
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 36

Expert Comment

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

Author Comment

by:rfwoolf
Comment Utility
0

Featured Post

Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

Join & Write a Comment

This article explains how to create forms/units independent of other forms/units object names in a delphi project. Have you ever created a form for user input in a Delphi project and then had the need to have that same form in a other Delphi proj…
Introduction I have seen many questions in this Delphi topic area where queries in threads are needed or suggested. I know bumped into a similar need. This article will address some of the concepts when dealing with a multithreaded delphi database…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…
Polish reports in Access so they look terrific. Take yourself to another level. Equations, Back Color, Alternate Back Color. Write easy VBA Code. Tighten space to use less pages. Launch report from a menu, considering criteria only when it is filled…

728 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

Need Help in Real-Time?

Connect with top rated Experts

14 Experts available now in Live!

Get 1:1 Help Now