Class TCalendar97 (unit DtCal97)

Inherits from

TCustomPanel

***************************************************************************** TCalendar97 Derived from tCustomPanel Properties Not published DayArray : array which contains all days names MonthArray : array which contains all monthes names ShowCancel : Internal Use : Show (or hide) cancel button ValidDates : List of valid dates (read only) Published BevelInner, BevelOuter, BorderStyle : inherited properties Colors : Colors for the popup calendar (title, arrows, dates, ...) ColorArrow : Color for arrow buttons of calendar ColorDates : Color for dates of calendar ColorTitle : Color for title of calendar ColorValid : Color for valid dates of calendar ColorWeekEnd : Color for week-end dates of calendar DayNames : Names of each days KeyRepeat : Delay when a key is repeated MonthNames : Names of each monthes OnlyMonth : If set to true, can select month without days. OnlyValidDates : If set to true, only valid dates are allowed. Others are grayed StartOfWeek : First day of week StartOfWeekEnd : First day of week-end (saturday, or thursday for musulmans) ShowNumWeek : Show (or hide) week number column ShowToday : Show (or hide) today button Event AfterNewMonth : After changing month BeforeNewMonth : Before changing month OnDateChange : When date is changing OnDateClick : When mouse is clicked on a date OnKeyCancel : When cancel key is pressed (esc key) OnKeyEnter : When enter key is pressed OnKillFocus : When Calendar loose focus (mgs WM_KILLFOCUS) Author name=BOURMAD Mehdi Author E-mail=bourmad@mygale.org Author URL=www.mygale.org/~bourmad

Constructors


Constructor Create(AOwner:TComponent);

Public declarations

-------------------------------------------------------------} {------------------------ TCalendar97 ------------------------} {-------------------------------------------------------------



Functions

procedure AddValidDate(aDate: TDateTime);

******** Add a Date in the list of valid dates

procedure ClearValidDates;

************* Clear list of valid dates

function DateInList(aDate: TDateTime): Boolean;

******** Is the supplied data in the date list?

Destructor Destroy;

Define initial date

procedure SetIdealSize;

***************** Set Ideal Size for calendar

procedure AddPopupItems;


procedure CalTimer(Sender: TObject);

****************** CalTimer

procedure DrawButtonCancel;

****************** Draw Buttton Cancel

procedure DrawButtons;

****************** Draw Butttons

procedure DrawButtonToday;

****************** Draw Buttton Today

procedure DrawCalendarBorder;

************* Draw Calendar Border

procedure DrawDates;

********************* Draw Dates

procedure DrawDaysHeader;

********************* Draw Day Header

procedure DrawFocusFrame(Index: Integer; IsUp: boolean);

****************** Draw Focus Frame

procedure DrawMonthHeader;

****************** Draw Month Header

procedure EraseButtonCancel;

****************** Erase Button Cancel

procedure EraseButtonToday;

****************** Erase Button Today

procedure EraseDateFrame(Index: Integer);

****************** Erase Date Frame

function GetCalendarRect: TRect;

******************** Get Calendar Rectangle ******************** ***** Get the rectangle used for the calendar section *****

function GetCancelButtonRect: TRect;

****************** Get Cancel Button Rectangle ***************** ***** Get the rectangle used for the Cancel button.

function GetDayArray: PDayArray;


function GetDblLeftButtonRect: TRect;

******************* Get DblLeft Button Rectangle *************** ***** Get the rectangle used for the dblleft button.

function GetDblRightButtonRect: TRect;

****************** Get DblRight Button Rectangle *************** ***** Get the rectangle used for the dblright button.

Function GetGoodColor (aDate: tDateTime): tColor;

***************** GetGoodColor

function GetIndexFromPoint(Left: Integer; Top: Integer): Integer;

**************** Get Index From Point ******************

function GetLeftButtonRect: TRect;

******************* Get Left Button Rectangle ****************** ***** Get the rectangle used for the left button.

function GetMonthArray: PMonthArray;


function GetMonthBegin: Integer;

************************* Get Month Begin ************************** ***** This function Gets the index value of the first day of the ***** ***** month.

function GetMonthHeaderRect: TRect;

******************* Get Month Header Rectangle ***************** ***** Get the rectangle used for the month header.

function GetNextDay : Integer;

******************* Get Next Day

function GetNextMonth : Integer;

****************** Get Next Month

function GetNextWeek : Integer;

****************** Get Next Week

function GetNextYear : Integer;

****************** Get Next Year

function GetNumWeek(Date: TDateTime): Integer;

******************** GetNumWeek

function GetPrevDay : Integer;

****************** Get Previous Day

function GetPrevMonth : Integer;

****************** GetPreviousMonth

function GetPrevWeek : Integer;

****************** Get Previous Week

function GetPrevYear : Integer;

***************** GetPrevious Year

function GetRectFromIndex(Index: Integer): TRect;

****************** Get Rectangle From Index ******************** ***** Get the rectangle used for this day section *****

function GetRightButtonRect: TRect;

****************** Get Right Button Rectangle ****************** ***** Get the rectangle used for the right button.

function GetTodayButtonRect: TRect;

******************* Get Today Button Rectangle ***************** ***** Get the rectangle used for the Today button.

procedure KeyDown(var Key: Word; Shift: TShiftState);

mouse move not in calendar rect

procedure LoadDateArray;

******************** LoadDateArray

procedure MonthPopupClick (Sender : tObject);


procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);


