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

      發布這個控件是因為我在網上找不到支持農歷的月歷控件，就自己寫了個，希望能
  有用。

      您可以沒有任何限制的使用、修改、分發本控件。但沒有任何擔保,甚至沒有適合特
  定目的而隱含的擔保。如果您修改了本控件，煩請發一份拷貝到<LuckMiky@21cn.com> 。

      開發平臺：PWin2000Pro + Delphi 7.0

      請不要刪除本說明。

  主要功能；
  1、在日歷面板上同時顯示公歷和農歷，農歷部分僅支持公元1900.1.31到公元2100.12.31；
  2、可以定制控件界面顏色和字體，類似TmonthCalendar，可以選擇采用AAFont平滑字體
     邊緣（有點慢）；
  3、控件字體大小根據控件大小自動適應；
  4、支持鼠標和鍵盤或者代碼選擇日期；
     Home:每月的第一天      End:每月的最后一天
     PageUp: 上一個月       Page：下一個月
     四個方向鍵移動光標
  5、提供了公歷轉農歷和農歷轉公歷函數，支持干支年、月、日；函數原形及調用方法請
     看代碼。
      本單元農歷轉換部分為 Mostone.Jiang 漠石(mostone@hotmail.com)的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;