用Delphi处理公历到农历的转换

{=========================================================================
   功  能: 用Delphi处理公历到农历的转换
   时  间: SilverLong 2005/10/09
   版  本: 1.0
   备  注:
=========================================================================}

unit CalendarToLunarDay;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, Grids, DBGrids,ShellAPI,TlHelp32;

const
        START_YEAR=1901;
        END_YEAR=2050;

  //返回iYear年iMonth月的天数 1年1月 --- 65535年12月
  function MonthDays(iYear,iMonth:Word):Word;

  //返回阴历iLunarYer年阴历iLunarMonth月的天数，如果iLunarMonth为闰月，
  //高字为第二个iLunarMonth月的天数，否则高字为0 1901年1月---2050年12月
  function LunarMonthDays(iLunarYear,iLunarMonth:Word):Longword;

  //返回阴历iLunarYear年的总天数 1901年1月---2050年12月
  function LunarYearDays(iLunarYear:Word):Word;

 //返回阴历iLunarYear年的闰月月份，如没有返回0 1901年1月---2050年12月
 function GetLeapMonth(iLunarYear:Word):Word;

 //把iYear年格式化成天干记年法表示的字符串
 procedure FormatLunarYear(iYear:Word;var pBuffer:string);overload;
 function FormatLunarYear(iYear:Word):string;overload;

 //把iMonth格式化成中文字符串
 procedure FormatMonth(iMonth:Word;var pBuffer:string;bLunar:Boolean=True);overload;
 function FormatMonth(iMonth:Word;bLunar:Boolean=True):string;overload;

 //把iDay格式化成中文字符串
 procedure FormatLunarDay(iDay:Word;var pBuffer:string);overload;
 function FormatLunarDay(iDay:Word):string;overload;

 //计算公历两个日期间相差的天数 1年1月1日 --- 65535年12月31日
 function CalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word=START_YEAR;iStartMonth:Word=
    1;iStartDay:Word=1):Longword;overload;
 function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;overload;

 //计算公历iYear年iMonth月iDay日对应的阴历日期,返回对应的阴历节气 0-24
 //1901年1月1日---2050年12月31日

 function GetLunarHolDay(InDate:TDateTime):string;overload;
 function GetLunarHolDay(iYear,iMonth,iDay:Word):string;overload;

 //private function--------------------------------------

 //计算从1901年1月1日过iSpanDays天后的阴历日期
 procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword);

 //计算公历iYear年iMonth月iDay日对应的节气 0-24，0表不是节气
 function l_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;

implementation

var
        //数组gLunarDay存入阴历1901年到2100年每年中的月天数信息，
        //阴历每月只能是29或30天，一年用12（或13）个二进制位表示，对应位为1表30天，否则为29天
        gLunarMonthDay:array[0..149] of Word=(
                //测试数据只有1901.1.1 --2050.12.31
                $4ae0, $a570, $5268, $d260, $d950, $6aa8, $56a0, $9ad0, $4ae8, $4ae0, //1910
                $a4d8, $a4d0, $d250, $d548, $b550, $56a0, $96d0, $95b0, $49b8, $49b0, //1920
                $a4b0, $b258, $6a50, $6d40, $ada8, $2b60, $9570, $4978, $4970, $64b0, //1930
                $d4a0, $ea50, $6d48, $5ad0, $2b60, $9370, $92e0, $c968, $c950, $d4a0, //1940
                $da50, $b550, $56a0, $aad8, $25d0, $92d0, $c958, $a950, $b4a8, $6ca0, //1950
                $b550, $55a8, $4da0, $a5b0, $52b8, $52b0, $a950, $e950, $6aa0, $ad50, //1960
                $ab50, $4b60, $a570, $a570, $5260, $e930, $d950, $5aa8, $56a0, $96d0, //1970
                $4ae8, $4ad0, $a4d0, $d268, $d250, $d528, $b540, $b6a0, $96d0, $95b0, //1980
                $49b0, $a4b8, $a4b0, $b258, $6a50, $6d40, $ada0, $ab60, $9370, $4978, //1990
                $4970, $64b0, $6a50, $ea50, $6b28, $5ac0, $ab60, $9368, $92e0, $c960, //2000
                $d4a8, $d4a0, $da50, $5aa8, $56a0, $aad8, $25d0, $92d0, $c958, $a950, //2010
                $b4a0, $b550, $b550, $55a8, $4ba0, $a5b0, $52b8, $52b0, $a930, $74a8, //2020
                $6aa0, $ad50, $4da8, $4b60, $9570, $a4e0, $d260, $e930, $d530, $5aa0, //2030
                $6b50, $96d0, $4ae8, $4ad0, $a4d0, $d258, $d250, $d520, $daa0, $b5a0, //2040
                $56d0, $4ad8, $49b0, $a4b8, $a4b0, $aa50, $b528, $6d20, $ada0, $55b0); //2050

        //数组gLanarMonth存放阴历1901年到2050年闰月的月份，如没有则为0，每字节存两年
        gLunarMonth:array[0..74] of Byte=(
                $00, $50, $04, $00, $20, //1910
                $60, $05, $00, $20, $70, //1920
                $05, $00, $40, $02, $06, //1930
                $00, $50, $03, $07, $00, //1940
                $60, $04, $00, $20, $70, //1950
                $05, $00, $30, $80, $06, //1960
                $00, $40, $03, $07, $00, //1970
                $50, $04, $08, $00, $60, //1980
                $04, $0a, $00, $60, $05, //1990
                $00, $30, $80, $05, $00, //2000
                $40, $02, $07, $00, $50, //2010
                $04, $09, $00, $60, $04, //2020
                $00, $20, $60, $05, $00, //2030
                $30, $b0, $06, $00, $50, //2040
                $02, $07, $00, $50, $03); //2050

