有谁帮着解释一下!! const //农历月份数据,每年4字节,从1901年开始,共150年 //数据来源:UCDOS 6.0 UCT.COM //分析整理:Copyright (c) 1996-1998, Randolph //数据解析: //如果第一字节的bit7为1,则该年1月1日位于农历12月,否则位于11月 //第一字节去除bit7为该年1月1日的农历日期 // 第二字节 第三字节 //bit: 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0 //农历月份:16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1 //农历月份指的是从该年1月1日的农历月份算起的顺序号 //农历月份对应的bit为1则该月为30日,否则为29日 //第四字节为闰月月份 CnData: array[0..599] of Byte = ( $0b,$52,$ba,$00,$16,$a9,$5d,$00,$83,$a9,$37,$05,$0e,$74,$9b,$00, $1a,$b6,$55,$00,$87,$b5,$55,$04,$11,$55,$aa,$00,$1c,$a6,$b5,$00, $8a,$a5,$75,$02,$14,$52,$ba,$00,$81,$52,$6e,$06,$0d,$e9,$37,$00, $18,$74,$97,$00,$86,$ea,$96,$05,$10,$6d,$55,$00,$1a,$35,$aa,$00, $88,$4b,$6a,$02,$13,$a5,$6d,$00,$1e,$d2,$6e,$07,$0b,$d2,$5e,$00, $17,$e9,$2e,$00,$84,$d9,$2d,$05,$0f,$da,$95,$00,$19,$5b,$52,$00, $87,$56,$d4,$04,$11,$4a,$da,$00,$1c,$a5,$5d,$00,$89,$a4,$bd,$02, $15,$d2,$5d,$00,$82,$b2,$5b,$06,$0d,$b5,$2b,$00,$18,$ba,$95,$00, $86,$b6,$a5,$05,$10,$56,$b4,$00,$1a,$4a,$da,$00,$87,$49,$ba,$03, $13,$a4,$bb,$00,$1e,$b2,$5b,$07,$0b,$72,$57,$00,$16,$75,$2b,$00, $84,$6d,$2a,$06,$0f,$ad,$55,$00,$19,$55,$aa,$00,$86,$55,$6c,$04, $12,$c9,$76,$00,$1c,$64,$b7,$00,$8a,$e4,$ae,$02,$15,$ea,$56,$00, $83,$da,$55,$07,$0d,$5b,$2a,$00,$18,$ad,$55,$00,$85,$aa,$d5,$05, $10,$53,$6a,$00,$1b,$a9,$6d,$00,$88,$a9,$5d,$03,$13,$d4,$ae,$00, $81,$d4,$ab,$08,$0c,$ba,$55,$00,$16,$5a,$aa,$00,$83,$56,$aa,$06, $0f,$aa,$d5,$00,$19,$52,$da,$00,$86,$52,$ba,$04,$11,$a9,$5d,$00, $1d,$d4,$9b,$00,$8a,$74,$9b,$03,$15,$b6,$55,$00,$82,$ad,$55,$07, $0d,$55,$aa,$00,$18,$a5,$b5,$00,$85,$a5,$75,$05,$0f,$52,$b6,$00, $1b,$69,$37,$00,$89,$e9,$37,$04,$13,$74,$97,$00,$81,$ea,$96,$08, $0c,$6d,$52,$00,$16,$2d,$aa,$00,$83,$4b,$6a,$06,$0e,$a5,$6d,$00, $1a,$d2,$6e,$00,$87,$d2,$5e,$04,$12,$e9,$2e,$00,$1d,$ec,$96,$0a, $0b,$da,$95,$00,$15,$5b,$52,$00,$82,$56,$d2,$06,$0c,$2a,$da,$00, $18,$a4,$dd,$00,$85,$a4,$bd,$05,$10,$d2,$5d,$00,$1b,$d9,$2d,$00, $89,$b5,$2b,$03,$14,$ba,$95,$00,$81,$b5,$95,$08,$0b,$56,$b2,$00, $16,$2a,$da,$00,$83,$49,$b6,$05,$0e,$64,$bb,$00,$19,$b2,$5b,$00, $87,$6a,$57,$04,$12,$75,$2b,$00,$1d,$b6,$95,$00,$8a,$ad,$55,$02, $15,$55,$aa,$00,$82,$55,$6c,$07,$0d,$c9,$76,$00,$17,$64,$b7,$00, $86,$e4,$ae,$05,$11,$ea,$56,$00,$1b,$6d,$2a,$00,$88,$5a,$aa,$04, $14,$ad,$55,$00,$81,$aa,$d5,$09,$0b,$52,$ea,$00,$16,$a9,$6d,$00, $84,$a9,$5d,$06,$0f,$d4,$ae,$00,$1a,$ea,$4d,$00,$87,$ba,$55,$04, $12,$5a,$aa,$00,$1d,$ab,$55,$00,$8a,$a6,$d5,$02,$14,$52,$da,$00, $82,$52,$ba,$06,$0d,$a9,$3b,$00,$18,$b4,$9b,$00,$85,$74,$9b,$05, $11,$b5,$4d,$00,$1c,$d6,$a9,$00,$88,$35,$aa,$03,$13,$a5,$b5,$00, $81,$a5,$75,$0b,$0b,$52,$b6,$00,$16,$69,$37,$00,$84,$e9,$2f,$06, $10,$f4,$97,$00,$1a,$75,$4b,$00,$87,$6d,$52,$05,$11,$2d,$69,$00, $1d,$95,$b5,$00,$8a,$a5,$6d,$02,$15,$d2,$6e,$00,$82,$d2,$5e,$07, $0e,$e9,$2e,$00,$19,$ea,$96,$00,$86,$da,$95,$05,$10,$5b,$4a,$00, $1c,$ab,$69,$00,$88,$2a,$d8,$03); function CnMonthOfDate(Date: TDate): String;//指定日期的农历月 function CnDayOfDate(Date: TDate): String;//指定日期的农历日 function CnDateOfDateStr(Date: TDate): String;//指定日期的农历日期implementation//日期是该年的第几天,1月1日为第一天 function DaysNumberOfDate(Date: TDate): Integer; var DaysNumber: Integer; I: Integer; yyyy, mm, dd: Word; begin DecodeDate(Date, yyyy, mm, dd); DaysNumber := 0; for I := 1 to mm - 1 do Inc(DaysNumber, MonthDays[IsLeapYear(yyyy), I]); Inc(DaysNumber, dd); Result := DaysNumber; end;//日期的农历日期,返回农历格式:月份*100 + 日,负数为闰月 //超出范围则返回0 function CnDateOfDate(Date: TDate): Integer; var CnMonth, CnMonthDays: array[0..15] of Integer; CnBeginDay, LeapMonth: Integer; yyyy, mm, dd: Word; Bytes: array[0..3] of Byte; I: Integer; CnMonthData: Word; DaysCount, CnDaysCount, ResultMonth, ResultDay: Integer; begin DecodeDate(Date, yyyy, mm, dd); if (yyyy < 1901) or (yyyy > 2050) then begin Result := 0; Exit; end; Bytes[0] := CnData[(yyyy - 1901) * 4]; Bytes[1] := CnData[(yyyy - 1901) * 4 + 1]; Bytes[2] := CnData[(yyyy - 1901) * 4 + 2]; Bytes[3] := CnData[(yyyy - 1901) * 4 + 3]; if (Bytes[0] and $80) <> 0 then CnMonth[0] := 12 else CnMonth[0] := 11; CnBeginDay := (Bytes[0] and $7f); CnMonthData := Bytes[1]; CnMonthData := CnMonthData shl 8; CnMonthData := CnMonthData or Bytes[2]; LeapMonth := Bytes[3]; for I := 15 downto 0 do begin CnMonthDays[15 - I] := 29; if ((1 shl I) and CnMonthData) <> 0 then Inc(CnMonthDays[15 - I]); if CnMonth[15 - I] = LeapMonth then CnMonth[15 - I + 1] := - LeapMonth else begin if CnMonth[15 - I] < 0 then //上月为闰月 CnMonth[15 - I + 1] := - CnMonth[15 - I] + 1 else CnMonth[15 - I + 1] := CnMonth[15 - I] + 1; if CnMonth[15 - I + 1] > 12 then CnMonth[15 - I + 1] := 1; end; end; DaysCount := DaysNumberOfDate(Date) - 1; if DaysCount <= (CnMonthDays[0] - CnBeginDay) then begin if (yyyy > 1901) and (CnDateOfDate(EncodeDate(yyyy - 1, 12, 31)) < 0) then ResultMonth := - CnMonth[0] else ResultMonth := CnMonth[0]; ResultDay := CnBeginDay + DaysCount; end else begin CnDaysCount := CnMonthDays[0] - CnBeginDay; I := 1; while (CnDaysCount < DaysCount) and (CnDaysCount + CnMonthDays[I] < DaysCount) do begin Inc(CnDaysCount, CnMonthDays[I]); Inc(I); end; ResultMonth := CnMonth[I]; ResultDay := DaysCount - CnDaysCount; end; if ResultMonth > 0 then Result := ResultMonth * 100 + ResultDay else Result := ResultMonth * 100 - ResultDay end;function CnMonthOfDate(Date: TDate): String; const CnMonthStr: array[1..12] of String = ( '一', '二', '三', '四', '五', '六', '七', '八', '九', '十', '冬', '蜡'); var Month: Integer; begin Month := CnDateOfDate(Date) div 100; if Month < 0 then Result := '闰' + CnMonthStr[-Month] else Result := CnMonthStr[Month] + '月'; end;function CnDayOfDate(Date: TDate): String; const CnDayStr: array[1..30] of String = ( '初一', '初二', '初三', '初四', '初五', '初六', '初七', '初八', '初九', '初十', '十一', '十二', '十三', '十四', '十五', '十六', '十七', '十八', '十九', '二十', '廿一', '廿二', '廿三', '廿四', '廿五', '廿六', '廿七', '廿八', '廿九', '三十'); var Day: Integer; begin Day := Abs(CnDateOfDate(Date)) mod 100; Result := CnDayStr[Day]; end;function CnDateOfDateStr(Date: TDate): String; begin Result := CnMonthOfDate(Date) + CnDayOfDate(Date); end;end.
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.
const
//农历月份数据,每年4字节,从1901年开始,共150年
//数据来源:UCDOS 6.0 UCT.COM
//分析整理:Copyright (c) 1996-1998, Randolph
//数据解析:
//如果第一字节的bit7为1,则该年1月1日位于农历12月,否则位于11月
//第一字节去除bit7为该年1月1日的农历日期
// 第二字节 第三字节
//bit: 7 6 5 4 3 2 1 0 7 6 5 4 3 2 1 0
//农历月份:16 15 14 13 12 11 10 9 8 7 6 5 4 3 2 1
//农历月份指的是从该年1月1日的农历月份算起的顺序号
//农历月份对应的bit为1则该月为30日,否则为29日
//第四字节为闰月月份
CnData: array[0..599] of Byte = (
$0b,$52,$ba,$00,$16,$a9,$5d,$00,$83,$a9,$37,$05,$0e,$74,$9b,$00,
$1a,$b6,$55,$00,$87,$b5,$55,$04,$11,$55,$aa,$00,$1c,$a6,$b5,$00,
$8a,$a5,$75,$02,$14,$52,$ba,$00,$81,$52,$6e,$06,$0d,$e9,$37,$00,
$18,$74,$97,$00,$86,$ea,$96,$05,$10,$6d,$55,$00,$1a,$35,$aa,$00,
$88,$4b,$6a,$02,$13,$a5,$6d,$00,$1e,$d2,$6e,$07,$0b,$d2,$5e,$00,
$17,$e9,$2e,$00,$84,$d9,$2d,$05,$0f,$da,$95,$00,$19,$5b,$52,$00,
$87,$56,$d4,$04,$11,$4a,$da,$00,$1c,$a5,$5d,$00,$89,$a4,$bd,$02,
$15,$d2,$5d,$00,$82,$b2,$5b,$06,$0d,$b5,$2b,$00,$18,$ba,$95,$00,
$86,$b6,$a5,$05,$10,$56,$b4,$00,$1a,$4a,$da,$00,$87,$49,$ba,$03,
$13,$a4,$bb,$00,$1e,$b2,$5b,$07,$0b,$72,$57,$00,$16,$75,$2b,$00,
$84,$6d,$2a,$06,$0f,$ad,$55,$00,$19,$55,$aa,$00,$86,$55,$6c,$04,
$12,$c9,$76,$00,$1c,$64,$b7,$00,$8a,$e4,$ae,$02,$15,$ea,$56,$00,
$83,$da,$55,$07,$0d,$5b,$2a,$00,$18,$ad,$55,$00,$85,$aa,$d5,$05,
$10,$53,$6a,$00,$1b,$a9,$6d,$00,$88,$a9,$5d,$03,$13,$d4,$ae,$00,
$81,$d4,$ab,$08,$0c,$ba,$55,$00,$16,$5a,$aa,$00,$83,$56,$aa,$06,
$0f,$aa,$d5,$00,$19,$52,$da,$00,$86,$52,$ba,$04,$11,$a9,$5d,$00,
$1d,$d4,$9b,$00,$8a,$74,$9b,$03,$15,$b6,$55,$00,$82,$ad,$55,$07,
$0d,$55,$aa,$00,$18,$a5,$b5,$00,$85,$a5,$75,$05,$0f,$52,$b6,$00,
$1b,$69,$37,$00,$89,$e9,$37,$04,$13,$74,$97,$00,$81,$ea,$96,$08,
$0c,$6d,$52,$00,$16,$2d,$aa,$00,$83,$4b,$6a,$06,$0e,$a5,$6d,$00,
$1a,$d2,$6e,$00,$87,$d2,$5e,$04,$12,$e9,$2e,$00,$1d,$ec,$96,$0a,
$0b,$da,$95,$00,$15,$5b,$52,$00,$82,$56,$d2,$06,$0c,$2a,$da,$00,
$18,$a4,$dd,$00,$85,$a4,$bd,$05,$10,$d2,$5d,$00,$1b,$d9,$2d,$00,
$89,$b5,$2b,$03,$14,$ba,$95,$00,$81,$b5,$95,$08,$0b,$56,$b2,$00,
$16,$2a,$da,$00,$83,$49,$b6,$05,$0e,$64,$bb,$00,$19,$b2,$5b,$00,
$87,$6a,$57,$04,$12,$75,$2b,$00,$1d,$b6,$95,$00,$8a,$ad,$55,$02,
$15,$55,$aa,$00,$82,$55,$6c,$07,$0d,$c9,$76,$00,$17,$64,$b7,$00,
$86,$e4,$ae,$05,$11,$ea,$56,$00,$1b,$6d,$2a,$00,$88,$5a,$aa,$04,
$14,$ad,$55,$00,$81,$aa,$d5,$09,$0b,$52,$ea,$00,$16,$a9,$6d,$00,
$84,$a9,$5d,$06,$0f,$d4,$ae,$00,$1a,$ea,$4d,$00,$87,$ba,$55,$04,
$12,$5a,$aa,$00,$1d,$ab,$55,$00,$8a,$a6,$d5,$02,$14,$52,$da,$00,
$82,$52,$ba,$06,$0d,$a9,$3b,$00,$18,$b4,$9b,$00,$85,$74,$9b,$05,
$11,$b5,$4d,$00,$1c,$d6,$a9,$00,$88,$35,$aa,$03,$13,$a5,$b5,$00,
$81,$a5,$75,$0b,$0b,$52,$b6,$00,$16,$69,$37,$00,$84,$e9,$2f,$06,
$10,$f4,$97,$00,$1a,$75,$4b,$00,$87,$6d,$52,$05,$11,$2d,$69,$00,
$1d,$95,$b5,$00,$8a,$a5,$6d,$02,$15,$d2,$6e,$00,$82,$d2,$5e,$07,
$0e,$e9,$2e,$00,$19,$ea,$96,$00,$86,$da,$95,$05,$10,$5b,$4a,$00,
$1c,$ab,$69,$00,$88,$2a,$d8,$03); function CnMonthOfDate(Date: TDate): String;//指定日期的农历月
function CnDayOfDate(Date: TDate): String;//指定日期的农历日
function CnDateOfDateStr(Date: TDate): String;//指定日期的农历日期implementation//日期是该年的第几天,1月1日为第一天
function DaysNumberOfDate(Date: TDate): Integer;
var
DaysNumber: Integer;
I: Integer;
yyyy, mm, dd: Word;
begin
DecodeDate(Date, yyyy, mm, dd);
DaysNumber := 0;
for I := 1 to mm - 1 do
Inc(DaysNumber, MonthDays[IsLeapYear(yyyy), I]);
Inc(DaysNumber, dd);
Result := DaysNumber;
end;//日期的农历日期,返回农历格式:月份*100 + 日,负数为闰月
//超出范围则返回0
function CnDateOfDate(Date: TDate): Integer;
var
CnMonth, CnMonthDays: array[0..15] of Integer;
CnBeginDay, LeapMonth: Integer;
yyyy, mm, dd: Word;
Bytes: array[0..3] of Byte;
I: Integer;
CnMonthData: Word;
DaysCount, CnDaysCount, ResultMonth, ResultDay: Integer;
begin
DecodeDate(Date, yyyy, mm, dd);
if (yyyy < 1901) or (yyyy > 2050) then
begin
Result := 0;
Exit;
end;
Bytes[0] := CnData[(yyyy - 1901) * 4];
Bytes[1] := CnData[(yyyy - 1901) * 4 + 1];
Bytes[2] := CnData[(yyyy - 1901) * 4 + 2];
Bytes[3] := CnData[(yyyy - 1901) * 4 + 3];
if (Bytes[0] and $80) <> 0 then CnMonth[0] := 12
else CnMonth[0] := 11;
CnBeginDay := (Bytes[0] and $7f);
CnMonthData := Bytes[1];
CnMonthData := CnMonthData shl 8;
CnMonthData := CnMonthData or Bytes[2];
LeapMonth := Bytes[3]; for I := 15 downto 0 do
begin
CnMonthDays[15 - I] := 29;
if ((1 shl I) and CnMonthData) <> 0 then
Inc(CnMonthDays[15 - I]);
if CnMonth[15 - I] = LeapMonth then
CnMonth[15 - I + 1] := - LeapMonth
else
begin
if CnMonth[15 - I] < 0 then //上月为闰月
CnMonth[15 - I + 1] := - CnMonth[15 - I] + 1
else CnMonth[15 - I + 1] := CnMonth[15 - I] + 1;
if CnMonth[15 - I + 1] > 12 then CnMonth[15 - I + 1] := 1;
end;
end; DaysCount := DaysNumberOfDate(Date) - 1;
if DaysCount <= (CnMonthDays[0] - CnBeginDay) then
begin
if (yyyy > 1901) and
(CnDateOfDate(EncodeDate(yyyy - 1, 12, 31)) < 0) then
ResultMonth := - CnMonth[0]
else ResultMonth := CnMonth[0];
ResultDay := CnBeginDay + DaysCount;
end
else
begin
CnDaysCount := CnMonthDays[0] - CnBeginDay;
I := 1;
while (CnDaysCount < DaysCount) and
(CnDaysCount + CnMonthDays[I] < DaysCount) do
begin
Inc(CnDaysCount, CnMonthDays[I]);
Inc(I);
end;
ResultMonth := CnMonth[I];
ResultDay := DaysCount - CnDaysCount;
end;
if ResultMonth > 0 then
Result := ResultMonth * 100 + ResultDay
else Result := ResultMonth * 100 - ResultDay
end;function CnMonthOfDate(Date: TDate): String;
const
CnMonthStr: array[1..12] of String = (
'一', '二', '三', '四', '五', '六', '七', '八', '九', '十',
'冬', '蜡');
var
Month: Integer;
begin
Month := CnDateOfDate(Date) div 100;
if Month < 0 then Result := '闰' + CnMonthStr[-Month]
else Result := CnMonthStr[Month] + '月';
end;function CnDayOfDate(Date: TDate): String;
const
CnDayStr: array[1..30] of String = (
'初一', '初二', '初三', '初四', '初五',
'初六', '初七', '初八', '初九', '初十',
'十一', '十二', '十三', '十四', '十五',
'十六', '十七', '十八', '十九', '二十',
'廿一', '廿二', '廿三', '廿四', '廿五',
'廿六', '廿七', '廿八', '廿九', '三十');
var
Day: Integer;
begin
Day := Abs(CnDateOfDate(Date)) mod 100;
Result := CnDayStr[Day];
end;function CnDateOfDateStr(Date: TDate): String;
begin
Result := CnMonthOfDate(Date) + CnDayOfDate(Date);
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.