Class TODCustomCalendar (unit ODCalend)

Inherits from

TCustomPanel

Constructors


constructor Create(AOwner: TComponent);

TODCustomCalendar


Functions

function DaysInMonth(AMonth, AYear: Integer): Integer;


destructor Destroy;


procedure Loaded;


function MonthToWeek(AMonth: Integer): Integer;

convert to days

function WeeksInYear(AYear: Integer): Integer;


function WeekToMonth(AWeek: Integer): Integer;

get weeks in year

function AdjustForWeekStart(ADayNo: Integer): Integer;

procedure TODCustomCalendar.

procedure BtnClick(Sender: TObject);


procedure DoChange;

procedure StartDragDrop(Sender, Source: TObject; X, Y: Integer); procedure FinishDragDrop(Sender, Source: TObject; X, Y: Integer); procedure DoHeaderPopup(Sender: TObject);

procedure TODCustomCalendar.


procedure DoDayDblClick(Sender: TObject);

then go forward a year

procedure DoDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);


procedure DoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

belongs to next year

procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);


procedure MonthItemClick(Sender: TObject);


procedure MonthMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

to end of week

procedure ResetTitleBtns;

if not SingleDate then

procedure Resize;

function TODCustomCalendar.

procedure SetBlank;

this year

procedure SetupMonth;


procedure ThisMonthClick(Sender: TObject);


procedure YearMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

a finish date click

function GetAbout: string;


function GetBevelEdge: TPanelBevel;


function GetDisplayDate: TDateTime;


function GetFinishFont: TFont;


function GetPanelDate(Panel: TPanel): TDateTime;


function GetShowStatus: Boolean;

function GetFramed: Boolean; procedure SetFramed(Value: Boolean);

function GetStartFont: TFont;

FHeaderPanel.

function GetTitleFont: TFont;


procedure SetAbout(Value: string);


procedure SetBevelEdge(Value: TPanelBevel);


procedure SetDateFormat(const Value: string);


procedure SetDayColor(Value: TColor);

function TODCustomCalendar.

procedure SetDisplayDate(Value: TDateTime);


procedure SetDisplayMonth(Value: Integer);


procedure SetDisplayYear(Value: Integer);


procedure SetFinishDate(Value: TDateTime);


procedure SetFinishFont(Value: TFont);


procedure SetRangeColor(Value: TColor);


procedure SetShowStatus(Value: Boolean);


procedure SetSingleDate(Value: Boolean);


procedure SetStartDate(Value: TDateTime);

function GetDisplayWeek: Integer; procedure SetDisplayWeek(Value: Integer);

procedure SetStartFont(Value: TFont);


procedure SetStartOnMonday(Value: Boolean);

update caption

procedure SetTitleFont(Value: TFont);

Result := FHeaderPanel.

procedure SetTodayColor(Value: TColor);


procedure SetWeekColor(Value: TColor);


procedure WMMove(var Msg: TWMMove);


Properties

property About : string


property Height :


property Width :


property AutoPage : Boolean


property BevelEdge : TPanelBevel


property DateFormat : string


property DayColor : TColor

property DisplayWeek: Integer read GetDisplayWeek write SetDisplayWeek;

property DisplayDate : TDateTime


property DisplayMonth : Integer


property DisplayYear : Integer


property FinishDate : TDateTime


property FinishFont : TFont


property Headers : TODCalendarHeaders

property Framed: Boolean read GetFramed write SetFramed default True;

property RangeColor : TColor


property ShowStatus : Boolean


property SingleDate : Boolean


property StartDate : TDateTime


property StartFont : TFont


property StartOnMonday : Boolean


property TitleFont : TFont


property TodayColor : TColor


property WeekColor : TColor


Events

event OnChange : TNotifyEvent


event OnDayDblClick : TODDateEvent


event OnFinishClick : TODSelectDateEvent


event OnSelectYear : TODSelectYearEvent


event OnSetupDay : TODSetupDayEvent


event OnStartClick : TODSelectDateEvent


Variables

FAutoPage : Boolean;


FDateFormat : string;


FDayColor : TColor;


FDays : array[0..5, 0..6] of TPanel;


FDisplayMonth : Integer;


FDisplayYear : Integer;


FFinishDate : TDateTime;