//数组gLanarHoliDay存放每年的二十四节气对应的阳历日期
//每年的二十四节气对应的阳历日期几乎固定，平均分布于十二个月中
// 1月 2月 3月 4月 5月 6月
//小寒 大寒 立春 雨水 惊蛰 春分 清明 谷雨 立夏 小满 芒种 夏至
// 7月 8月 9月 10月 11月 12月
//小暑 大暑 立秋 处暑 白露 秋分 寒露 霜降 立冬 小雪 大雪 冬至
{*********************************************************************************
节气无任何确定规律,所以只好存表,要节省空间,所以....
**********************************************************************************}
//数据格式说明:
//如1901年的节气为
// 1月 2月 3月 4月 5月 6月 7月 8月 9月 10月 11月 12月
// 6, 21, 4, 19, 6, 21, 5, 21, 6,22, 6,22, 8, 23, 8, 24, 8, 24, 8, 24, 8, 23, 8, 22
// 9, 6, 11,4, 9, 6, 10,6, 9,7, 9,7, 7, 8, 7, 9, 7, 9, 7, 9, 7, 8, 7, 15
//上面第一行数据为每月节气对应日期,15减去每月第一个节气,每月第二个节气减去15得第二行
// 这样每月两个节气对应数据都小于16,每月用一个字节存放,高位存放第一个节气数据,低位存放
//第二个节气的数据,可得下表
        gLunarHolDay:array[0..1799] of Byte=(
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1901
                $96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1902
                $96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1903
                $86, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //1904
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1905
                $96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1906
                $96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1907
                $86, $A5, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1908
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1909
                $96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1910
                $96, $A5, $87, $96, $87, $87, $79, $69, $69, $69, $78, $78, //1911
                $86, $A5, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1912
                $95, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1913
                $96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1914
                $96, $A5, $97, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1915
                $96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1916
                $95, $B4, $96, $A6, $96, $97, $78, $79, $78, $69, $78, $87, //1917
                $96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $77, //1918
                $96, $A5, $97, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1919
                $96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1920
                $95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $87, //1921
                $96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $77, //1922
                $96, $A4, $96, $96, $97, $87, $79, $79, $69, $69, $78, $78, //1923
                $96, $A5, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1924
                $95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $87, //1925
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1926
                $96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1927
                $96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1928
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1929
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1930
                $96, $A4, $96, $96, $97, $87, $79, $79, $79, $69, $78, $78, //1931
                $96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1932
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1933
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1934
                $96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1935
                $96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1936
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1937
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1938
                $96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1939
                $96, $A5, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1940
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1941
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1942
                $96, $A4, $96, $96, $97, $97, $79, $79, $79, $69, $78, $78, //1943
                $96, $A5, $96, $A5, $A6, $96, $88, $78, $78, $78, $87, $87, //1944
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1945
                $95, $B4, $96, $A6, $97, $97, $78, $79, $78, $69, $78, $77, //1946
                $96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1947
                $96, $A5, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1948
                $A5, $B4, $96, $A5, $96, $97, $88, $79, $78, $79, $77, $87, //1949
                $95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $77, //1950
                $96, $B4, $96, $A6, $97, $97, $79, $79, $79, $69, $78, $78, //1951
                $96, $A5, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1952
                $A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1953
                $95, $B4, $96, $A5, $96, $97, $78, $79, $78, $68, $78, $87, //1954
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1955
                $96, $A5, $A5, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1956
                $A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1957
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1958
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1959
                $96, $A4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1960
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1961
                $96, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1962
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1963
                $96, $A4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1964
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1965
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1966
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1967
                $96, $A4, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1968
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1969
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1970
                $96, $B4, $96, $A6, $97, $97, $78, $79, $79, $69, $78, $77, //1971
                $96, $A4, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1972
                $A5, $B5, $96, $A5, $A6, $96, $88, $78, $78, $78, $87, $87, //1973
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1974
                $96, $B4, $96, $A6, $97, $97, $78, $79, $78, $69, $78, $77, //1975
                $96, $A4, $A5, $B5, $A6, $A6, $88, $89, $88, $78, $87, $87, //1976
                $A5, $B4, $96, $A5, $96, $96, $88, $88, $78, $78, $87, $87, //1977
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //1978
                $96, $B4, $96, $A6, $96, $97, $78, $79, $78, $69, $78, $77, //1979
                $96, $A4, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1980
                $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $77, $87, //1981
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1982
                $95, $B4, $96, $A5, $96, $97, $78, $79, $78, $69, $78, $77, //1983
                $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //1984
                $A5, $B4, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //1985
                $A5, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //1986
                $95, $B4, $96, $A5, $96, $97, $88, $79, $78, $69, $78, $87, //1987
                $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1988
                $A5, $B4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1989
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //1990
                $95, $B4, $96, $A5, $86, $97, $88, $78, $78, $69, $78, $87, //1991
                $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1992
                $A5, $B3, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //1993
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1994
                $95, $B4, $96, $A5, $96, $97, $88, $76, $78, $69, $78, $87, //1995
                $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //1996
                $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //1997
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //1998
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //1999
                $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2000
                $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2001
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2002
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //2003
                $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2004
                $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2005
                $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2006
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $69, $78, $87, //2007
                $96, $B4, $A5, $B5, $A6, $A6, $87, $88, $87, $78, $87, $86, //2008
                $A5, $B3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2009
                $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2010
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $78, $87, //2011
                $96, $B4, $A5, $B5, $A5, $A6, $87, $88, $87, $78, $87, $86, //2012
                $A5, $B3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2013
                $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2014
                $95, $B4, $96, $A5, $96, $97, $88, $78, $78, $79, $77, $87, //2015
                $95, $B4, $A5, $B4, $A5, $A6, $87, $88, $87, $78, $87, $86, //2016
                $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2017
                $A5, $B4, $A6, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2018
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //2019
                $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $86, //2020
                $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2021
                $A5, $B4, $A5, $A5, $A6, $96, $88, $88, $88, $78, $87, $87, //2022
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $79, $77, $87, //2023
                $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2024
                $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2025
                $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2026
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2027
                $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2028
                $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2029
                $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2030
                $A5, $B4, $96, $A5, $96, $96, $88, $78, $78, $78, $87, $87, //2031
                $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2032
                $A5, $C3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $86, //2033
                $A5, $B3, $A5, $A5, $A6, $A6, $88, $78, $88, $78, $87, $87, //2034
                $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2035
                $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2036
                $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $86, //2037
                $A5, $B3, $A5, $A5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2038
                $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2039
                $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $78, $87, $96, //2040
                $A5, $C3, $A5, $B5, $A5, $A6, $87, $88, $87, $78, $87, $86, //2041
                $A5, $B3, $A5, $B5, $A6, $A6, $88, $88, $88, $78, $87, $87, //2042
                $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2043
                $95, $B4, $A5, $B4, $A5, $A6, $97, $87, $87, $88, $87, $96, //2044
                $A5, $C3, $A5, $B4, $A5, $A6, $87, $88, $87, $78, $87, $86, //2045
                $A5, $B3, $A5, $B5, $A6, $A6, $87, $88, $88, $78, $87, $87, //2046
                $A5, $B4, $96, $A5, $A6, $96, $88, $88, $78, $78, $87, $87, //2047
                $95, $B4, $A5, $B4, $A5, $A5, $97, $87, $87, $88, $86, $96, //2048
                $A4, $C3, $A5, $A5, $A5, $A6, $97, $87, $87, $78, $87, $86, //2049
                $A5, $C3, $A5, $B5, $A6, $A6, $87, $88, $78, $78, $87, $87); //2050

