!<続き>

!<続き>
CASE -45 TO -8 ! 初期ユリウス暦
LET y1w=juweekcirc(MOD(y+45,7*3))
IF MOD(y,3)=1 THEN LET leap=1
IF MOD(y,4)=3 THEN LET jdleap=1
CASE ELSE
PRINT "　";y;"年";m;"月";d;"日"
PRINT
PRINT "　ユリウス暦実施(BC.45年)以前 !!"
PRINT
IF MOD(y,4)=3 THEN LET jdleap=1
CALL julian_day ! ユリウス通日
CALL today ! A)本日との日数差
CALL eto ! B)干支
STOP
END SELECT
END IF
IF leap=0 AND m=2 AND d=29 THEN
IF jdleap=1 THEN
PRINT "初期のユリウス暦では、この年は平年。"
PRINT "したがって、2月29日は存在しない。"
PRINT "ただしユリウス通日では、この年を閏年として計算する。"
ELSE
PRINT USING "　-#####年##月##日":y,m,d
PRINT "　この年は平年です。この年の2月29日は存在しません。"
STOP
END IF
END IF
! 出力
LET leapc$=r$&"平年)"
IF leap=1 THEN LET leapc$=r$&"閏年)"
PRINT USING " -#####年##月##日 ##曜日 <###################":y,m,d,w$(weekcode(d)),leapc$
CALL calendar ! カレンダー表示
CALL julian_day ! ユリウス通日
CALL today ! A)本日との日数差
CALL eto ! B)干支
IF y>4 THEN
CALL all_greg ! C)通年グレゴリオ年月日
CALL all_julius ! D)通年ユリウス年月日
END IF

