精华公布栏

发信人: wpf (I'llTouchTheBlueSky), 信区: BorlandDev
标  题: 阴阳历转换
发信站: 哈工大紫丁香 (2001年10月11日17:00:26 星期四), 站内信件

发信人: lauhy (  ), 信区: Delphi
标  题: Re: 请问各位大虾哪有阳历转阴历的资料？
发信站: BBS 水木清华站 (Thu Oct 11 16:29:15 2001)

还真挺好用，可惜只能支持到2051年，我想这也足够用了吧。
那人说这个算法是"暴力法"，赫赫，
不过总比将农历公历一一对应存到数组中"温柔"多了吧。
Look!

  unit unit2;
  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;
                end;
                iDayLeave := iDayLeave - wCount;
            end;
            wBigSmallDist := wBigSmallDist shr 1;
        end;
    end;
  //返回值:
  // 1位闰月标志 + 12位年份+4位月份+5位日期             (共22位)
  end;
  function isCNLeap(cnDate:TCNDate):boolean;
  begin
    result := (cnDate and $200000) <> 0;
  end;
  function GetGregDateFromCN(cnYear,cnMonth,cnDay:word;bLeap:
Boolean=False):
TDateTime;
  var
    i,j:integer;
    DayCount:integer;
    wBigSmallDist,wLeap,wLeapShift:WORD;
  begin
    // 0101 010010101111     高四位是闰月位置,后12位表示大小月,大月30天

//,小月29天,
    DayCount := 0;
    if (cnYear < 1990) or (cnYear >2050) then begin
        Result := 0;
        Exit;

    end;
    for i:= cstCNYearOrg to cnYear-1 do begin
          wBigSmallDist := cstCNTable[i];
          if (wBIgSmallDist and $F000) <> 0 then DayCount := DayCount
+ 29;
          DayCount := DayCount + 12 * 29;
          for j:= 1 to 12 do begin
              DayCount := DayCount + wBigSmallDist and 1;
              wBigSmallDist := wBigSmallDist shr 1;
          end;
    end;
    wBigSmallDist := cstCNTable[cnYear];
    wLeap := wBigSmallDist shr 12;
    if wLeap > 12 then begin
        wLeap := wLeap and 7;
        wLeapShift := 1;                       //大月在闰月.
    end else
        wLeapShift := 0;
    for j:= 1 to cnMonth-1 do begin
        DayCount:=DayCount + (wBigSmallDist and 1) + 29;
        if j=wLeap then DayCount := DayCount + 29;
        wBigSmallDist := wBigSmallDist shr 1;
    end;
    if bLeap and (cnMonth = wLeap)   then   //是要闰月的吗?
        DayCount := DayCount + 30 - wLeapShift;
    result := cstDateOrg + DayCount + cnDay - 1;
  end;
  //将日期显示成农历字符串.
  function GregDateToCNStr(dtGreg:TDateTime):String;
  const hzNumber:array[0..10] of string=('零','一','二','三','四','五',

'六',
'七','八','九','十');
  function ConvertYMD(Number:Word;YMD:Word):string;
  var
    wTmp:word;
  begin

    result := '';
    if YMD = 1 then begin //年份
        while Number > 0 do begin
            result := hzNumber[Number Mod 10] + result;
            Number := Number DIV 10;
        end;
        Exit;
    end;
    if Number<=10 then begin   //可只用1位
        if YMD = 2 then //月份
            result := hzNumber[Number]
        else                       //天
            result := '初' + hzNumber[Number];
        Exit;
    end;
    wTmp := Number Mod 10;   //个位
    if wTmp <> 0 then result := hzNumber[wTmp];
    wTmp := Number Div 10;           //十位
    result:='十'+result;
    if wTmp > 1 then   result := hzNumber[wTmp] + result;
  end;
  var
    cnYear,cnMonth,cnDay:word;
    cnDate:TCNDate;
    strLeap:string;
  begin
    cnDate:= DecodeGregToCNDate(dtGreg);
    if cnDate = 0 then begin
        result := '输入越界';
        Exit;
    end;
    cnDay := cnDate and $1F;

    cnMonth := (cnDate shr 5) and $F;
    cnYear := (cnDate shr 9) and $FFF;
    //测试第22位,为1表示闰月
    if isCNLeap(cnDate) then strLeap:='(闰)' else   strLeap := '';
    result := '农历' + ConvertYMD(cnYear,1) + '年' +
ConvertYMD(cnMonth,2) +'月' + strLeap + ConvertYMD(cnDay,3) ;
  end;
  end.

【在 specialyang (wo ) 的大作中提到: 】
: 几乎每本数据结构的书上都有，
: 实在不行自己写一下吧，呵呵。初中的同学最会计算了。呵呵

--

--
据说呆娃儿不笨

※ 来源:·哈工大紫丁香 bbs.hit.edu.cn·[FROM: 202.118.245.178]