function MonthDays(iYear,iMonth:Word):Word;
begin
        case iMonth of
                1,3,5,7,8,10,12: Result:=31;
                4,6,9,11: Result:=30;
                2://如果是闰年
                if IsLeapYear(iYear) then
                        Result:=29
                else
                        Result:=28
                else
                        Result:=0;
        end;
end;

function GetLeapMonth(iLunarYear:Word):Word;
var
        Flag:Byte;
begin
        Flag:=gLunarMonth[(iLunarYear-START_YEAR) div 2];
        if (iLunarYear-START_YEAR) mod 2=0 then
                Result:=Flag shr 4
        else
                Result:=Flag and $0F;
end;

function LunarMonthDays(iLunarYear,iLunarMonth:Word):Longword;
var
        Height,Low:Word;
        iBit:Integer;
begin
        if iLunarYear<START_YEAR then
        begin
                Result:=30;
                Exit;
        end;
        Height:=0;
        Low:=29;
        iBit:=16-iLunarMonth;
        if (iLunarMonth>GetLeapMonth(iLunarYear)) and (GetLeapMonth(iLunarYear)>0) then
                Dec(iBit);
        if (gLunarMonthDay[iLunarYear-START_YEAR] and (1 shl iBit))>0 then
                Inc(Low);
        if iLunarMonth=GetLeapMonth(iLunarYear) then
        if (gLunarMonthDay[iLunarYear-START_YEAR] and (1 shl (iBit-1)))>0 then
                Height:=30
        else
                Height:=29;
        Result:=MakeLong(Low,Height);