procedure MouseMove(Shift: TShiftState; X, Y: Integer);

Check if mouse was pressed in Today button

procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

Check if mouse was pressed in date area

procedure Paint;


function PointInRect(const rectTest: TRect; X, Y: Integer): Boolean;

comment: FontWidth * 3 = width for 1 character

procedure RefreshPopupItems;


procedure SetColors (value: tCalendarColors);


procedure SetDate (value : tDateTime);


procedure SetDay(Days: Integer);

*************** Set Date ************************** **** This procedure adjusts the date by nDays **** **** nDays can be possitive or negative.

procedure SetKeyRepeat (value: word);


procedure SetOnlyMonth (value: boolean);


procedure SetOnlyValidDates (value: boolean);


procedure SetShowCancel (value: boolean);


procedure SetShowNumWeek (value: boolean);


procedure SetShowToday (value: boolean);


procedure SetStartOfWeek (value: TDayOfWeek);


procedure SetStartOfWeekEnd (value: TDayOfWeek);


procedure WMGetDlgCode(var Message: TWMGetDlgCode);

Protected declarations

procedure WMKillFocus(var Message: TWMKillFocus);


procedure WMSetFocus(var Message: TWMSetFocus);


procedure WMSetFont(var Message: TWMSetFont);


Properties

property About : TAboutMeProperty


property AfterNewMonth : TNewMonthEvent


property BeforeNewMonth : TNewMonthEvent


property BevelInner :


property BevelOuter :


property BorderStyle :


property Colors : TCalendarColors


property Date : TDateTime


property DayNames : TDayName


property Enabled :


property Font :


property Hint :

Published declarations

property KeyRepeat : Word


property MonthNames : TMonthName


property ParentShowHint :


property PopupMenu :


property ShowHint :


property ShowNumWeek : boolean


property ShowToday : boolean


property StartOfWeek : TDayOfWeek


property StartOfWeekEnd : TDayOfWeek


property TabOrder :


property TabStop :


property DayArray : PDayArray

properties

property MonthArray : PMonthArray


property ShowCancel : boolean


property ValidDates : tStringList


Events

event OnDateChange : TNotifyEvent


event OnDateClick : TNotifyEvent


event OnDblClick :

Some Events

event OnKeyCancel : TNotifyEvent


event OnKeyEnter : TNotifyEvent


event OnKillFocus : TNotifyEvent


event OnlyMonth : boolean


event OnlyValidDates : boolean


event OnMouseUp :


Variables

Border : integer;


ButtonHeight : integer;


ButtonWidth : integer;


CurrentDateIndex : Integer;


CurrentDay : Word;


CurrentMonth : Word;


CurrentYear : Word;


DateArray : array[1..42] of string[2];


FAbout : TAboutMeProperty;

Private declarations

FAfterNewMonth : TNewMonthEvent;

TNotifyEvent

FBeforeNewMonth : TNewMonthEvent;


FBmpToday : tBitmap;


FColors : TCalendarColors;


FDate : TDateTime;


FDayArray : TDayArray;


FDayName : TDayName;


FKeyRepeat : Word;


FMonthArray : TMonthArray;


FMonthName : TMonthName;


FMonthPopup : tPopupMenu;


FOnDateChange : TNotifyEvent;

TNotifyEvent

FOnDateClick : TNotifyEvent;


FOnKeyCancel : TNotifyEvent;


FOnKeyEnter : TNotifyEvent;


FOnKillFocus : TNotifyEvent;


FOnlyMonth : Boolean;


