グレゴリオ暦とユリウス暦の両方を表示でき...

グレゴリオ暦とユリウス暦の両方を表示できるカレンダーです。
SECONDさんも苦労されていますが、ユリウス日から元の年月日を取り出すのが大変なんですよね。
ユリウス暦の制定は紀元前45年ですが当初は3年に1度の閏年だったそうで、それを取り入れています。参考にしたのは、2006年2月ごろのWikipediaの記事です。
ぜひ、1582年10月の日付を入力してみてください。変換期のカレンダーを表示できます。
ところで、SECONDさんのプログラムでは西暦1年の前年が西暦0年となりませんか？

REM ** グレゴリオ暦/ユリウス暦カレンダー **
!閏年 -44年,-41,-38,-35,-32,-29,-26,-23,-20,-17,-14,-11,-8,+8,+12,+16年,,,
DECLARE FUNCTION y_m_d,gMJD,jMJD,weekcode
OPTION BASE 0
DIM w$(7-1),md(1 TO 12),weekcirc(7*4-1),juweekcirc(7*3-1)
DIM 十干$(10-1),十干かな$(10-1),十二支$(12-1),十二支かな$(12-1)
SET ECHO "OFF"
LINE INPUT PROMPT "西暦年/月/日 (半角入力)":ymd0$ ! 区切り文字は何でも可(/-,.文字や空白も可)
CALL data_check ! 入力データチェック
WHEN EXCEPTION IN ! 年,月,日の取得
LET y=y_m_d(1) ! 年
LET m=y_m_d(fi+1) ! 月
LET d=y_m_d(fi+1) ! 日
LET sy$=STR$(y)
LET sm$=STR$(m)
LET sd$=STR$(d)
USE
CALL error(1)
END WHEN
MAT READ w$,md,weekcirc,juweekcirc
DATA 日,月,火,水,木,金,土
DATA 31,28,31,30,31,30,31,31,30,31,30,31
DATA 0,1,2,3,5,6,0,1,3,4,5,6,1,2,3,4,6,0,1,2,4,5,6,0,2,3,4,5 ! 1月1日の曜日
DATA 5,6,1,2,3,5,6,0,2,3,4,6,0,1,3,4,5,0,1,2,4 ! 初期ユリウス暦
CALL error_check ! エラーチェック
LET leap=0 ! うるう年 off
LET tjleap=0 ! 通年ユリウス暦うるう年 off
IF y>0 AND MOD(y,4)=0 THEN LET tjleap=1
LET jdy=y
LET jdm=m
LET jdd=d
LET jdleap=0 ! ユリウス通日での閏年 off
IF m=1 OR m=2 THEN ! 1月2月は前年の13月14月として計算
LET jdy=y-1
LET jdm=m+12
END IF
! ユリウス通日(AJD),Lilian日(LD),修正ユリウス日(MJD)
DEF AJD=MJD+2400000.5 ! -4713/1/1=-0.5 (-4713/1/1/12:00=0) ユリウス通日
DEF LD=AJD-2299159.5 ! LD=MJD+100841 1582/10/15=1 Lilian日
IF y>1582 OR (y=1582 AND (m>10 OR (m=10 AND d>=15))) THEN
LET gg=1 ! 1582/10/15以降
LET r$="(グレゴリオ暦・"
CALL greg ! グレゴリオ暦の曜日閏年計算
LET jdleap=leap
IF MOD(y,4)=0 THEN LET tjleap=1
LET MJD=gMJD(jdy,jdm,jdd) ! 修正ユリウス日
ELSE
LET gg=0
IF y=1582 AND m=10 AND (d>4 AND d<15) THEN
PRINT "ユリウス暦・グレゴリオ暦期間外 !!"
LET jg=-1
END IF
LET r$="(ユリウス暦・"
LET MJD=jMJD(jdy,jdm,jdd) ! 修正ユリウス日
SELECT CASE y
CASE IS >=8 ! 改良ユリウス暦
LET y1w=weekcirc(MOD(y+15,7*4))
IF MOD(y,4)=0 THEN LET leap=1
LET jdleap=leap
CASE 1 TO 7 ! AD.移行期間
LET y1w=MOD(y+6,7)
IF y=4 THEN LET jdleap=1
CASE -7 TO -1 ! BC.移行期間
LET y1w=y+7
IF MOD(y,4)=3 THEN LET jdleap=1
!<続く>

