中国农历算法(delphi)[1]

// 节日算法 请参见 《农历与西历对照、万年历》
unit cnyear;

interface

uses sysutils;

type tcndate = cardinal;

function decodegregtocndate(dtgreg:tdatetime):tcndate;
function getgregdatefromcn(cnyear,cnmonth,cnday:word;bleap:boolean=false):tdatetime;
function gregdatetocnstr(dtgreg:tdatetime):string;
function iscnleap(cndate:tcndate):boolean;

implementation

const cstdateorg:integer=32900; //公历1990-01-27的tdatetime表示 对应农历1990-01-01
const cstcnyearorg=1990;
const cstcntable:array[cstcnyearorg..cstcnyearorg + 60] of word=(       //   unsigned 16-bit
24402, 3730, 3366, 13614, 2647, 35542, 858, 1749,           //1997
23401, 1865, 1683, 19099, 1323, 2651, 10926, 1386,           //2005
32213, 2980, 2889, 23891, 2709, 1325, 17757, 2741,           //2013
39850, 1490, 3493, 61098, 3402, 3221, 19102, 1366,           //2021
2773, 10970, 1746, 26469, 1829, 1611, 22103, 3243,           //2029
1370, 13678, 2902, 48978, 2898, 2853, 60715, 2635,           //2037
1195, 21179, 1453, 2922, 11690, 3474, 32421, 3365,           //2045
2645, 55901, 1206, 1461, 14038);                             //2050
//建表方法：
// 0101 111101010010     高四位是闰月位置,后12位表示大小月,大月30天,小月29天,
//闰月一般算小月,但是有三个特例2017/06,2036/06,2047/05
//对于特例则高四位的闰月位置表示法中的最高为设置为1 特殊处理用wleapnormal变量
// //2017/06 28330->61098 2036/06 27947->60715 2047/05 23133->55901

//如果希望用汇编,这里有一条信息:农历不会滞后公历2个月.
//将公历转换为农历
//返回:12位年份+4位月份+5位日期
function decodegregtocndate(dtgreg:tdatetime):tcndate;
var
  idayleave:integer;
  wyear,wmonth,wday:word;
  i,j:integer;
  wbigsmalldist,wleap,wcount,wleapshift:word;
label ok;
begin
  result := 0;
  idayleave := trunc(dtgreg) - cstdateorg;
  decodedate(incmonth(dtgreg,-1),wyear,wmonth,wday);
  if (idayleave < 0) or (idayleave > 22295 )then exit;
              //raise exception.create('目前只能算1990-01-27以后的');
              //raise exception.create('目前只能算2051-02-11以前的');
  for i:=low(cstcntable)   to high(cstcntable) do begin
      wbigsmalldist := cstcntable[i];
      wleap := wbigsmalldist shr 12;
      if wleap > 12 then begin
          wleap := wleap and 7;
          wleapshift := 1;
      end else
          wleapshift := 0;
      for j:=1 to 12 do begin
          wcount:=(wbigsmalldist and 1) + 29;
          if j=wleap then wcount := wcount - wleapshift;
          if idayleave < wcount   then begin
              result := (i shl 9) + (j shl 5) + idayleave + 1;
              exit;
          end;
          idayleave := idayleave - wcount;
          if j=wleap then begin
              wcount:=29 + wleapshift;
              if idayleave < wcount   then begin
                  result := (i shl 9) + (j shl 5) + idayleave + 1 + (1 shl 21);
                  exit;