FOnlyValidDates : Boolean;


FontHeight : Integer;


FontWidth : Integer;


FRepeatBtn : tCalendarButtons;


FShowCancel : Boolean;


FShowNumWeek : Boolean;


FShowToday : Boolean;


FStartOfWeek : TDayOfWeek;


FStartOfWeekEnd : TDayOfWeek;


FTimer : TTimer;


FValidDates : tStringList;


IdealHeight : Word;


IdealWidth : Word;


MouseIsDown : Boolean;


NumWeekWidth : Word;


PreviousDateHighlight : Integer;


PreviousDateIndex : Integer;


PreviousDay : Word;


PreviousMonth : Word;


PreviousYear : Word;


TextIndent : integer;



Constructors


Constructor Create(AOwner:TComponent);

Public declarations

-------------------------------------------------------------} {------------------------ TCalendar97 ------------------------} {-------------------------------------------------------------


Functions


procedure AddValidDate(aDate: TDateTime);

******** Add a Date in the list of valid dates


procedure ClearValidDates;

************* Clear list of valid dates


function DateInList(aDate: TDateTime): Boolean;

******** Is the supplied data in the date list?


Destructor Destroy;

Define initial date


procedure SetIdealSize;

***************** Set Ideal Size for calendar


procedure AddPopupItems;


procedure CalTimer(Sender: TObject);

****************** CalTimer


procedure DrawButtonCancel;

****************** Draw Buttton Cancel


procedure DrawButtons;

****************** Draw Butttons


procedure DrawButtonToday;

****************** Draw Buttton Today


procedure DrawCalendarBorder;

************* Draw Calendar Border


procedure DrawDates;

********************* Draw Dates


procedure DrawDaysHeader;

********************* Draw Day Header


procedure DrawFocusFrame(Index: Integer; IsUp: boolean);

****************** Draw Focus Frame


procedure DrawMonthHeader;

****************** Draw Month Header


procedure EraseButtonCancel;

****************** Erase Button Cancel


procedure EraseButtonToday;

****************** Erase Button Today


procedure EraseDateFrame(Index: Integer);

****************** Erase Date Frame


function GetCalendarRect: TRect;

******************** Get Calendar Rectangle ******************** ***** Get the rectangle used for the calendar section *****


function GetCancelButtonRect: TRect;

****************** Get Cancel Button Rectangle ***************** ***** Get the rectangle used for the Cancel button. *****


function GetDayArray: PDayArray;


function GetDblLeftButtonRect: TRect;

******************* Get DblLeft Button Rectangle *************** ***** Get the rectangle used for the dblleft button. *****


function GetDblRightButtonRect: TRect;

****************** Get DblRight Button Rectangle *************** ***** Get the rectangle used for the dblright button. *****


Function GetGoodColor (aDate: tDateTime): tColor;

***************** GetGoodColor


function GetIndexFromPoint(Left: Integer; Top: Integer): Integer;

**************** Get Index From Point ******************


function GetLeftButtonRect: TRect;

******************* Get Left Button Rectangle ****************** ***** Get the rectangle used for the left button. *****


function GetMonthArray: PMonthArray;


function GetMonthBegin: Integer;

************************* Get Month Begin ************************** ***** This function Gets the index value of the first day of the ***** ***** month. *****


function GetMonthHeaderRect: TRect;

******************* Get Month Header Rectangle ***************** ***** Get the rectangle used for the month header. *****


function GetNextDay : Integer;

******************* Get Next Day


function GetNextMonth : Integer;

****************** Get Next Month


function GetNextWeek : Integer;

****************** Get Next Week


function GetNextYear : Integer;

****************** Get Next Year


function GetNumWeek(Date: TDateTime): Integer;

******************** GetNumWeek


function GetPrevDay : Integer;

****************** Get Previous Day


function GetPrevMonth : Integer;

****************** GetPreviousMonth


function GetPrevWeek : Integer;

****************** Get Previous Week


function GetPrevYear : Integer;

***************** GetPrevious Year


function GetRectFromIndex(Index: Integer): TRect;

****************** Get Rectangle From Index ******************** ***** Get the rectangle used for this day section *****


function GetRightButtonRect: TRect;

****************** Get Right Button Rectangle ****************** ***** Get the rectangle used for the right button. *****


function GetTodayButtonRect: TRect;

******************* Get Today Button Rectangle ***************** ***** Get the rectangle used for the Today button. *****


procedure KeyDown(var Key: Word; Shift: TShiftState);

mouse move not in calendar rect


procedure LoadDateArray;

******************** LoadDateArray


procedure MonthPopupClick (Sender : tObject);


procedure MouseDown(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);


procedure MouseMove(Shift: TShiftState; X, Y: Integer);

Check if mouse was pressed in Today button


procedure MouseUp(Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

Check if mouse was pressed in date area


procedure Paint;


function PointInRect(const rectTest: TRect; X, Y: Integer): Boolean;

comment: FontWidth * 3 = width for 1 character


procedure RefreshPopupItems;


procedure SetColors (value: tCalendarColors);


procedure SetDate (value : tDateTime);


procedure SetDay(Days: Integer);

*************** Set Date ************************** **** This procedure adjusts the date by nDays **** **** nDays can be possitive or negative. It **** **** also populates the vars YEAR, MONTH and DAY ****


procedure SetKeyRepeat (value: word);


procedure SetOnlyMonth (value: boolean);


procedure SetOnlyValidDates (value: boolean);


procedure SetShowCancel (value: boolean);


procedure SetShowNumWeek (value: boolean);


procedure SetShowToday (value: boolean);


procedure SetStartOfWeek (value: TDayOfWeek);


procedure SetStartOfWeekEnd (value: TDayOfWeek);


procedure WMGetDlgCode(var Message: TWMGetDlgCode);

Protected declarations


procedure WMKillFocus(var Message: TWMKillFocus);


procedure WMSetFocus(var Message: TWMSetFocus);


procedure WMSetFont(var Message: TWMSetFont);


Properties


property About : TAboutMeProperty


property AfterNewMonth : TNewMonthEvent


property BeforeNewMonth : TNewMonthEvent


property BevelInner :


property BevelOuter :


property BorderStyle :


property Colors : TCalendarColors


property Date : TDateTime


property DayNames : TDayName


property Enabled :


property Font :


property Hint :

Published declarations


property KeyRepeat : Word


property MonthNames : TMonthName


property ParentShowHint :


property PopupMenu :


property ShowHint :


property ShowNumWeek : boolean


property ShowToday : boolean


property StartOfWeek : TDayOfWeek


property StartOfWeekEnd : TDayOfWeek


property TabOrder :


property TabStop :


property DayArray : PDayArray

properties


property MonthArray : PMonthArray


property ShowCancel : boolean


property ValidDates : tStringList


Events


event OnDateChange : TNotifyEvent


event OnDateClick : TNotifyEvent


event OnDblClick :

Some Events


event OnKeyCancel : TNotifyEvent


event OnKeyEnter : TNotifyEvent


event OnKillFocus : TNotifyEvent


event OnlyMonth : boolean


event OnlyValidDates : boolean


event OnMouseUp :


Variables


Border : integer;


ButtonHeight : integer;


ButtonWidth : integer;


CurrentDateIndex : Integer;


CurrentDay : Word;


CurrentMonth : Word;


CurrentYear : Word;


DateArray : array[1..42] of string[2];


FAbout : TAboutMeProperty;

Private declarations


FAfterNewMonth : TNewMonthEvent;

TNotifyEvent


FBeforeNewMonth : TNewMonthEvent;


FBmpToday : tBitmap;


FColors : TCalendarColors;


FDate : TDateTime;


FDayArray : TDayArray;


FDayName : TDayName;


FKeyRepeat : Word;


FMonthArray : TMonthArray;


FMonthName : TMonthName;


FMonthPopup : tPopupMenu;


FOnDateChange : TNotifyEvent;

TNotifyEvent


FOnDateClick : TNotifyEvent;


FOnKeyCancel : TNotifyEvent;


FOnKeyEnter : TNotifyEvent;


FOnKillFocus : TNotifyEvent;


FOnlyMonth : Boolean;


FOnlyValidDates : Boolean;


FontHeight : Integer;


FontWidth : Integer;


FRepeatBtn : tCalendarButtons;


FShowCancel : Boolean;


FShowNumWeek : Boolean;


FShowToday : Boolean;


FStartOfWeek : TDayOfWeek;


FStartOfWeekEnd : TDayOfWeek;


FTimer : TTimer;


FValidDates : tStringList;


IdealHeight : Word;


IdealWidth : Word;


MouseIsDown : Boolean;


NumWeekWidth : Word;


PreviousDateHighlight : Integer;


PreviousDateIndex : Integer;


PreviousDay : Word;


PreviousMonth : Word;


PreviousYear : Word;


TextIndent : integer;