注册 登录  
 加关注
   显示下一条  |  关闭
温馨提示!由于新浪微博认证机制调整,您的新浪微博帐号绑定已过期,请重新绑定!立即重新绑定新浪微博》  |  关闭

鑫淼梦园的博客

圆你的梦想 从这里开始

 
 
 

日志

 
 

【转载】中国农历算法(delphi)  

2014-05-02 15:53:17|  分类: delphi xe5 |  标签: |举报 |字号 订阅

  下载LOFTER 我的照片书  |
本文转载自智能双色球《中国农历算法(delphi)》

// 节日算法 请参见 《农历与西历对照、万年历》
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; 
              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. 

//////////////////////////  应用 /////////////////////////////
uses CNYear;
procedure TForm1.Button1Click(Sender: TObject);
begin
  edit1.text:=GregDateToCNStr(DateTimePicker1.date);
end;
  评论这张
 
阅读(131)| 评论(0)
推荐 转载

历史上的今天

在LOFTER的更多文章

评论

<#--最新日志,群博日志--> <#--推荐日志--> <#--引用记录--> <#--博主推荐--> <#--随机阅读--> <#--首页推荐--> <#--历史上的今天--> <#--被推荐日志--> <#--上一篇,下一篇--> <#-- 热度 --> <#-- 网易新闻广告 --> <#--右边模块结构--> <#--评论模块结构--> <#--引用模块结构--> <#--博主发起的投票-->
 
 
 
 
 
 
 
 
 
 
 
 
 
 

页脚

网易公司版权所有 ©1997-2017