zoukankan      html  css  js  c++  java
  • Delphi 农历算法

    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 : rexpeng@ms1.hinet.net

    }
    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.

  • 相关阅读:
    129 01 Android 零基础入门 02 Java面向对象 06 Java单例模式 03 饿汉模式 VS 懒汉模式 02 懒汉式的代码实现
    128 01 Android 零基础入门 02 Java面向对象 06 Java单例模式 03 饿汉模式 VS 懒汉模式 01 饿汉式的代码实现
    127 01 Android 零基础入门 02 Java面向对象 06 Java单例模式 02 单例模式概述 01 单例模式的定义和作用
    126 01 Android 零基础入门 02 Java面向对象 06 Java单例模式 01 设计模式概述 01 设计模式简介
    125 01 Android 零基础入门 02 Java面向对象 05 Java继承(下)05 Java继承(下)总结 01 Java继承(下)知识点总结
    leetcode-----121. 买卖股票的最佳时机
    leetcode-----104. 二叉树的最大深度
    Json串的字段如果和类中字段不一致,如何映射、转换?
    Mybatis-Plus的Service方法使用 之 泛型方法default <V> List<V> listObjs(Function<? super Object, V> mapper)
    模糊查询
  • 原文地址:https://www.cnblogs.com/MaxWoods/p/1854701.html
Copyright © 2011-2022 走看看