lsscalendar.pas

是一个免费并开源的支持农历的月历控件

unit LssCalendar;
(*
说明：如果你没有AAFont，请把第80行{$DEFINE AAFONT}删除；
      如果你使用的Delphi版本低于7.0，请去掉第81行{$DEFINE DELPHI5}前的注释；

                   TLssCalendar (支持农历的月历控件)
                                        Version  2.00
     2006-03-01 Ver 2.00  Luke.Wang
  主要修改；
  1。TLssCalendar 2.0向下兼容；
  2。参照控件CnCalendar，增加了月份背景显示；
  3。参照控件hxCalendar，增加了公历和农历节日显示；
  4。参照控件LunarCalendar，增加Grid和Border显示，显示提示信息窗口；
  5。将控件中的字体设置改为TLssColors属性，方便用户修改；
  6。Title栏增加了上一年、上一月、下一月、下一年快捷按钮；
  7。增加了BackImage属性，用户可以为每个月设置不同图片作为每月背景；
  8。增加了TFestivalList类，用户可以订制和标记自己的节日;
  9。可以显示英文星期名称、标题；
  10。支持ISO8601日期格式（以星期一为一周开始）;
  11。用户可以自定义公历日期与农历或节日的显示比例；
  11。根据nihaoqiang的修改，编写了DateUtils中一些function，以方便Delphi 5.0用户；
    （本控件只在Delphi7中测试过，请使用Delphi其它版本的用户帮忙测试一下）
                 

                 
      开发平台：WinXP SP2 + Delphi 7.0

      请不要删除本说明。

                                                             Luke Wang

                                                             2004.01
--------------------------------------------------------------------------------
                   TLssCalendar (支持农历的月历控件)
                                        Version  1.10

      发布这个控件是因为我在网上找不到支持农历的月历控件，就自己写了个，希望能
  有用。

      您可以没有任何限制的使用、修改、分发本控件。但没有任何担保,甚至没有适合特
  定目的而隐含的担保。如果您修改了本控件，烦请发一份拷贝到<[e-mail]> 。

      开发平台：PWin2000Pro + Delphi 7.0

      请不要删除本说明。

  主要功能；
  1、在日历面板上同时显示公历和农历，农历部分仅支持公元1900.1.31到公元2100.12.31；
  2、可以定制控件界面颜色和字体，类似TmonthCalendar，可以选择采用AAFont平滑字体
     边缘（有点慢）；
  3、控件字体大小根据控件大小自动适应；
  4、支持鼠标和键盘或者代码选择日期；
     Home:每月的第一天      End:每月的最后一天
     PageUp: 上一个月       Page：下一个月
     四个方向键移动光标
  5、提供了公历转农历和农历转公历函数，支持干支年、月、日；函数原形及调用方法请
     看代码。
      本单元农历转换部分为 Mostone.Jiang 漠石([e-mail])的CnBase.pas,
  作了一点小小改动。由于控件字体过小，采用了 ***与月共舞工作室 周劲羽*** 的
  AAFont 来平滑字体显示，在此感谢2位，提供了这么好的东西给我们免费使用！


                                                              Miky

                                                             2004.01

     更新历史：
     2004-4-24  Ver 1.10  
                修正了网友happylife发现的Bug;
                修改了Paint部分，不再使用DoubleBuffered,显示速度有很大改观;
                添加了干支记日显示方式选项；
                添加了keypress,keydown,keyup事件；
                添加了编译指令{DEFINE AAFONT}，如果你没有AAFont，请把第49行删除

     2004-1-15  Ver 1.00
                发布于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  //农历日期
    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;   //月倒数第几个星期

  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);
      // 取得新历节日
    function GetSolarFtv(TheDate: TDate; var fcolor: TColor): string; overload;
    function GetSolarFtv(TheDate: TDate): string; overload;
      // 取得农历节日
    function GetLunarFtv(TheDate: ThzDate; var fcolor: TColor): string; overload;
    function GetLunarFtv(TheDate: ThzDate): string; overload;
      // 取得周节日
    function GetWeekFtv(TheDate: TDate; var fcolor: TColor): string; overload;
    function GetWeekFtv(TheDate: TDate): string; overload;
      // 取得新历标记
    function GetSolarMark(TheDate: TDate): TColor;
      // 取得农历标记
    function GetLunarMark(TheDate: ThzDate): TColor;
      // 取得周标记
    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;            //月历当前指向的日期
    FYear: Word;
    FMonth: Word;
    FDay: Word;
    FCalColors: TLssCalColors;
    {$IFDEF AAFONT}
    FSmoothText: Boolean;      //平滑字体标志
    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;         //标题区
    FWeekRect: TRect;          //星期区
    FDaysRect: TRect;          //日期区
    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;   //最大可显示节日字符串长度

    FOnChange: TNotifyEvent;
    procedure CalcRect;        //计算各区以及字体大小
    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;
    //返回农历 y年的总天数
    function DaysOfLunarYear(y: integer): integer;
    //返回农历 y年闰月的天数
    function daysofleapMonth(y: integer): integer;
    //返回农历 y年闰哪个月 1-12 , 没闰返回 0
    function leapMonth(y: integer): integer;
    //返回农历 y年m月的总天数
    function Daysofmonth(y, m: integer): integer;
    //算出农历, 传入公历日期, 返回农历日期
    function ToLunar(TheDate: TDate): THzDate;
    //传入干支y年,返回生肖
    function GetAnimal(y: integer): string;
    //传入 offset 返回干支, 0=甲子
    function cyclical(num: integer): string;
    //算出公历, 传入农历日期控件, 返回公历
    function ToGreg(objDate: THzDate): TDate;
    //检查农历日期是否合法
    function ChkHzDate(objDate: THzDate): Boolean;
    //某年的第n个节气为几日(从0小寒起算)
    function sTerm(y, n: integer): TDateTime;
    //求年柱，月柱，日柱TheDate为当天的公历日期)
    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;
    // 取得指定日期的节气
    function GetJQ(TheDate: TDate): string;
      // 取得指定日期的节日
    function GetFtv(TheDate: TDate): string; overload;
    function GetFtv(TheDate: TDate; var fcolor: TColor): string; overload;
      // 取得指定日期的标记
    function GetMark(TheDate: TDate): TColor;
    //根据公历日期，返回星座
    function Constellation(TheDate: TDate): String;
    //返回当日所在周数
    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;