bestlong 怕失憶論壇

 

 

搜索
bestlong 怕失憶論壇 論壇 Delphi 星期、天干地支、二十八星宿計算公式
查看: 7094|回復: 0
go

星期、天干地支、二十八星宿計算公式 [複製鏈接]

Rank: 9Rank: 9Rank: 9

1#
發表於 2006-6-23 16:46 |只看該作者 |倒序瀏覽 |打印
1. 求星期公式
星期=[5+A(實際天數)] mod 7

2. 干支計算公式
六十甲子干支序號,从1->59->0。
六十甲子干支序號=[23+A(實際天數)] mod 60

3. 二十八宿計算公式
二十八宿序號=[23+A(實際天數)] mod 28

4. 實際天數A的計算
A = B(基本天數) + C(閏日天數)
B = (計算年-1) * 365 + (要計算到年的月日天數)

例:1984年2月1日的基本天数 B = (1984-1) * 365 + (31 + 1) = 723827(天),其中,31是1月为31天,1为2月1日为1天。

公元 308 年 8 月 28 日的基本天数
B = (308 - 1) * 365 + (31 + 28 + 31 + 30 + 31 + 30 + 31 + 27)
= 112055 + 239
= 112294(天)

这里的(要计算到年的月日天数),用的是公历,月日天数的规则我好象小学就学过了。哈哈……

C = (计算年 - 1) div 4 - 误差修正值 + fixValue2

fixValue2 为 0 或 者 1。常值为 0,当年数为闰年(公历闰年法)之中的3月1日之后的为1。

误差修正值推算:
公元元年1月1日至1582年10月14日为0。
1582年10月15日至1699年12月31日为10。
从1701年1月1日起每增加一个世纪累加1,但能被400除尽的世纪不累加1。此方法推算即可。
--有一个问题,1700年这一年的修正值应为多少呢?算法中正好没有讲到,但看来应该是10。

例1701年1月1日起误差值为11,而1801年1月1日起误差修正值为12,而1901年1月1日起误差修正值为13,但2001年误差修正值仍为13,因为2000年能被400整除,故不累加。而2101年1月1日起误差修正值为14。

5. 实例:1998.3.15的星期、干支与二十八宿
B=(1998-1)*365+(31+28+15)=728979
C=(1998-1) div 4 - 13 + 0 = 486
A=B+C=728979+486=729465
星期序号=(5+729465) mod 7=0,即为星期日
干支序号=(13+729465) mod 60=58,即为辛酉
二十八宿序号=(23+729465) mod 28=4,即为房

===================================================
好可怕!还有一些其它公式……但好象有些参数不知道怎么得到:

二十四节交节日算法:
用已知年的交接时辰加上22个小时35分,超过24要减去24,分数足60进1个小时,即得到8年后的各节交节时辰。
如2000年雨水交节时辰为16时22分,则2008年雨水交节时辰为14时52分。
因为16时22分+22时35分=38时57分。38-24=14时。
谁知道公元元年到公元八年的交节日,这个算法就可以实现了。
--好象逆算法可以解决这个问题。谁试试?

