![続き]

![続き]
SUB greg ! グレゴリオ暦の曜日閏年計算
LET leap=0
LET c1wec=MOD(INT(y/100),4)*4+12 ! XX01年1月1日(-XX00年1月1日)のweekcirc
LET yy=MOD(y,100) ! 年号の下2桁(年号の下2桁+100)
SELECT CASE y
CASE IS>0
IF (MOD(y,4)=0 AND MOD(y,100)<>0) OR MOD(y,400)=0 THEN LET leap=1
LET y1w=weekcirc(MOD(yy+c1wec-1,7*4)) ! 1/1の曜日(y<0では異なる)
IF yy=0 AND leap=0 THEN LET y1w=y1w+1
CASE ELSE
IF (MOD(y,4)=3 AND MOD(y,100)<>99) OR MOD(y,400)=399 THEN LET leap=1
LET y1w=weekcirc(MOD(yy+c1wec,7*4)) ! 1/1の曜日
END SELECT
END SUB
FUNCTION weekcode(d) ! 曜日コード
LET ddd=0
FOR k=1 TO m-1
LET ddd=ddd+md(k)
NEXT k
IF m>=3 THEN LET ddd=ddd+leap
LET ddd=ddd+d ! 1/1からの日数
LET weekcode=MOD(ddd+y1w-1,7)
END FUNCTION
SUB calendar ! カレンダー表示
LET tb=10 ! TAB
LET cal$="## "&REPEAT$(" ## ",5)&" ##"
PRINT TAB(tb);
FOR i=0 TO 7-1
PRINT w$(i);" ";" ";
NEXT i
PRINT
PRINT TAB(tb); REPEAT$(" ",4*weekcode(1)); ! 第1週
LET i=1
DO
PRINT i;" ";
LET i=i+1
IF weekcode(i)=0 THEN EXIT DO
LOOP
IF leap=1 AND m=2 THEN LET md(m)=29 ! 第2週以降
DO
IF i+6>md(m) THEN EXIT DO
PRINT TAB(tb);
PRINT USING cal$:i,i+1,i+2,i+3,i+4,i+5,i+6
LET i=i+7
LOOP
IF i<=md(m) THEN ! 最終週
PRINT TAB(tb-1);
FOR i2=i TO md(m)
PRINT i2;
NEXT i2
PRINT
END IF
IF y=1582 AND m=10 THEN
PRINT "　ユリウス暦→グレゴリオ暦転換期(1582年10月)"
PRINT TAB(tb);
FOR i=0 TO 7-1
PRINT w$(i);" ";" ";
NEXT i
PRINT TAB(tb+5);"1 ";" ";" 2 ";" ";" 3 ";" ";" 4 ";" 15 ";" 16"
PRINT TAB(tb);"17 ";" 18 ";" 19 ";" 20 ";" 21 ";" 22 ";" 23"
PRINT TAB(tb);"24 ";" 25 ";" 26 ";" 27 ";" 28 ";" 29 ";" 30"
PRINT TAB(tb);"31"
END IF
PRINT
END SUB
SUB julian_day ! ユリウス通日
IF jdleap=0 AND m=2 AND d=29 THEN
PRINT "ユリウス通日では、この年を平年として計算する。"
PRINT "したがって、この年の2月29日のユリウス通日は存在しない。"
EXIT SUB
END IF
PRINT USING "　ユリウス通日(AJD)---##########.#":AJD ! -4713/1/1=-0.5 (-4713/1/1/12:00=0)
PRINT USING "　Lilian日(LD)--------##########":LD ! 1582/10/15=1,LD=MJD+100841
PRINT USING "　修正ユリウス日(MJD)-##########":MJD ! 1858/11/17=0
PRINT
END SUB
!(続く)

Re: !<続き>	返事を書くノートメニュー
荒田浩二 <knrztrhoel> 2008/01/20 11:52:14
![続き] SUB greg ! グレゴリオ暦の曜日閏年計算 LET leap=0 LET c1wec=MOD(INT(y/100),4)4+12 ! XX01年1月1日(-XX00年1月1日)のweekcirc LET yy=MOD(y,100) ! 年号の下2桁(年号の下2桁+100) SELECT CASE y CASE IS>0 IF (MOD(y,4)=0 AND MOD(y,100)<>0) OR MOD(y,400)=0 THEN LET leap=1 LET y1w=weekcirc(MOD(yy+c1wec-1,74)) ! 1/1の曜日(y<0では異なる) IF yy=0 AND leap=0 THEN LET y1w=y1w+1 CASE ELSE IF (MOD(y,4)=3 AND MOD(y,100)<>99) OR MOD(y,400)=399 THEN LET leap=1 LET y1w=weekcirc(MOD(yy+c1wec,74)) ! 1/1の曜日 END SELECT END SUB FUNCTION weekcode(d) ! 曜日コード LET ddd=0 FOR k=1 TO m-1 LET ddd=ddd+md(k) NEXT k IF m>=3 THEN LET ddd=ddd+leap LET ddd=ddd+d ! 1/1からの日数 LET weekcode=MOD(ddd+y1w-1,7) END FUNCTION SUB calendar ! カレンダー表示 LET tb=10 ! TAB LET cal$="## "&REPEAT$(" ## ",5)&" ##" PRINT TAB(tb); FOR i=0 TO 7-1 PRINT w$(i);" ";" "; NEXT i PRINT PRINT TAB(tb); REPEAT$(" ",4weekcode(1)); ! 第1週 LET i=1 DO PRINT i;" "; LET i=i+1 IF weekcode(i)=0 THEN EXIT DO LOOP IF leap=1 AND m=2 THEN LET md(m)=29 ! 第2週以降 DO IF i+6>md(m) THEN EXIT DO PRINT TAB(tb); PRINT USING cal$:i,i+1,i+2,i+3,i+4,i+5,i+6 LET i=i+7 LOOP IF i<=md(m) THEN ! 最終週 PRINT TAB(tb-1); FOR i2=i TO md(m) PRINT i2; NEXT i2 PRINT END IF IF y=1582 AND m=10 THEN PRINT "　ユリウス暦→グレゴリオ暦転換期(1582年10月)" PRINT TAB(tb); FOR i=0 TO 7-1 PRINT w$(i);" ";" "; NEXT i PRINT TAB(tb+5);"1 ";" ";" 2 ";" ";" 3 ";" ";" 4 ";" 15 ";" 16" PRINT TAB(tb);"17 ";" 18 ";" 19 ";" 20 ";" 21 ";" 22 ";" 23" PRINT TAB(tb);"24 ";" 25 ";" 26 ";" 27 ";" 28 ";" 29 ";" 30" PRINT TAB(tb);"31" END IF PRINT END SUB SUB julian_day ! ユリウス通日 IF jdleap=0 AND m=2 AND d=29 THEN PRINT "ユリウス通日では、この年を平年として計算する。" PRINT "したがって、この年の2月29日のユリウス通日は存在しない。" EXIT SUB END IF PRINT USING "　ユリウス通日(AJD)---##########.#":AJD ! -4713/1/1=-0.5 (-4713/1/1/12:00=0) PRINT USING "　Lilian日(LD)--------##########":LD ! 1582/10/15=1,LD=MJD+100841 PRINT USING "　修正ユリウス日(MJD)-##########":MJD ! 1858/11/17=0 PRINT END SUB !(続く)