• 首页
  
  ASP
• ASP.NET
  
  CSS
• JSP
  
  Javascript
• MsSQL
  
  MySQL
• php
  
  网页
• XML
  
  培训
• Linux
  
  系统
• 办公
  
  问答
• 安全
  
  服务器

• 路由器
• 交换机
• 处理器
• 存储
• 安全
• 解决方案
• 应用案例
• 数字化
• 采购
• 芯片
• 测试
• 中小企业
• 网络
• ERP
• 资讯
• 行业
• 技术
• 软件
• 应用
• OS
• PS
• 网页
• 其它

日历函数单元

   致看到这些源代码的兄弟:
       你好!
       这本来是我为一个商业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.

• · 在Delphi中如何控制其它应用程序窗口
• · 装扮工具提示条
• · 如何在状态栏中加入图标（或图片），还有动态的时间
• · 利用Delphi编写Windows外壳扩展
• · 利用未公开函数实现Shell操作监视
• · 利用Delphi消息处理建立类似Windows开始菜单
• · Delphi中的图形显示技巧
• · Form产生时的事件次序；
• · Delphi中布尔类型辨析
• · AccesS密码的打击
• · Delphi嵌入式汇编一例
• · 在Delphi中实现任意形状的窗体
• · sql server 2005中的DDL触发器
• · asp.net 2.0下嵌套masterpage页的可视化编辑
• · PHP程序加速探索之缓存输出
• · 用C#代码编写的SN快速输入工具
• · (PHP)模板引擎Smarty介绍
• · 用PHP操纵Oracle的LOB类型的数据
• · C# 2.0中泛型编程初级入门教程
• · asp.net 2.0中加密web.config
• · ADO.NET操纵数据库
• · 关于asp.net c#中对cookie的操作
• · asp.net 2.0里当readonly遇上enableviewstate=false
• · C# 2.0与泛型
• · 让3721也无奈的弹出窗口（代码）
• · 玩透9种网页弹出窗口(精)
• · 网站左右两边浮动广告JS代码
• · 一个IP只提示一次设为首页的代码
• · 常用ASP脚本程序集锦*精（适合初学者）
• · 鼠标自动移动/点击
• · PHP程序加速探索之加速工具软件
• · SQLServer2000数据访问基类
• · 图解MySQL数据库的安装和操作
• · 一些ASP初学者常用的代码
• · ASP经典问答收藏之一
• · 一段防注入的通用脚本
• · 简单的防盗链（代码）
• · PHP窜红：革命尚未成功 Java仍需努力
• · 使用PHP编写基于Web的文件管理系统
• · 理解PHP中的MVC编程之控制器
• · 理解PHP中的MVC编程之MVC框架简介
• · SQL Server Express 数据库自动部署问题及解决
• · 用PHP文件上传的具体思路及实现
• · 回顾与展望PHP 5.0的变化与PHP 6.0展望
• · 一个产生中文累计数的代码片断
• · 在SQL Server 2005中解决死锁
• · 30分钟正则表达式指导
• · 不算不知道 44% 数据库开发者使用MySQL
• · 立即释放.net下的com组件
• · XHTML的目标,规则和细节
• · SQL Server 2005 提供的分页查询支持
• · ASP.NET程序中常用的三十三种代码
• · Sql server存储过程和C#分页类简化你的代码
• · SQL Server 2005新功能-TSQL
• · 在SQL Server 2005中编辑SQL Server 2000 DTS
• · .NET 连接到 Oracle的oci.dll加载错误解决方案
• · 如何在调用线程的时候传递参数
• · 专家预言：PHP将比Java更好更受欢迎
• · 在IIS6.0下ASP .NET 的版本冲突问题
• · 解决SqlTransaction用尽的问题（SQL处理超时）