注:以下代码不是本人的, 是从网上来的. 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.
unit Lunar;interface uses SysUtils;//國曆轉農曆(民國年, 月, 日, var 農曆年, 農曆月, 農曆日) procedure Solar2Lunar(SYear, SMonth, SDay : Integer; Var LYear, LMonth, LDay : Integer); //農曆轉國曆(農曆年, 農曆月, 農曆日, var 民國年, 月, 日) procedure Lunar2Solar(LYear, LMonth, LDay : Integer; Var SYear, SMonth, SDay : Integer); //輸入農曆年份換算六十甲子名稱 function YearName(LYear : integer) : string; //得知農曆之月份天數 function DaysPerLunarMonth(LYear, LMonth : Integer) : Integer;implementation const SMDay : array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31); c1 : array[1..10] of string[2] = ('甲', '乙', '丙', '丁', '戊', '己', '庚', '辛', '壬', '癸'); c2 : array[1..12] of string[2] = ('子', '丑', '寅', '卯', '辰', '巳', '午', '未', '申', '酉', '戌', '亥');// Magic String : LongLife : array[1..111] of string[9] = ( '132637048', '133365036', '053365225', '132900044', '131386034', '022778122', //6 '132395041', '071175231', '131175050', '132635038', '052891127', '131701046', //12 '131748035', '042741223', '130694043', '132391032', '021327122', '131175040', //18 '061623129', '133402047', '133402036', '051769125', '131453044', '130694034', //24 '032158223', '132350041', '073213230', '133221049', '133402038', '063466226', //30 '132901045', '131130035', '042651224', '130605043', '132349032', '023371121', //36 '132709040', '072901128', '131738047', '132901036', '051333226', '131210044', //42 '132651033', '031111223', '131323042', '082714130', '133733048', '131706038', //48 '062794127', '132741045', '131206035', '042734124', '132647043', '131318032', //54 '033878120', '133477039', '071461129', '131386047', '132413036', '051245126', //60 '131197045', '132637033', '043405122', '133365041', '083413130', '132900048', //66 '132922037', '062394227', '132395046', '131179035', '042711124', '132635043', //72 '102855132', '131701050', '131748039', '062804128', '132742047', '132359036', //78 '051199126', '131175045', '131611034', '031866122', '133749040', '081717130', //84 '131452049', '132742037', '052413127', '132350046', '133222035', '043477123', //90 '133402042', '133493031', '021877121', '131386039', '072747128', '130605048', //96 '132349037', '053243125', '132709044', '132890033', '042986122', '132901040', //102 '091373130', '131210049', '132651038', '061303127', '131323046', '132707035', //108 '041941124', '131706042', '132773031'); //111var LMDay : array[1..13] of integer; InterMonth, InterMonthDays, SLRangeDay : integer; function IsLeapYear(AYear: Integer): Boolean; begin Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0)); end;function YearName(LYear : integer) : string; var x, y, ya : integer; begin ya := LYear; if ya < 1 then ya := ya + 1; if ya < 12 then ya := ya + 60; x := (ya + 8 - ((ya + 7) div 10) * 10); y := (ya - ((ya-1) div 12) * 12); result := c1[x]+c2[y]; end;procedure CovertLunarMonth(magicno : integer); var i, size, m : integer; begin m := magicno; for i := 12 downto 1 do begin size := m mod 2; if size = 0 then LMDay[i] := 29 else LMDay[i] := 30; m := m div 2; end; end;procedure ProcessMagicStr(yy : integer); var magicstr : string; dsize, LunarMonth : integer; begin magicstr := LongLife[yy]; InterMonth := StrToInt(Copy(magicstr, 1, 2)); LunarMonth := StrToInt(copy(magicstr, 3, 4)); CovertLunarMonth(LunarMonth); dsize := StrToInt(Copy(magicstr, 7, 1)); case dsize of 0 : InterMonthDays := 0; 1 : InterMonthDays := 29; 2 : InterMonthDays := 30; end; SLRangeDay := StrToInt(Copy(Magicstr, 8, 2)); end;function DaysPerLunarMonth(LYear, LMonth : Integer) : Integer; begin ProcessMagicStr(LYear); if LMonth < 0 then Result := InterMonthDays else Result := LMDay[LMonth]; end;procedure Solar2Lunar(SYear, SMonth, SDay : integer; var LYear, LMonth, LDay : integer); var i, day : integer; begin day := 0; if isLeapYear(SYear+1911) then SMDay[2] := 29; ProcessMagicStr(SYear); if SMonth = 1 then day := SDay else begin for i := 1 to SMonth-1 do day := day + SMDay[i]; day := day + SDay; end; if day <= SLRangeDay then begin day := day - SLRangeDay; processmagicstr(SYear-1); for i := 12 downto 1 do begin day := day + LMDay[i]; if day > 0 then break; end; LYear := SYear - 1; LMonth := i; LDay := day; end else begin day := day - SLRangeDay; for i := 1 to InterMonth-1 do begin day := day - LMDay[i]; if day <= 0 then break; end; if day <= 0 then begin LYear := SYear; LMonth := i; LDay := day + LMDay[i]; end else begin day := day - LMDay[InterMonth]; if day <= 0 then begin LYear := SYear; LMonth := InterMonth; LDay := day + LMDay[InterMonth]; end else begin LMDay[InterMonth] := InterMonthDays; for i := InterMonth to 12 do begin day := day - LMDay[i]; if day <= 0 then break; end; if i = InterMonth then LMonth := 0 - InterMonth else LMonth := i; LYear := SYear; LDay := day + LMDay[i]; end; end; end; end;procedure Lunar2Solar(LYear, LMonth, LDay : integer; var SYear, SMonth, SDay : integer); var i, day : integer; begin day := 0; SYear := LYear; if isLeapYear(SYear+1911) then SMDay[2] := 29; processmagicstr(SYear); if LMonth < 0 then day := LMDay[InterMonth]; if LMonth <> 1 then for i := 1 to LMonth-1 do day := day + LMDay[i]; day := day + LDay + SLRangeDay; if (InterMonth <> 13) and (InterMonth < LMonth) then day := day + InterMonthDays; for i := 1 to 12 do begin day := day - SMDay[i]; if day <= 0 then break; end; if day > 0 then begin SYear := SYear + 1; if isLeapYear(SYear+1911) then SMDay[2] := 29; for i := 1 to 12 do begin day := day - SMDay[i]; if day <= 0 then break; end; end; //i := i - 1; day := day + SMDay[i]; //if i = 0 then begin // i := 12; // SYear := SYear - 1; // day := day + 31; //end;// else //day := day + SMDay[i]; SMonth := i; SDay := day; end;end.
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 SysUtils;//國曆轉農曆(民國年, 月, 日, var 農曆年, 農曆月, 農曆日)
procedure Solar2Lunar(SYear, SMonth, SDay : Integer; Var LYear, LMonth, LDay : Integer);
//農曆轉國曆(農曆年, 農曆月, 農曆日, var 民國年, 月, 日)
procedure Lunar2Solar(LYear, LMonth, LDay : Integer; Var SYear, SMonth, SDay : Integer);
//輸入農曆年份換算六十甲子名稱
function YearName(LYear : integer) : string;
//得知農曆之月份天數
function DaysPerLunarMonth(LYear, LMonth : Integer) : Integer;implementation
const
SMDay : array[1..12] of integer = (31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);
c1 : array[1..10] of string[2] = ('甲', '乙', '丙', '丁', '戊', '己', '庚', '辛', '壬', '癸');
c2 : array[1..12] of string[2] = ('子', '丑', '寅', '卯', '辰', '巳', '午', '未', '申', '酉', '戌', '亥');// Magic String :
LongLife : array[1..111] of string[9] = (
'132637048', '133365036', '053365225', '132900044', '131386034', '022778122', //6
'132395041', '071175231', '131175050', '132635038', '052891127', '131701046', //12
'131748035', '042741223', '130694043', '132391032', '021327122', '131175040', //18
'061623129', '133402047', '133402036', '051769125', '131453044', '130694034', //24
'032158223', '132350041', '073213230', '133221049', '133402038', '063466226', //30
'132901045', '131130035', '042651224', '130605043', '132349032', '023371121', //36
'132709040', '072901128', '131738047', '132901036', '051333226', '131210044', //42
'132651033', '031111223', '131323042', '082714130', '133733048', '131706038', //48
'062794127', '132741045', '131206035', '042734124', '132647043', '131318032', //54
'033878120', '133477039', '071461129', '131386047', '132413036', '051245126', //60
'131197045', '132637033', '043405122', '133365041', '083413130', '132900048', //66
'132922037', '062394227', '132395046', '131179035', '042711124', '132635043', //72
'102855132', '131701050', '131748039', '062804128', '132742047', '132359036', //78
'051199126', '131175045', '131611034', '031866122', '133749040', '081717130', //84
'131452049', '132742037', '052413127', '132350046', '133222035', '043477123', //90
'133402042', '133493031', '021877121', '131386039', '072747128', '130605048', //96
'132349037', '053243125', '132709044', '132890033', '042986122', '132901040', //102
'091373130', '131210049', '132651038', '061303127', '131323046', '132707035', //108
'041941124', '131706042', '132773031'); //111var
LMDay : array[1..13] of integer;
InterMonth, InterMonthDays, SLRangeDay : integer;
function IsLeapYear(AYear: Integer): Boolean;
begin
Result := (AYear mod 4 = 0) and ((AYear mod 100 <> 0) or (AYear mod 400 = 0));
end;function YearName(LYear : integer) : string;
var
x, y, ya : integer;
begin
ya := LYear;
if ya < 1 then
ya := ya + 1;
if ya < 12 then
ya := ya + 60;
x := (ya + 8 - ((ya + 7) div 10) * 10);
y := (ya - ((ya-1) div 12) * 12);
result := c1[x]+c2[y];
end;procedure CovertLunarMonth(magicno : integer);
var
i, size, m : integer;
begin
m := magicno;
for i := 12 downto 1 do begin
size := m mod 2;
if size = 0 then
LMDay[i] := 29
else
LMDay[i] := 30;
m := m div 2;
end;
end;procedure ProcessMagicStr(yy : integer);
var
magicstr : string;
dsize, LunarMonth : integer;
begin
magicstr := LongLife[yy];
InterMonth := StrToInt(Copy(magicstr, 1, 2));
LunarMonth := StrToInt(copy(magicstr, 3, 4));
CovertLunarMonth(LunarMonth);
dsize := StrToInt(Copy(magicstr, 7, 1));
case dsize of
0 : InterMonthDays := 0;
1 : InterMonthDays := 29;
2 : InterMonthDays := 30;
end;
SLRangeDay := StrToInt(Copy(Magicstr, 8, 2));
end;function DaysPerLunarMonth(LYear, LMonth : Integer) : Integer;
begin
ProcessMagicStr(LYear);
if LMonth < 0 then
Result := InterMonthDays
else
Result := LMDay[LMonth];
end;procedure Solar2Lunar(SYear, SMonth, SDay : integer; var LYear, LMonth, LDay : integer);
var
i, day : integer;
begin
day := 0;
if isLeapYear(SYear+1911) then
SMDay[2] := 29;
ProcessMagicStr(SYear);
if SMonth = 1 then
day := SDay
else begin
for i := 1 to SMonth-1 do
day := day + SMDay[i];
day := day + SDay;
end;
if day <= SLRangeDay then begin
day := day - SLRangeDay;
processmagicstr(SYear-1);
for i := 12 downto 1 do begin
day := day + LMDay[i];
if day > 0 then
break;
end;
LYear := SYear - 1;
LMonth := i;
LDay := day;
end else begin
day := day - SLRangeDay;
for i := 1 to InterMonth-1 do begin
day := day - LMDay[i];
if day <= 0 then
break;
end;
if day <= 0 then begin
LYear := SYear;
LMonth := i;
LDay := day + LMDay[i];
end else begin
day := day - LMDay[InterMonth];
if day <= 0 then begin
LYear := SYear;
LMonth := InterMonth;
LDay := day + LMDay[InterMonth];
end else begin
LMDay[InterMonth] := InterMonthDays;
for i := InterMonth to 12 do begin
day := day - LMDay[i];
if day <= 0 then
break;
end;
if i = InterMonth then
LMonth := 0 - InterMonth
else
LMonth := i;
LYear := SYear;
LDay := day + LMDay[i];
end;
end;
end;
end;procedure Lunar2Solar(LYear, LMonth, LDay : integer; var SYear, SMonth, SDay : integer);
var
i, day : integer;
begin
day := 0;
SYear := LYear;
if isLeapYear(SYear+1911) then
SMDay[2] := 29;
processmagicstr(SYear);
if LMonth < 0 then
day := LMDay[InterMonth];
if LMonth <> 1 then
for i := 1 to LMonth-1 do
day := day + LMDay[i];
day := day + LDay + SLRangeDay;
if (InterMonth <> 13) and (InterMonth < LMonth) then
day := day + InterMonthDays;
for i := 1 to 12 do begin
day := day - SMDay[i];
if day <= 0 then
break;
end;
if day > 0 then begin
SYear := SYear + 1;
if isLeapYear(SYear+1911) then
SMDay[2] := 29;
for i := 1 to 12 do begin
day := day - SMDay[i];
if day <= 0 then
break;
end;
end;
//i := i - 1;
day := day + SMDay[i];
//if i = 0 then begin
// i := 12;
// SYear := SYear - 1;
// day := day + 31;
//end;// else
//day := day + SMDay[i];
SMonth := i;
SDay := day;
end;end.
好像是历法设计上有问题。
csdn上的那个算法我贴在下面。unit Calendar;interfaceuses 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;iSta
rtMonth: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;implementationvar
///数组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,每月用一个字节存放,高位存放第一个节气数
据,低位存放
$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