用Delphi處理公曆到農曆的轉換 (轉)

gugu99發表於2008-01-25
用Delphi處理公曆到農曆的轉換 (轉)[@more@]  const
 START_YEAR=1901;
 END_YEAR=2050;

//返回iYear年iMonth月的天數 1年1月 --- 65535年12月
function MonthDays(iYear,iMonth:):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, //
 $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 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 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.

來自 “ ITPUB部落格 ” ,連結:http://blog.itpub.net/10748419/viewspace-998405/,如需轉載,請註明出處,否則將追究法律責任。

相關文章