FFinishPanel : TPanel;


FFooterPanel : TPanel;


FGridPanel : TPanel;


FHeaderPanel : TPanel;


FHeaders : TODCalendarHeaders;


FHeadings : array[0..7] of TPanel;


FMonthBtn : TSpeedButton;


FNextMonthBtn : TSpeedButton;


FNextYearBtn : TSpeedButton;


FOldFinishDate : TDateTime;


FOldStartDate : TDateTime;


FOnChange : TNotifyEvent;


FOnDayDblClick : TODDateEvent;


FOnFinishClick : TODSelectDateEvent;


FOnSelectYear : TODSelectYearEvent;


FOnSetupDay : TODSetupDayEvent;


FOnStartClick : TODSelectDateEvent;


FPaging : Boolean;


FPrevMonthBtn : TSpeedButton;


FPrevYearBtn : TSpeedButton;

FHeaderPopup: TPopupMenu;

FRangeColor : TColor;


FSingleDate : Boolean;


FStartDate : TDateTime;


FStartOnMonday : Boolean;


FStartPanel : TPanel;


FTodayColor : TColor;


FWeekColor : TColor;


FWeeks : array[0..5] of TPanel;


FYearBtn : TSpeedButton;



Constructors


constructor Create(AOwner: TComponent);

TODCustomCalendar


Functions


function DaysInMonth(AMonth, AYear: Integer): Integer;


destructor Destroy;


procedure Loaded;


function MonthToWeek(AMonth: Integer): Integer;

convert to days


function WeeksInYear(AYear: Integer): Integer;


function WeekToMonth(AWeek: Integer): Integer;

get weeks in year


function AdjustForWeekStart(ADayNo: Integer): Integer;

procedure TODCustomCalendar.SetDisplayDay(Value: Integer); begin if Value < 1 then FDisplayDay := 1 else if Value > DaysInMonth(FDisplayMonth, FDisplayYear) then FDisplayDay := DaysInMonth(FDisplayMonth, FDisplayYear) else FDisplayDay := Value; SetupMonth; end;


procedure BtnClick(Sender: TObject);


procedure DoChange;

procedure StartDragDrop(Sender, Source: TObject; X, Y: Integer); procedure FinishDragDrop(Sender, Source: TObject; X, Y: Integer); procedure DoHeaderPopup(Sender: TObject);

procedure TODCustomCalendar.StartDragDrop(Sender, Source: TObject; X, Y: Integer); begin SetStartDate(GetPanelDate(Source as TPanel)); end; procedure TODCustomCalendar.FinishDragDrop(Sender, Source: TObject; X, Y: Integer); begin SetFinishDate(GetPanelDate(Source as TPanel)); end;


procedure DoDayDblClick(Sender: TObject);

then go forward a year


procedure DoDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);


procedure DoMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

belongs to next year


procedure DoMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);


procedure MonthItemClick(Sender: TObject);


procedure MonthMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

to end of week


procedure ResetTitleBtns;

if not SingleDate then


procedure Resize;

function TODCustomCalendar.GetFramed: Boolean; begin Result := BorderWidth > 1; end; procedure TODCustomCalendar.SetFramed(Value: Boolean); begin if Value <> Framed then begin if Value then begin BevelOuter := bvRaised; BevelInner := bvLowered; BorderWidth := 1; Height := Height + 6; Width := Width + 6; end else begin BevelOuter := bvNone; BevelInner := bvNone; BorderWidth := 0; Height := Height - 6; Width := Width - 6; end; end; end;


procedure SetBlank;

this year


procedure SetupMonth;


procedure ThisMonthClick(Sender: TObject);


procedure YearMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);

a finish date click


function GetAbout: string;


function GetBevelEdge: TPanelBevel;


function GetDisplayDate: TDateTime;


function GetFinishFont: TFont;


function GetPanelDate(Panel: TPanel): TDateTime;


function GetShowStatus: Boolean;

function GetFramed: Boolean; procedure SetFramed(Value: Boolean);


function GetStartFont: TFont;

FHeaderPanel.Font.Assign(Value);


function GetTitleFont: TFont;


procedure SetAbout(Value: string);


procedure SetBevelEdge(Value: TPanelBevel);


procedure SetDateFormat(const Value: string);