end;

function LunarYearDays(iLunarYear:Word):Word;
var
        Days,i:Word;
        tmp:Longword;
begin
        Days:=0;
        for i:=1 to 12 do
        begin
                tmp:=LunarMonthDays(iLunarYear,i);
                Days:=Days+HiWord(tmp);
                Days:=Days+LoWord(tmp);
        end;
        Result:=Days;
end;

procedure FormatLunarYear(iYear:Word;var pBuffer:string);
var
        szText1,szText2,szText3:string;
begin
        szText1:='甲乙丙丁戊己庚辛壬癸';
        szText2:='子丑寅卯辰巳午未申酉戌亥';
        szText3:='鼠牛虎免龙蛇马羊猴鸡狗猪';
        pBuffer:=Copy(szText1,((iYear-4) mod 10)*2+1,2);
        pBuffer:=pBuffer+Copy(szText2,((iYear-4) mod 12)*2+1,2);
        pBuffer:=pBuffer+' ';
        pBuffer:=pBuffer+Copy(szText3,((iYear-4) mod 12)*2+1,2);
        pBuffer:=pBuffer+'年';
end;

function FormatLunarYear(iYear:Word):string;
var
        pBuffer:string;
begin
        FormatLunarYear(iYear,pBuffer);
        Result:=pBuffer;
end;

procedure FormatMonth(iMonth:Word;var pBuffer:string;bLunar:Boolean);
var
        szText:string;
begin
        if (not bLunar) and (iMonth=1) then
        begin
                pBuffer:='一月';
                Exit;
        end;
       
        szText:='正二三四五六七八九十';

        if iMonth<=10 then
        begin
                pBuffer:=' ';
                pBuffer:=pBuffer+Copy(szText,(iMonth-1)*2+1,2);
                pBuffer:=pBuffer+'月';
                Exit;
        end;

        if iMonth=11 then
                pBuffer:='十一'
        else
                pBuffer:='十二';
        pBuffer:=pBuffer+'月';
end;

function FormatMonth(iMonth:Word;bLunar:Boolean):string;
var
        pBuffer:string;
begin
        FormatMonth(iMonth,pBuffer,bLunar);
        Result:=pBuffer;
end;

procedure FormatLunarDay(iDay:Word;var pBuffer:string);
var
        szText1,szText2:string;
begin
        szText1:='初十廿三';
        szText2:='一二三四五六七八九十';
        if (iDay<>20) and (iDay<>30) then
        begin
                pBuffer:=Copy(szText1,((iDay-1) div 10)*2+1,2);
                pBuffer:=pBuffer+Copy(szText2,((iDay-1) mod 10)*2+1,2);
        end else
        begin
                pBuffer:=Copy(szText1,(iDay div 10)*2+1,2);
                pBuffer:=pBuffer+'十';
        end;
