已知阴历求阳历

你所说的资料我有，那是阳历--->阴历的，
我现在说的是阴历--->阳历的，算法好象不一样吧，
其实我现在也不是不可实现，而是方法很笨：
阳历一般比阴历快一到两个月吧，
我就从两个月前开始，已知阳历看阴历是否等于已知
的阴历，如果等于的话跳出循环。
但总是感觉这种方法很笨的，我想写阳历--->阴历的
反函数，但感觉不是那么容易。

这是网上找的，没试过。unit DateCn; interface uses Windows  SysUtils  Controls; 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. 其中年份皆用民國年份請自行轉換 (西元年-1911 = 民國年).
***************************************************************************
*國農曆對映表之說明 : *
***************************************************************************
* 前二數字 = 閏月月份如果為 13 則沒有閏月 *
* 第三至第六數字 = 12 個月之大小月之2進位碼->10進位                      *
   *  例如:                                                                  *
   *       101010101010 = 2730                                               *
   *       1 : 代表大月(30天) 0 : 代表小月(29天) ==> 1月大2月小3月大.....    *
   *  第七位數字為閏月天數                                                   *
   *           0 : 沒有閏月之天數                                            *
   *           1 : 閏月為小月(29天)                                          *
   *           2 : 閏月為大月(30天)                                          *
   *  最後2位數字代表陽曆之1月1日與陰曆之1月1日相差天數                      *
   ***************************************************************************
   這對映表只有民國一年至民國一百年  如不敷您的使用請按照上述之方式自行增加.    這個程式沒有判斷您所輸入之年月日是否正確  請自行判斷.    如果轉換出來之農曆的月份是閏月則傳給您的值是***負數***
   如果農曆要轉換國曆如果是閏月請輸入***負數***    此版本為FreeWare   Version : 0.1
   您可以自行修改  但最好可以將修改過之程式Mail一份給我.
   如果您要用於商業用途  請mail給我告知您的用途及原因.    作者 : 彭宏傑
   E-Mail : [email protected] }

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');                                       //111 var
  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.

调试易

已知阴历求阳历

解决方案 »