Re: 干支(えと) の計算	返事を書くノートメニュー
荒田浩二 <knrztrhoel> 2008/01/20 11:40:55
グレゴリオ暦とユリウス暦の両方を表示できるカレンダーです。 SECONDさんも苦労されていますが、ユリウス日から元の年月日を取り出すのが大変なんですよね。ユリウス暦の制定は紀元前45年ですが当初は3年に1度の閏年だったそうで、それを取り入れています。参考にしたのは、2006年2月ごろのWikipediaの記事です。ぜひ、1582年10月の日付を入力してみてください。変換期のカレンダーを表示できます。ところで、SECONDさんのプログラムでは西暦1年の前年が西暦0年となりませんか？ REM グレゴリオ暦/ユリウス暦カレンダー !閏年 -44年,-41,-38,-35,-32,-29,-26,-23,-20,-17,-14,-11,-8,+8,+12,+16年,,, DECLARE FUNCTION y_m_d,gMJD,jMJD,weekcode OPTION BASE 0 DIM w$(7-1),md(1 TO 12),weekcirc(74-1),juweekcirc(73-1) DIM 十干$(10-1),十干かな$(10-1),十二支$(12-1),十二支かな$(12-1) SET ECHO "OFF" LINE INPUT PROMPT "西暦年/月/日 (半角入力)":ymd0$ ! 区切り文字は何でも可(/-,.文字や空白も可) CALL data_check ! 入力データチェック WHEN EXCEPTION IN ! 年,月,日の取得 LET y=y_m_d(1) ! 年 LET m=y_m_d(fi+1) ! 月 LET d=y_m_d(fi+1) ! 日 LET sy$=STR$(y) LET sm$=STR$(m) LET sd$=STR$(d) USE CALL error(1) END WHEN MAT READ w$,md,weekcirc,juweekcirc DATA 日,月,火,水,木,金,土 DATA 31,28,31,30,31,30,31,31,30,31,30,31 DATA 0,1,2,3,5,6,0,1,3,4,5,6,1,2,3,4,6,0,1,2,4,5,6,0,2,3,4,5 ! 1月1日の曜日 DATA 5,6,1,2,3,5,6,0,2,3,4,6,0,1,3,4,5,0,1,2,4 ! 初期ユリウス暦 CALL error_check ! エラーチェック LET leap=0 ! うるう年 off LET tjleap=0 ! 通年ユリウス暦うるう年 off IF y>0 AND MOD(y,4)=0 THEN LET tjleap=1 LET jdy=y LET jdm=m LET jdd=d LET jdleap=0 ! ユリウス通日での閏年 off IF m=1 OR m=2 THEN ! 1月2月は前年の13月14月として計算 LET jdy=y-1 LET jdm=m+12 END IF ! ユリウス通日(AJD),Lilian日(LD),修正ユリウス日(MJD) DEF AJD=MJD+2400000.5 ! -4713/1/1=-0.5 (-4713/1/1/12:00=0) ユリウス通日 DEF LD=AJD-2299159.5 ! LD=MJD+100841 1582/10/15=1 Lilian日 IF y>1582 OR (y=1582 AND (m>10 OR (m=10 AND d>=15))) THEN LET gg=1 ! 1582/10/15以降 LET r$="(グレゴリオ暦・" CALL greg ! グレゴリオ暦の曜日閏年計算 LET jdleap=leap IF MOD(y,4)=0 THEN LET tjleap=1 LET MJD=gMJD(jdy,jdm,jdd) ! 修正ユリウス日 ELSE LET gg=0 IF y=1582 AND m=10 AND (d>4 AND d<15) THEN PRINT "ユリウス暦・グレゴリオ暦期間外 !!" LET jg=-1 END IF LET r$="(ユリウス暦・" LET MJD=jMJD(jdy,jdm,jdd) ! 修正ユリウス日 SELECT CASE y CASE IS >=8 ! 改良ユリウス暦 LET y1w=weekcirc(MOD(y+15,7*4)) IF MOD(y,4)=0 THEN LET leap=1 LET jdleap=leap CASE 1 TO 7 ! AD.移行期間 LET y1w=MOD(y+6,7) IF y=4 THEN LET jdleap=1 CASE -7 TO -1 ! BC.移行期間 LET y1w=y+7 IF MOD(y,4)=3 THEN LET jdleap=1 !<続く>