end;

function FormatLunarDay(iDay:Word):string;
var
        pBuffer:string;
begin
        FormatLunarDay(iDay,pBuffer);
        Result:=pBuffer;
end;

function CalcDateDiff(iEndYear,iEndMonth,iEndDay:Word;iStartYear:Word;
        iStartMonth:Word;iStartDay:Word):Longword;
begin
        Result:=Trunc(EncodeDate(iEndYear,iEndMonth,iEndDay)
                -EncodeDate(iStartYear,iStartMonth,iStartDay));
end;

function CalcDateDiff(EndDate,StartDate:TDateTime):Longword;
begin
        Result:=Trunc(EndDate-StartDate);
end;

procedure l_CalcLunarDate(var iYear,iMonth,iDay:Word;iSpanDays:Longword);
var
        tmp:Longword;
begin
        //阳历1901年2月19日为阴历1901年正月初一
        //阳历1901年1月1日到2月19日共有49天
        if iSpanDays<49 then
        begin
                iYear:=START_YEAR-1;
                if iSpanDays<19 then
                begin
                        iMonth:=11;
                        iDay:=11+Word(iSpanDays);
                end else
                begin
                        iMonth:=12;
                        iDay:=Word(iSpanDays)-18;
                end;
                Exit;
        end;
        //下面从阴历1901年正月初一算起
        iSpanDays:=iSpanDays-49;
        iYear:=START_YEAR;
        iMonth:=1;
        iDay:=1;
        //计算年
        tmp:=LunarYearDays(iYear);
        while iSpanDays>=tmp do
        begin
                iSpanDays:=iSpanDays-tmp;
                Inc(iYear);
                tmp:=LunarYearDays(iYear);
        end;
        //计算月
        tmp:=LoWord(LunarMonthDays(iYear,iMonth));
        while iSpanDays>=tmp do
        begin
                iSpanDays:=iSpanDays-tmp;
                if iMonth=GetLeapMonth(iYear) then
                begin
                        tmp:=HiWord(LunarMonthDays(iYear,iMonth));
                        if iSpanDays<tmp then Break;
                        iSpanDays:=iSpanDays-tmp;
                end;
                Inc(iMonth);
                tmp:=LoWord(LunarMonthDays(iYear,iMonth));
        end;
        //计算日
        iDay:=iDay+Word(iSpanDays);
end;

function l_GetLunarHolDay(iYear,iMonth,iDay:Word):Word;
var
        Flag:Byte;
        Day:Word;
begin
        Flag:=gLunarHolDay[(iYear-START_YEAR)*12+iMonth-1];
        if iDay<15 then
                Day:=15-((Flag shr 4) and $0f)
        else
                Day:=(Flag and $0f)+15;
        if iDay=Day then
                if iDay>15 then
                        Result:=(iMonth-1)*2+2
                else
                        Result:=(iMonth-1)*2+1
        else
                Result:= 0;
end;

function GetLunarHolDay(InDate:TDateTime):string;
var
        i,iYear,iMonth,iDay:Word;
begin
        DecodeDate(InDate,iYear,iMonth,iDay);
        i:=l_GetLunarHolDay(iYear,iMonth,iDay);
        case i of
                1:Result:='小 寒';
                2:Result:='大 寒';
                3:Result:='立 春';
                4:Result:='雨 水';
                5:Result:='惊 蛰';
                6:Result:='春 分';
                7:Result:='清 明';
                8:Result:='谷 雨';
                9:Result:='立 夏';
                10:Result:='小 满';
                11:Result:='芒 种';
                12:Result:='夏 至';
                13:Result:='小 暑';
                14:Result:='大 暑';
                15:Result:='立 秋';
                16:Result:='处 暑';
                17:Result:='白 露';
                18:Result:='秋 分';
                19:Result:='寒 露';
                20:Result:='霜 降';
                21:Result:='立 冬';
                22:Result:='小 雪';
                23:Result:='大 雪';
                24:Result:='冬 至';
        else
                l_CalcLunarDate(iYear,iMonth,iDay,CalcDateDiff(InDate,EncodeDate(START_YEAR,1,1)));
                Result := trim(FormatMonth(iMonth) + FormatLunarDay(iDay));
        end;
end;

function GetLunarHolDay(iYear,iMonth,iDay:Word):string;
begin
        Result:=GetLunarHolDay(EncodeDate(iYear,iMonth,iDay));
end;

end.