!! 以下、副プログラム,関数定義
SUB data_check ! 入力データチェック
LET ymd$=LTRIM$(RTRIM$(ymd0$)) ! 前後空白削除
IF ymd$(1:1)="""" THEN LET ymd$(1:1)=""
LET Lymd=LEN(ymd$)
IF ymd$(Lymd:Lymd)="""" THEN LET ymd$(Lymd:Lymd)=""
LET ymd$=LTRIM$(RTRIM$(ymd$)) ! 前後空白削除
IF ymd$(1:1)="'" THEN LET ymd$(1:1)=LEFT$(DATE$,2) !['06/2/13]対応
IF (ORD(ymd$(1:1))<48 OR ORD(ymd$(1:1))>57) AND ymd$(1:1)<>"-" THEN LET ymd$(1:1)=""
LET Lymd=LEN(ymd$)
END SUB
FUNCTION y_m_d(p) ! 年,月,日の取得
LET s$=""
IF p=1 AND ymd$(1:1)="-" THEN ! 紀元前は負号を入力 [-7/10/25]
LET s$=s$&"-"
LET p=p+1
END IF
FOR fi=p TO Lymd
IF ORD(ymd$(fi:fi))>=48 AND ORD(ymd$(fi:fi))<=57 THEN ! 数字
LET s$=s$&ymd$(fi:fi)
ELSE
EXIT FOR
END IF
NEXT fi
LET y_m_d=VAL(s$)
END FUNCTION
FUNCTION gMJD(y,m,d) ! 修正ユリウス日(グレゴリオ暦)
IF m<=2 THEN
LET y=y-1
LET m=m+12
END IF
LET gMJD=INT(365.25*y)+INT(y/400)-INT(y/100)+INT(30.59*(m-2))+d-678912
END FUNCTION
FUNCTION jMJD(y,m,d) ! 修正ユリウス日(ユリウス暦)
IF m<=2 THEN
LET y=y-1
LET m=m+12
END IF
LET jda=0
IF y<0 THEN ! 紀元前の修正ユリウス日の調整
LET jdd=d+366
LET jda=-0.75
END IF
LET jMJD=INT(365.25*y+jda)+INT(30.59*(m-2))+jdd-678914
END FUNCTION
![続く]

Re: グレゴリオ暦とユリウス暦の両方を表示でき...	返事を書くノートメニュー
荒田浩二 <knrztrhoel> 2008/01/20 11:44:36
!<続き> CASE -45 TO -8 ! 初期ユリウス暦 LET y1w=juweekcirc(MOD(y+45,73)) IF MOD(y,3)=1 THEN LET leap=1 IF MOD(y,4)=3 THEN LET jdleap=1 CASE ELSE PRINT "　";y;"年";m;"月";d;"日" PRINT PRINT "　ユリウス暦実施(BC.45年)以前 !!" PRINT IF MOD(y,4)=3 THEN LET jdleap=1 CALL julian_day ! ユリウス通日 CALL today ! A)本日との日数差 CALL eto ! B)干支 STOP END SELECT END IF IF leap=0 AND m=2 AND d=29 THEN IF jdleap=1 THEN PRINT "初期のユリウス暦では、この年は平年。" PRINT "したがって、2月29日は存在しない。" PRINT "ただしユリウス通日では、この年を閏年として計算する。" ELSE PRINT USING "　-#####年##月##日":y,m,d PRINT "　この年は平年です。この年の2月29日は存在しません。" STOP END IF END IF ! 出力 LET leapc$=r$&"平年)" IF leap=1 THEN LET leapc$=r$&"閏年)" PRINT USING " -#####年##月##日 ##曜日 <###################":y,m,d,w$(weekcode(d)),leapc$ CALL calendar ! カレンダー表示 CALL julian_day ! ユリウス通日 CALL today ! A)本日との日数差 CALL eto ! B)干支 IF y>4 THEN CALL all_greg ! C)通年グレゴリオ年月日 CALL all_julius ! D)通年ユリウス年月日 END IF !! 以下、副プログラム,関数定義 SUB data_check ! 入力データチェック LET ymd$=LTRIM$(RTRIM$(ymd0$)) ! 前後空白削除 IF ymd$(1:1)="""" THEN LET ymd$(1:1)="" LET Lymd=LEN(ymd$) IF ymd$(Lymd:Lymd)="""" THEN LET ymd$(Lymd:Lymd)="" LET ymd$=LTRIM$(RTRIM$(ymd$)) ! 前後空白削除 IF ymd$(1:1)="'" THEN LET ymd$(1:1)=LEFT$(DATE$,2) !['06/2/13]対応 IF (ORD(ymd$(1:1))<48 OR ORD(ymd$(1:1))>57) AND ymd$(1:1)<>"-" THEN LET ymd$(1:1)="" LET Lymd=LEN(ymd$) END SUB FUNCTION y_m_d(p) ! 年,月,日の取得 LET s$="" IF p=1 AND ymd$(1:1)="-" THEN ! 紀元前は負号を入力 [-7/10/25] LET s$=s$&"-" LET p=p+1 END IF FOR fi=p TO Lymd IF ORD(ymd$(fi:fi))>=48 AND ORD(ymd$(fi:fi))<=57 THEN ! 数字 LET s$=s$&ymd$(fi:fi) ELSE EXIT FOR END IF NEXT fi LET y_m_d=VAL(s$) END FUNCTION FUNCTION gMJD(y,m,d) ! 修正ユリウス日(グレゴリオ暦) IF m<=2 THEN LET y=y-1 LET m=m+12 END IF LET gMJD=INT(365.25y)+INT(y/400)-INT(y/100)+INT(30.59(m-2))+d-678912 END FUNCTION FUNCTION jMJD(y,m,d) ! 修正ユリウス日(ユリウス暦) IF m<=2 THEN LET y=y-1 LET m=m+12 END IF LET jda=0 IF y<0 THEN ! 紀元前の修正ユリウス日の調整 LET jdd=d+366 LET jda=-0.75 END IF LET jMJD=INT(365.25y+jda)+INT(30.59*(m-2))+jdd-678914 END FUNCTION ![続く]