当前页面位置: » 丰搜网 » 文档中心 » 详细内容
日历函数单元
致看到这些源代码的兄弟:
你好!
这本来是我为一个商业pda产品开发的日历程序,最近移植于pc机上, 所以算法
和数据部分是用纯c++写的,不涉及mfc,所有的代码都是以短节省存储空间为主要目
的.
很高兴你对这些代码有兴趣,你可以随意复制和使用些代码,唯一有一点小小的
愿望:在你使用和复制给别人时,别忘注明这些代码作者:-)。程序代码也就罢了,后
面的数据可是我辛辛苦苦从万年历上找出来输进去的。
如果你有什么好的意见不妨mail给我。
wangfei@hanwang.com.cn
或
wangfei@engineer.com.cn
2000年3月
****************************************************************************/
//translated and modified by icebird from c++ to delphi 5 on 2001.1
unit calendar;
interface
uses sysutils, windows;
const
start_year = 1901;
end_year = 2050;
// ==> function isleapyear(year: word): boolean;
//计算iyear,imonth,iday对应是星期几 1年1月1日 --- 65535年12月31日
function weekday(iyear, imonth, iday: word): integer;
// ==> function dayofweek(date: tdatetime): integer;
//计算指定日期的周数，周0为新年开始后第一个星期天开始的周
function weeknum(const tdt: tdatetime): word; overload;
function weeknum(const iyear, imonth, iday: word): word; overload;
//返回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 getlunardate(iyear, imonth, iday: word; var ilunaryear, ilunarmonth, ilunarday: word): word; overload;
procedure getlunardate(indate: tdatetime; var ilunaryear, ilunarmonth, ilunarday: word); overload;
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;
//计算指定日期所对应的星座
function getconstellation(const datetime: tdatetime): integer;
function getconstellationname(const constellation: integer): string; overload;
function getconstellationname(const datetime: tdatetime): string; overload;
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 weekday(iyear, imonth, iday: word): integer;
begin
result := dayofweek(encodedate(iyear, imonth, iday));
end;
function weeknum(const tdt: tdatetime): word;
var
y, m, d: word;
dttmp: tdatetime;
begin
decodedate(tdt, y, m, d);
dttmp := encodedate(y, 1, 1);
result := (trunc(tdt - dttmp) + (dayofweek(dttmp) - 1)) div 7;
if result = 0 then
result := 51
else
result := result - 1;
end;
function weeknum(const iyear, imonth, iday: word): word;
begin
result := weeknum(encodedate(iyear, imonth, iday));
end;
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;
function getlunardate(iyear, imonth, iday: word; var ilunaryear, ilunarmonth, ilunarday: word): word;
begin
l_calclunardate(ilunaryear, ilunarmonth, ilunarday, calcdatediff(iyear, imonth, iday));
result := l_getlunarholday(iyear, imonth, iday);
end;
procedure getlunardate(indate: tdatetime; var ilunaryear, ilunarmonth, ilunarday: word);
begin
l_calclunardate(ilunaryear, ilunarmonth, ilunarday, calcdatediff(indate, encodedate(start_year, 1, 1)));
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
result := ';
end;
end;
function getlunarholday(iyear, imonth, iday: word): string;
begin
result := getlunarholday(encodedate(iyear, imonth, iday));
end;
function getconstellation(const datetime: tdatetime): integer;
var
y, m, d: word;
begin
decodedate(datetime, y, m, d);
y := m * 100 + d;
if (y >= 321) and (y <= 419) then
result := 0
else
if (y >= 420) and (y <= 520) then
result := 1
else
if (y >= 521) and (y <= 620) then
result := 2
else
if (y >= 621) and (y <= 722) then
result := 3
else
if (y >= 723) and (y <= 822) then
result := 4
else
if (y >= 823) and (y <= 922) then
result := 5
else
if (y >= 923) and (y <= 1022) then
result := 6
else
if (y >= 1023) and (y <= 1121) then
result := 7
else
if (y >= 1122) and (y <= 1221) then
result := 8
else
if (y >= 1222) or (y <= 119) then
result := 9
else
if (y >= 120) and (y <= 218) then
result := 10
else
if (y >= 219) and (y <= 320) then
result := 11
else
result := -1;
end;
function getconstellationname(const constellation: integer): string;
begin
case constellation of
0: result := '白羊座';
1: result := '金牛座';
2: result := '双子座';
3: result := '巨蟹座';
4: result := '狮子座';
5: result := '处女座';
6: result := '天秤座';
7: result := '天蝎座';
8: result := '射手座';
9: result := '摩羯座';
10: result := '水瓶座';
11: result := '双鱼座';
else
result := ';
end;
end;
function getconstellationname(const datetime: tdatetime): string;
begin
result := getconstellationname(getconstellation(datetime));
end;
end.
