公历农历转换

公历农历转换 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; 字串4 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天 字串4 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 字串6 $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 字串5 $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 字串2 $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 字串8 $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 字串1 $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 字串1 $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 字串5 $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 字串2 $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 字串3 $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 字串2 $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 字串7 $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; 字串1 iBit:Integer; begin if iLunarYear 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:=?甲乙丙丁戊己庚辛壬癸?; 字串2 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:=?十一? 字串2 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,i StartDay)); 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); 字串7 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 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; 字串3 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:=?小 雪?; 字串2 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.