怎么确定农历的大月小月。

mee123456 2003-01-22 02:49:05

怎么确定农历的某月是大月还是小月.

...全文

1168 12 打赏收藏转发到动态举报

写回复

用AI写文章

12 条回复

切换为时间正序

请发表友善的回复…

发表回复

mee123456 2003-01-24

打赏
举报

谢谢各位。

snla 2003-01-23

打赏
举报

{
這是一個國曆與農曆互相轉的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;

snla 2003-01-23

打赏
举报

///DELPHI的代码，可以在C++ Builder中编译。

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.

*************

snla 2003-01-23

打赏
举报

一个关于VB的农历算法－转自CSDN

'日期数据定义方法如下
'前12个字节代表1-12月为大月或是小月，1为大月30天，0为小月29天，
'第13位为闰月的情况，1为大月30天，0为小月29天，第14位为闰月的月
'份，如果不是闰月为0，否则给出月份，10、11、12分别用A、B、C来表
'示，即使用16进制。最后4位为当年家农历新年-即农历1月1日所在公历
'的日期，如0131代表1月31日。
'GetYLDate函数使用方式如下tYear为要输入的年，tMonth为月，tDay为
'日期，YLyear是返回值，返加农历的年份，如甲子年，YLShuXing返回
'的是属象，如鼠。IsGetGl是设置是不是通过农历取公历值，如果是，
'前三个返回相应的公历日期，而且返回值是一个公历日期。

Function GetYLDate(tYear As Integer, tMonth As Integer, tDay As Integer, _
YLyear As String, YLShuXing As String, _
Optional IsGetGl As Boolean) As String

On Error Resume Next
Dim daList(1900 To 2011) As String * 18
Dim conDate As Date, setDate As Date
Dim AddMonth As Integer, AddDay As Integer, AddYear As Integer, getDay As Integer
Dim RunYue As Boolean
If tYear > 2010 Or tYear < 1901 Then Exit Function '如果不是有效有日期，退出
'1900 to 1909
daList(1900) = "010010110110180131"
daList(1901) = "010010101110000219"
daList(1902) = "101001010111000208"
daList(1903) = "010100100110150129"
daList(1904) = "110100100110000216"
daList(1905) = "110110010101000204"
daList(1906) = "011010101010140125"
daList(1907) = "010101101010000213"
daList(1908) = "100110101101000202"
daList(1909) = "010010101110120122"
daList(1910) = "010010101110000210"
daList(1911) = "101001001101160130"
daList(1912) = "101001001101000218"
daList(1913) = "110100100101000206"
daList(1914) = "110101010100150126"
daList(1915) = "101101010101000214"
daList(1916) = "010101101010000204"
daList(1917) = "100101101101020123"
daList(1918) = "100101011011000211"
daList(1919) = "010010011011170201"
daList(1920) = "010010011011000220"
daList(1921) = "101001001011000208"
daList(1922) = "101100100101150128"
daList(1923) = "011010100101000216"
daList(1924) = "011011010100000205"
daList(1925) = "101011011010140124"
daList(1926) = "001010110110000213"
daList(1927) = "100101010111000202"
daList(1928) = "010010010111120123"
daList(1929) = "010010010111000210"
daList(1930) = "011001001011060130"
daList(1931) = "110101001010000217"
daList(1932) = "111010100101000206"
daList(1933) = "011011010100150126"
daList(1934) = "010110101101000214"
daList(1935) = "001010110110000204"
daList(1936) = "100100110111030124"
daList(1937) = "100100101110000211"
daList(1938) = "110010010110170131"
daList(1939) = "110010010101000219"
daList(1940) = "110101001010000208"
daList(1941) = "110110100101060127"
daList(1942) = "101101010101000215"
daList(1943) = "010101101010000205"
daList(1944) = "101010101101140125"
daList(1945) = "001001011101000213"
daList(1946) = "100100101101000202"
daList(1947) = "110010010101120122"
daList(1948) = "101010010101000210"
daList(1949) = "101101001010170129"
daList(1950) = "011011001010000217"
daList(1951) = "101101010101000206"
daList(1952) = "010101011010150127"
daList(1953) = "010011011010000214"
daList(1954) = "101001011011000203"
daList(1955) = "010100101011130124"
daList(1956) = "010100101011000212"
daList(1957) = "101010010101080131"
daList(1958) = "111010010101000218"
daList(1959) = "011010101010000208"
daList(1960) = "101011010101060128"
daList(1961) = "101010110101000215"
daList(1962) = "010010110110000205"
daList(1963) = "101001010111040125"
daList(1964) = "101001010111000213"
daList(1965) = "010100100110000202"
daList(1966) = "111010010011030121"
daList(1967) = "110110010101000209"
daList(1968) = "010110101010170130"
daList(1969) = "010101101010000217"
daList(1970) = "100101101101000206"
daList(1971) = "010010101110150127"
daList(1972) = "010010101101000215"
daList(1973) = "101001001101000203"
daList(1974) = "110100100110140123"
daList(1975) = "110100100101000211"
daList(1976) = "110101010010180131"
daList(1977) = "101101010100000218"
daList(1978) = "101101101010000207"
daList(1979) = "100101101101060128"
daList(1980) = "100101011011000216"
daList(1981) = "010010011011000205"
daList(1982) = "101001001011140125"
daList(1983) = "101001001011000213"
daList(1984) = "1011001001011A0202"
daList(1985) = "011010100101000220"
daList(1986) = "011011010100000209"
daList(1987) = "101011011010060129"
daList(1988) = "101010110110000217"
daList(1989) = "100100110111000206"
daList(1990) = "010010010111150127"
daList(1991) = "010010010111000215"
daList(1992) = "011001001011000204"
daList(1993) = "011010100101030123"
daList(1994) = "111010100101000210"
daList(1995) = "011010110010180131"
daList(1996) = "010110101100000219"
daList(1997) = "101010110110000207"
daList(1998) = "100100110110150128"
daList(1999) = "100100101110000216"
daList(2000) = "110010010110000205"
daList(2001) = "110101001010140124"
daList(2002) = "110101001010000212"
daList(2003) = "110110100101000201"
daList(2004) = "010110101010120122"
daList(2005) = "010101101010000209"
daList(2006) = "101010101101170129"
daList(2007) = "001001011101000218"
daList(2008) = "100100101101000207"
daList(2009) = "110010010101150126"
daList(2010) = "101010010101000214"
daList(2011) = "101101001010000214"
AddYear = tYear
RunYue = False

If IsGetGl Then
AddMonth = Val(Mid(daList(AddYear), 15, 2))
AddDay = Val(Mid(daList(AddYear), 17, 2))
conDate = DateSerial(AddYear, AddMonth, AddDay)
AddDay = tDay
For i = 1 To tMonth - 1
AddDay = AddDay + 29 + Val(Mid(daList(tYear), i, 1))
Next i
'MsgBox DateDiff("d", conDate, Date)
setDate = DateAdd("d", AddDay - 1, conDate)
GetYLDate = setDate
tYear = Year(setDate)
tMonth = Month(setDate)
tDay = Day(setDate)
Exit Function
End If
CHUSHIHUA:
AddMonth = Val(Mid(daList(AddYear), 15, 2))
AddDay = Val(Mid(daList(AddYear), 17, 2))
conDate = DateSerial(AddYear, AddMonth, AddDay)
setDate = DateSerial(tYear, tMonth, tDay)
getDay = DateDiff("d", conDate, setDate)
If getDay < 0 Then AddYear = AddYear - 1: GoTo CHUSHIHUA
' addday = NearDay
AddDay = 1: AddMonth = 1
For i = 1 To getDay
AddDay = AddDay + 1
If AddDay = 30 + Mid(daList(AddYear), AddMonth, 1) Or (RunYue And AddDay = 30 + Mid(daList(AddYear), 13, 1)) Then
If RunYue = False And AddMonth = Val("&H" & Mid(daList(AddYear), 14, 1)) Then
RunYue = True
Else
RunYue = False
AddMonth = AddMonth + 1
End If
AddDay = 1
End If

Next

md$ = "初一初二初三初四初五初六初七初八初九初十十一十二十三十四十五十六十七十八十九二十廿一廿二廿三廿四廿五廿六廿七廿八廿九三十"
dd$ = Mid(md$, (AddDay - 1) * 2 + 1, 2)
mm$ = Mid("正二三四五六七八九十寒腊", AddMonth, 1) + "月"
YouGetDate = DateSerial(AddYear, AddMonth, AddDay)
tiangan$ = "甲乙丙丁戊已庚辛壬癸"
dizhi$ = "子丑寅卯辰巳午未申酉戌亥"
Dim ganzhi(0 To 59) As String * 2
For i = 0 To 59
ganzhi(i) = Mid(tiangan$, (i Mod 10) + 1, 1) + Mid(dizhi$, (i Mod 12) + 1, 1)
'ff$ = ff$ + ganzhi(i)
Next i
'MsgBox ff$, , Len(ff$)
YLyear = ganzhi((AddYear - 4) Mod 60)
shu$ = "鼠牛虎兔龙蛇马羊猴鸡狗猪"
YLShuXing = Mid(shu$, ((AddYear - 4) Mod 12) + 1, 1)
If RunYue Then mm$ = "闰" + mm$

GetYLDate = mm$ + dd$

End Function