?? lsscalendar.pas
字號(hào):
unit LssCalendar;
(*
說(shuō)明：如果你沒(méi)有AAFont，請(qǐng)把第80行{$DEFINE AAFONT}刪除；
如果你使用的Delphi版本低于7.0，請(qǐng)去掉第81行{$DEFINE DELPHI5}前的注釋；
TLssCalendar (支持農(nóng)歷的月歷控件)
Version 2.00
2006-03-01 Ver 2.00 Luke.Wang
主要修改；
1。TLssCalendar 2.0向下兼容；
2。參照控件CnCalendar，增加了月份背景顯示；
3。參照控件hxCalendar，增加了公歷和農(nóng)歷節(jié)日顯示；
4。參照控件LunarCalendar，增加Grid和Border顯示，顯示提示信息窗口；
5。將控件中的字體設(shè)置改為TLssColors屬性，方便用戶修改；
6。Title欄增加了上一年、上一月、下一月、下一年快捷按鈕；
7。增加了BackImage屬性，用戶可以為每個(gè)月設(shè)置不同圖片作為每月背景；
8。增加了TFestivalList類，用戶可以訂制和標(biāo)記自己的節(jié)日;
9?？梢燥@示英文星期名稱、標(biāo)題；
10。支持ISO8601日期格式（以星期一為一周開始）;
11。用戶可以自定義公歷日期與農(nóng)歷或節(jié)日的顯示比例；
11。根據(jù)nihaoqiang的修改，編寫了DateUtils中一些function，以方便Delphi 5.0用戶；
（本控件只在Delphi7中測(cè)試過(guò)，請(qǐng)使用Delphi其它版本的用戶幫忙測(cè)試一下）
開發(fā)平臺(tái)：WinXP SP2 + Delphi 7.0
請(qǐng)不要?jiǎng)h除本說(shuō)明。
Luke Wang
2004.01
--------------------------------------------------------------------------------
TLssCalendar (支持農(nóng)歷的月歷控件)
Version 1.10
發(fā)布這個(gè)控件是因?yàn)槲以诰W(wǎng)上找不到支持農(nóng)歷的月歷控件，就自己寫了個(gè)，希望能
有用。
您可以沒(méi)有任何限制的使用、修改、分發(fā)本控件。但沒(méi)有任何擔(dān)保,甚至沒(méi)有適合特
定目的而隱含的擔(dān)保。如果您修改了本控件，煩請(qǐng)發(fā)一份拷貝到<LuckMiky@21cn.com> 。
開發(fā)平臺(tái)：PWin2000Pro + Delphi 7.0
請(qǐng)不要?jiǎng)h除本說(shuō)明。
主要功能；
1、在日歷面板上同時(shí)顯示公歷和農(nóng)歷，農(nóng)歷部分僅支持公元1900.1.31到公元2100.12.31；
2、可以定制控件界面顏色和字體，類似TmonthCalendar，可以選擇采用AAFont平滑字體
邊緣（有點(diǎn)慢）；
3、控件字體大小根據(jù)控件大小自動(dòng)適應(yīng)；
4、支持鼠標(biāo)和鍵盤或者代碼選擇日期；
Home:每月的第一天 End:每月的最后一天
PageUp: 上一個(gè)月 Page：下一個(gè)月
四個(gè)方向鍵移動(dòng)光標(biāo)
5、提供了公歷轉(zhuǎn)農(nóng)歷和農(nóng)歷轉(zhuǎn)公歷函數(shù)，支持干支年、月、日；函數(shù)原形及調(diào)用方法請(qǐng)
看代碼。
本單元農(nóng)歷轉(zhuǎn)換部分為 Mostone.Jiang 漠石(mostone@hotmail.com)的CnBase.pas,
作了一點(diǎn)小小改動(dòng)。由于控件字體過(guò)小，采用了 ***與月共舞工作室 周勁羽*** 的
AAFont 來(lái)平滑字體顯示，在此感謝2位，提供了這么好的東西給我們免費(fèi)使用！
Miky
2004.01
更新歷史：
2004-4-24 Ver 1.10
修正了網(wǎng)友happylife發(fā)現(xiàn)的Bug;
修改了Paint部分，不再使用DoubleBuffered,顯示速度有很大改觀;
添加了干支記日顯示方式選項(xiàng)；
添加了keypress,keydown,keyup事件；
添加了編譯指令{DEFINE AAFONT}，如果你沒(méi)有AAFont，請(qǐng)把第49行刪除
2004-1-15 Ver 1.00
發(fā)布于Delphi盒子；
*)
interface
{$DEFINE AAFONT} {disable this statement if component AAFont is not installed}
//{$DEFINE DELPHI5} {enable this statement if used in Delphi 5}
uses
SysUtils, Classes, Controls, Graphics {$IFNDEF DELPHI5}, Types, DateUtils{$ENDIF}, Windows, Messages
{$IFDEF AAFONT}, AAFont{$ENDIF}, ExtCtrls, StdCtrls, Forms, SysConst;
type
TCalendarHint = Class(TCustomControl)
Private
FAlpha: Integer;
FStrings, FNames: TStringlist;
FMaxNameLen: Integer;
Procedure CMTextChanged(Var Message: TMessage); Message CM_TEXTCHANGED;
Procedure SetAlpha(Value: Integer);
Procedure WMNCHitTest(Var Message: TWMNCHitTest); Message WM_NCHITTEST;
Protected
Procedure CreateParams(Var Params: TCreateParams); Override;
Procedure Paint; Override;
Procedure SetLayeredAttribs;
Public
Constructor Create(AOwner: TComponent); Override;
Destructor Destroy; Override;
Procedure SetPosition;
Published
Property Alpha: Integer Read FAlpha Write SetAlpha;
End;
THzDate = record //農(nóng)歷日期
Year: integer;
Month: integer;
Day: integer;
isLeap: Boolean; //閏月
end;
TGzDate = record //干支日期
Year: integer;
Month: integer;
Day: integer;
end;
TLssCalendar = class;
TLssCalStyle = (csBottom,csRight,csNone);
TLssCalColors = class(TPersistent)
private
Owner: TLssCalendar;
FTitleBackColor: TColor;
FWeekBackColor: TColor;
FDayBackColor: TColor;
FTrailingTextColor: TColor;
FLunarTermColor: TColor;
FSundayColor: TColor;
FSaturdayColor :TColor;
FHightlightBackColor: TColor;
FHightlightTextColor: TColor;
FBorderColor: TColor;
FGridColor: TColor;
FArrowColor: TColor;
FTitleTextFont: TFont;
FWeekTextFont: TFont;
FDayTextFont: TFont;
FLunarTextFont: TFont;
FFtvTextFont: TFont;
FBackMonthTextFont: TFont;
procedure SetColor(Index: Integer; Value: TColor);
procedure SetFont(Index: Integer; Value: TFont);
public
Constructor Create(AOwner: TLssCalendar);
Destructor Destroy; Override;
procedure Assign(Source: TPersistent); override;
published
property TitleBackColor: TColor index 0 read FTitleBackColor write SetColor default clActiveCaption;
property WeekBackColor: TColor index 1 read FWeekBackColor write SetColor default clWindow;
property DayBackColor: TColor index 2 read FDayBackColor write SetColor default clWindow;
property TrailingTextColor: TColor index 3 read FTrailingTextColor write SetColor default clInactiveCaptionText;
property LunarTermColor: TColor index 4 read FLunarTermColor write SetColor default clPurple;
property SundayColor: TColor index 5 read FSunDayColor write SetColor default clRed;
property SaturdayColor: TColor index 6 read FSaturdayColor write SetColor default clMaroon;
property HightlightBackColor: TColor index 7 read FHightlightBackColor write SetColor default clActiveCaption;
property HightlightTextColor: TColor index 8 read FHightlightTextColor write SetColor default clWhite;
property BorderColor: TColor index 9 read FBorderColor write SetColor default $808080;
property GridColor: TColor index 10 read FGridColor write SetColor default $C0C0C0;
property ArrowColor: TColor index 11 read FArrowColor write SetColor default clWhite;
property TitleTextFont: TFont index 0 read FTitleTextFont write SetFont;
property WeekTextFont: TFont index 1 read FWeekTextFont write SetFont;
property DayTextFont: TFont index 2 read FDayTextFont write SetFont;
property LunarTextFont: TFont index 3 read FLunarTextFont write SetFont;
property FtvTextFont: TFont index 4 read FFtvTextFont write SetFont;
property BackMonthTextFont: TFont index 5 read FBackMonthTextFont write SetFont;
end;
TFestivalList = class(TPersistent)
private
Owner: TLssCalendar;
FSolarFestivals: TStringList;
FLunarFestivals: TStringList;
FWeekFestivals: TStringList;
FSolarMarks: TStringList;
FLunarMarks: TStringList;
FWeekMarks: TStringList;
procedure SetFestivals(Index: Integer; Value:TStringList);
procedure SetMarks(Index: Integer; Value:TStringList);
{$IFDEF DELPHI5}
function NthDayOfWeek(const AValue: TDateTime): Word;
{$ENDIF}
function NthRevDayOfWeek(const AValue: TDateTime): Word; //月倒數(shù)第幾個(gè)星期
public
Constructor Create(AOwner: TLssCalendar);
Destructor Destroy; Override;
procedure Assign(Source: TPersistent); override;
procedure clearAll();
function addFestival(Index: Integer; const fdate: string; const fname: string; const fcolor: TColor = clRed): Boolean;
procedure delFestival(Index: Integer; const fdate: string);
function addMark(Index: Integer; const fdate: string; const fcolor: TColor = clYellow): Boolean;
procedure delMark(Index: Integer; const fdate: string);
// 取得新歷節(jié)日
function GetSolarFtv(TheDate: TDate; var fcolor: TColor): string; overload;
function GetSolarFtv(TheDate: TDate): string; overload;
// 取得農(nóng)歷節(jié)日
function GetLunarFtv(TheDate: ThzDate; var fcolor: TColor): string; overload;
function GetLunarFtv(TheDate: ThzDate): string; overload;
// 取得周節(jié)日
function GetWeekFtv(TheDate: TDate; var fcolor: TColor): string; overload;
function GetWeekFtv(TheDate: TDate): string; overload;
// 取得新歷標(biāo)記
function GetSolarMark(TheDate: TDate): TColor;
// 取得農(nóng)歷標(biāo)記
function GetLunarMark(TheDate: ThzDate): TColor;
// 取得周標(biāo)記
function GetWeekMark(TheDate: TDate): TColor;
published
property SolarFestivals: TStringList index 0 read FSolarFestivals write SetFestivals;
property LunarFestivals: TStringList index 1 read FLunarFestivals write SetFestivals;
property WeekFestivals: TStringList index 2 read FWeekFestivals write SetFestivals;
property SolarMarks: TStringList index 0 read FSolarMarks write SetMarks;
property LunarMarks: TStringList index 1 read FLunarMarks write SetMarks;
property WeekMarks: TStringList index 2 read FWeekMarks write SetMarks;
end;
TLssCalendar = class(TCustomControl)
private
FViewDate: TDate; //月歷當(dāng)前指向的日期
FYear: Word;
FMonth: Word;
FDay: Word;
FCalColors: TLssCalColors;
{$IFDEF AAFONT}
FSmoothText: Boolean; //平滑字體標(biāo)志
FShadowFont: Boolean; //字體陰影
{$ENDIF}
FChineseEar: Boolean; //是否使用干支記日
FLunarCalStyle: TLssCalStyle;
FFtvCalStyle: TLssCalStyle;
FFtvList: TFestivalList;
FShowVertical: Boolean;
FShowBackMonth: Boolean;
FShowBackImage: Boolean;
FShowArrow: Boolean;
FUseISO8601: Boolean; //是否以星期一作為一周開始
FVerticalScale: Real;
FHorizonScale: Real;
FAutoFontSize: Boolean;
FBackImage: TImage;
FShowBorder: Boolean;
FShowGrid: Boolean;
FEnWeekName: Boolean;
CHint: TCalendarHint;
FFirstDate: TDate; //月歷第一格日期
FTitleRect: TRect; //標(biāo)題區(qū)
FWeekRect: TRect; //星期區(qū)
FDaysRect: TRect; //日期區(qū)
FOldRect: TRect;
FOldViewRect: TRect;
FSolarRect: TRect;
FLunarRect: TRect;
FFtvRect: TRect;
FPrevYearRect: TRect;
FPrevMonthRect: TRect;
FNextMonthRect: TRect;
FNextYearRect: TRect;
FNeedUpdate :Boolean;
FCellWidth: integer;
FCellHeight: integer;
MaxFtvLen: integer; //最大可顯示節(jié)日字符串長(zhǎng)度
FOnChange: TNotifyEvent;
procedure CalcRect; //計(jì)算各區(qū)以及字體大小
function CalcDayRect(ADate:TDate):TRect;
procedure GetFirstDay;
function GetMaxTextSize(S:String;W,H:integer):integer;
procedure UpdateHighlight(X, Y: Integer);
{$IFDEF AAFONT}
procedure SetSmoothText(Value:Boolean);
procedure SetShadowFont(Value:Boolean);
{$ENDIF}
procedure SetDate(Value: TDate);
procedure SetYear(Value: Word);
procedure SetMonth(Value: Word);
procedure SetDay(Value: Word);
procedure SetUseISO8601(Value:Boolean);
procedure SetCalColors(Value: TLssCalColors);
procedure SetFtvList(Value: TFestivalList);
procedure SetLunarCalStyle(Value: TLssCalStyle);
procedure SetFtvCalStyle(Value: TLssCalStyle);
procedure SetShowVertical(Value:Boolean);
procedure SetChineseEar(Value:Boolean);
procedure SetShowBackMonth(Value:Boolean);
procedure SetShowBackImage(Value:Boolean);
procedure SetShowArrow(Value:Boolean);
procedure SetVerticalScale(Value:Real);
procedure SetHorizonScale(Value:Real);
procedure SetAutoFontSize(Value:Boolean);
procedure SetBackImage(Value: TImage);
procedure SetShowBorder(Value:Boolean);
procedure SetShowGrid(Value:Boolean);
procedure SetEnWeekName(Value:Boolean);
protected
{ Protected declarations }
procedure CreateWnd; override;
procedure Paint; override;
procedure Resize; override;
procedure KeyDown( var Key: Word; Shift: TShiftState ); override;
procedure MouseDown( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); override;
procedure MouseMove( Shift: TShiftState; X, Y: Integer ); override;
Procedure MouseLeave(Var Msg: TMessage); Message CM_MOUSELEAVE;
procedure MouseUp( Button: TMouseButton; Shift: TShiftState; X, Y: Integer ); override;
procedure CMWantSpecialKey(var Message: TCMWantSpecialKey); message CM_WANTSPECIALKEY;
procedure Changed; dynamic;
public
constructor Create( AOwner: TComponent ); override;
destructor Destroy; override;
//返回農(nóng)歷 y年的總天數(shù)
function DaysOfLunarYear(y: integer): integer;
//返回農(nóng)歷 y年閏月的天數(shù)
function daysofleapMonth(y: integer): integer;
//返回農(nóng)歷 y年閏哪個(gè)月 1-12 , 沒(méi)閏返回 0
function leapMonth(y: integer): integer;
//返回農(nóng)歷 y年m月的總天數(shù)
function Daysofmonth(y, m: integer): integer;
//算出農(nóng)歷, 傳入公歷日期, 返回農(nóng)歷日期
function ToLunar(TheDate: TDate): THzDate;
//傳入干支y年,返回生肖
function GetAnimal(y: integer): string;
//傳入 offset 返回干支, 0=甲子
function cyclical(num: integer): string;
//算出公歷, 傳入農(nóng)歷日期控件, 返回公歷
function ToGreg(objDate: THzDate): TDate;
//檢查農(nóng)歷日期是否合法
function ChkHzDate(objDate: THzDate): Boolean;
//某年的第n個(gè)節(jié)氣為幾日(從0小寒起算)
function sTerm(y, n: integer): TDateTime;
//求年柱，月柱，日柱TheDate為當(dāng)天的公歷日期)
function GetGZ(TheDate: TDate): TGzDate;
//取漢字日期
function FormatLunarDay(day:integer): string;
//漢字月份
function FormatLunarMonth(month:integer;isLeap:boolean): string;
//漢字年份
function FormatLunarYear(year:integer): string;
//漢字星期幾
function FormatWeekDay(WeekDay:integer): string;
// 取得指定日期的節(jié)氣
function GetJQ(TheDate: TDate): string;
// 取得指定日期的節(jié)日
function GetFtv(TheDate: TDate): string; overload;
function GetFtv(TheDate: TDate; var fcolor: TColor): string; overload;
// 取得指定日期的標(biāo)記
function GetMark(TheDate: TDate): TColor;
//根據(jù)公歷日期，返回星座
function Constellation(TheDate: TDate): String;
//返回當(dāng)日所在周數(shù)
function WeekOfYear(TheDate: TDate): integer;
//返回英文星期縮寫或全名
function WeekEnName(aWeekDay: Integer; longNameFormat: boolean = false): string;
//返回英文月份縮寫或全名
function MonthEnName(aMonth: Integer; longNameFormat: Boolean = false): string;
property Year: Word read FYear write SetYear;
property Month: Word read FMonth write SetMonth;
property Day: Word read FDay write SetDay;
{$IFDEF DELPHI5}
function DateOf(const AValue: TDateTime): TDateTime;
function YearOf(const AValue: TDateTime): Word;
function MonthOf(const AValue: TDateTime): Word;
function DayOf(const AValue: TDateTime): Word;
function IncDay(const AValue: TDateTime; const ANumberOfDays: Integer = 1): TDateTime;
function DaysBetween(const ANow, AThen: TDateTime): Integer;
function IncMilliSecond(const AValue: TDateTime; const ANumberOfMilliSeconds: Int64 = 1): TDateTime;
function EncodeDateTime(const AYear, AMonth, ADay, AHour, AMinute, ASecond, AMilliSecond: Word):TDateTime;
function DaysInAMonth(const AYear, AMonth: Word): Word;
function WeekOfTheYear(const AValue: TDateTime): Word;
function WeeksInYear(const AValue: TDateTime): Word;
function DayOfTheWeek(const AValue: TDateTime): Word;
function IncYear(const AValue: TDateTime; const ANumberOfYears: Integer = 1): TDateTime;
{$ENDIF}
published
{ Published declarations }
property Align;
property Anchors;
property BevelEdges;
property BevelInner;
property BevelOuter;
property BevelKind;
property BevelWidth;
property BorderWidth;
property CalColors: TLssCalColors read FCalColors write SetCalColors;
?? 快捷鍵說(shuō)明
復(fù)制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號(hào)
Ctrl + =
減小字號(hào)
Ctrl + -