procedure SetDayColor(Value: TColor);

function TODCustomCalendar.GetDisplayWeek: Integer; begin Result := MonthToWeek(DisplayMonth); end; procedure TODCustomCalendar.SetDisplayWeek(Value: Integer); var tw: Integer; begin tw := WeeksInYear(FDisplayYear); if Value < 1 then Value := 1 else if Value > tw then Value := tw; SetDisplayMonth(WeekToMonth(Value)); end; procedure TODCustomCalendar.DoHeaderPopup(Sender: TObject); var yr, mo, dy: Word; begin with Sender as TPopupMenu do begin DecodeDate(Date, yr, mo, dy); Items[0].Enabled := (FDisplayMonth <> mo) or (FDisplayYear <> yr); Items[FDisplayMonth + 1].Checked := True; end; end;


procedure SetDisplayDate(Value: TDateTime);


procedure SetDisplayMonth(Value: Integer);


procedure SetDisplayYear(Value: Integer);


procedure SetFinishDate(Value: TDateTime);


procedure SetFinishFont(Value: TFont);


procedure SetRangeColor(Value: TColor);


procedure SetShowStatus(Value: Boolean);


procedure SetSingleDate(Value: Boolean);


procedure SetStartDate(Value: TDateTime);

function GetDisplayWeek: Integer; procedure SetDisplayWeek(Value: Integer);


procedure SetStartFont(Value: TFont);


procedure SetStartOnMonday(Value: Boolean);

update caption


procedure SetTitleFont(Value: TFont);

Result := FHeaderPanel.Font;


procedure SetTodayColor(Value: TColor);


procedure SetWeekColor(Value: TColor);


procedure WMMove(var Msg: TWMMove);


Properties


property About : string


property Height :


property Width :


property AutoPage : Boolean


property BevelEdge : TPanelBevel


property DateFormat : string


property DayColor : TColor

property DisplayWeek: Integer read GetDisplayWeek write SetDisplayWeek;


property DisplayDate : TDateTime


property DisplayMonth : Integer


property DisplayYear : Integer


property FinishDate : TDateTime


property FinishFont : TFont


property Headers : TODCalendarHeaders

property Framed: Boolean read GetFramed write SetFramed default True;


property RangeColor : TColor


property ShowStatus : Boolean


property SingleDate : Boolean


property StartDate : TDateTime


property StartFont : TFont


property StartOnMonday : Boolean


property TitleFont : TFont


property TodayColor : TColor


property WeekColor : TColor


Events


event OnChange : TNotifyEvent


event OnDayDblClick : TODDateEvent


event OnFinishClick : TODSelectDateEvent


event OnSelectYear : TODSelectYearEvent


event OnSetupDay : TODSetupDayEvent


event OnStartClick : TODSelectDateEvent


Variables


FAutoPage : Boolean;


FDateFormat : string;


FDayColor : TColor;


FDays : array[0..5, 0..6] of TPanel;


FDisplayMonth : Integer;


FDisplayYear : Integer;


FFinishDate : TDateTime;


FFinishPanel : TPanel;


FFooterPanel : TPanel;


FGridPanel : TPanel;


FHeaderPanel : TPanel;


FHeaders : TODCalendarHeaders;


FHeadings : array[0..7] of TPanel;


FMonthBtn : TSpeedButton;


FNextMonthBtn : TSpeedButton;


FNextYearBtn : TSpeedButton;


FOldFinishDate : TDateTime;


FOldStartDate : TDateTime;


FOnChange : TNotifyEvent;


FOnDayDblClick : TODDateEvent;


FOnFinishClick : TODSelectDateEvent;


FOnSelectYear : TODSelectYearEvent;


FOnSetupDay : TODSetupDayEvent;


FOnStartClick : TODSelectDateEvent;


FPaging : Boolean;


FPrevMonthBtn : TSpeedButton;


FPrevYearBtn : TSpeedButton;

FHeaderPopup: TPopupMenu;


FRangeColor : TColor;


FSingleDate : Boolean;


FStartDate : TDateTime;


FStartOnMonday : Boolean;


FStartPanel : TPanel;


FTodayColor : TColor;


FWeekColor : TColor;


FWeeks : array[0..5] of TPanel;


FYearBtn : TSpeedButton;