农历闰月算法:
农历中,二十四节气(十二节气和十二中气)的中气落在月末的话,下个月就没有中气。农历将这种有节(节气)无气(中气)的月份规定为闰月。平均计算,19年有七个闰月。
但二十四个节气的十二节气和十二中气是怎么分的呢?我没有资料,估记应该是一节气一中气这样交叉。
  1. unit CNYear;

  2. interface
  3. uses sysutils;
  4.   type TCNDate = Cardinal;
  5.   function DecodeGregToCNDate(dtGreg:TDateTime):TCNDate;
  6.   function GetGregDateFromCN(cnYear,cnMonth,cnDay:word;bLeap:Boolean=False):TDateTime;
  7.   function GregDateToCNStr(dtGreg:TDateTime):String;
  8.   function isCNLeap(cnDate:TCNDate):boolean;
  9. implementation

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

  27. //如果希望用汇编,这里有一条信息:农历不会滞后公历2个月.
  28. //将公历转换为农历
  29. //返回:12位年份+4位月份+5位日期
  30. function DecodeGregToCNDate(dtGreg:TDateTime):TCNDate;
  31. var
  32.   iDayLeave:Integer;
  33.   wYear,wMonth,wDay:WORD;
  34.   i,j:integer;
  35.   wBigSmallDist,wLeap,wCount,wLeapShift:WORD;
  36.   label OK;
  37. begin
  38.   result := 0;
  39.   iDayLeave := Trunc(dtGreg) - cstDateOrg;
  40.   DecodeDate(IncMonth(dtGreg,-1),wYear,wMonth,wDay);
  41.   if (iDayLeave < 0) or (iDayLeave > 22295 )then Exit;
  42. //Raise Exception.Create('目前只能算1990-01-27以后的');
  43. //Raise Exception.Create('目前只能算2051-02-11以前的');
  44.   for i:=Low(cstCNTable) to High(cstCNTable) do
  45.   begin
  46.     wBigSmallDist := cstCNTable[i];
  47.     wLeap := wBigSmallDist shr 12;
  48.     if wLeap > 12 then
  49.     begin
  50.       wLeap := wLeap and 7;
  51.       wLeapShift := 1;
  52.     end else
  53.       wLeapShift := 0;
  54.     for j:=1 to 12 do
  55.     begin
  56.       wCount:=(wBigSmallDist and 1) + 29;
  57.       if j=wLeap then
  58.         wCount := wCount - wLeapShift;
  59.       if iDayLeave < wCount then
  60.       begin
  61.         Result := (i shl 9) + (j shl 5) + iDayLeave + 1;
  62.         Exit;
  63.       end;
  64.       iDayLeave := iDayLeave - wCount;
  65.       if j=wLeap then
  66.       begin
  67.         wCount:=29 + wLeapShift;
  68.         if iDayLeave < wCount then
  69.         begin
  70.           Result := (i shl 9) + (j shl 5) + iDayLeave + 1 + (1 shl 21);
  71.           Exit;
  72.         end;
  73.         iDayLeave := iDayLeave - wCount;
  74.       end;
  75.       wBigSmallDist := wBigSmallDist shr 1;
  76.     end;
  77.   end;
  78.   //返回值:
  79.   // 1位闰月标志 + 12位年份+4位月份+5位日期 (共22位)
  80. end;

  81. function isCNLeap(cnDate:TCNDate):boolean;
  82. begin
  83.   result := (cnDate and $200000) <> 0;
  84. end;
  85. function GetGregDateFromCN(cnYear,cnMonth,cnDay:word;bLeap:Boolean=False):TDateTime;
  86. var
  87.   i,j:integer;
  88.   DayCount:integer;
  89.   wBigSmallDist,wLeap,wLeapShift:WORD;
  90. begin
  91.   // 0101 010010101111 高四位是闰月位置,后12位表示大小月,大月30天,小月29天,
  92.   DayCount := 0;
  93.   if (cnYear < 1990) or (cnYear >2050) then
  94.   begin
  95.     Result := 0;
  96.     Exit;
  97.   end;
  98.   for i:= cstCNYearOrg to cnYear-1 do
  99.   begin
  100.     wBigSmallDist := cstCNTable[i];
  101.     if (wBIgSmallDist and $F000) <> 0 then
  102.       DayCount := DayCount + 29;
  103.     DayCount := DayCount + 12 * 29;
  104.     for j:= 1 to 12 do
  105.     begin
  106.       DayCount := DayCount + wBigSmallDist and 1;
  107.       wBigSmallDist := wBigSmallDist shr 1;
  108.     end;
  109.   end;
  110.   wBigSmallDist := cstCNTable[cnYear];
  111.   wLeap := wBigSmallDist shr 12;
  112.   if wLeap > 12 then
  113.   begin
  114.     wLeap := wLeap and 7;
  115.     wLeapShift := 1; //大月在闰月.
  116.   end else
  117.     wLeapShift := 0;
  118.   for j:= 1 to cnMonth-1 do
  119.   begin
  120.     DayCount:=DayCount + (wBigSmallDist and 1) + 29;
  121.     if j = wLeap then
  122.       DayCount := DayCount + 29;
  123.     wBigSmallDist := wBigSmallDist shr 1;
  124.   end;
  125.   if bLeap and (cnMonth = wLeap) then //是要闰月的吗?
  126.     DayCount := DayCount + 30 - wLeapShift;
  127.   result := cstDateOrg + DayCount + cnDay - 1;
  128. end;

  129. //将日期显示成农历字符串.
  130. function GregDateToCNStr(dtGreg:TDateTime):String;
  131. const hzNumber:array[0..10] of string=('零','一','二','三','四','五','六','七','八','九','十');

  132.     function ConvertYMD(Number:Word;YMD:Word):string;
  133.     var
  134.       wTmp:word;
  135.     begin
  136.       result := '';
  137.       if YMD = 1 then
  138.       begin //年份
  139.         while Number > 0 do
  140.         begin
  141.           result := hzNumber[Number Mod 10] + result;
  142.           Number := Number DIV 10;
  143.         end;
  144.         Exit;
  145.     end;
  146.     if Number<=10 then
  147.     begin //可只用1位
  148.       if YMD = 2 then //月份
  149.         result := hzNumber[Number]
  150.       else //天
  151.         result := '初' + hzNumber[Number];
  152.       Exit;
  153.     end;
  154.     wTmp := Number Mod 10; //个位
  155.     if wTmp <> 0 then result := hzNumber[wTmp];
  156.     wTmp := Number Div 10; //十位
  157.     result := '十'+result;
  158.     if wTmp > 1 then result := hzNumber[wTmp] + result;
  159.   end;
  160.   
  161. var
  162.   cnYear,cnMonth,cnDay:word;
  163.   cnDate:TCNDate;
  164.   strLeap:string;
  165. begin
  166.   cnDate:= DecodeGregToCNDate(dtGreg);
  167.   if cnDate = 0 then
  168.   begin
  169.     result := '输入越界';
  170.     Exit;
  171.   end;
  172.   cnDay := cnDate and $1F;
  173.   cnMonth := (cnDate shr 5) and $F;
  174.   cnYear := (cnDate shr 9) and $FFF;
  175.   //测试第22位,为1表示闰月
  176.   if isCNLeap(cnDate) then strLeap:='(闰)' else strLeap := '';
  177.   result := '农历' + ConvertYMD(cnYear,1) + '年' +
  178.     ConvertYMD(cnMonth,2) + '月' + strLeap + ConvertYMD(cnDay,3) ;
  179. end;
  180. end.
複製代碼
我是雪龍
http://blog.bestlong.idv.tw
http://www.bestlong.idv.tw
‹ 上一主題|下一主題

Archiver|怕失憶論壇

GMT+8, 2024-4-30 23:20 , Processed in 0.023358 second(s), 10 queries .

Powered by Discuz! X1.5

© 2001-2010 Comsenz Inc.