十進BASICプログラミングについての質問や研究成果の公開にご利用ください。
メッセージ入力枠は右下をドラッグして拡大できます。 画像，URLは省略可能です。
編集/削除キーを入力しなくてもエラーにはなりませんが，何か適当な半角英数字4～8文字を指定してください。
特に，長文投稿の場合，プレビューで最後の行を確認しても，実際には途中で切れてしまうことがあるので，投稿後の確認が必要です。
月齢カレンダーの修正(二度目) - gnuutera2012or文句うさびょん URL
2025/06/01 (Sun) 00:42:52
!!月齢カレンダーの修正(二度目)!!
!' カレンダー
!'
!' 投稿者：しばっち
!' 投稿日：2014年 9月 2日(火)19時16分5秒 通報 返信・引用
!'
!' ----------------------------------------------------------------------------------------------------
!' 加筆修正者：gnuutera2012
!' ※新元号が令和となり、あちこち加筆修正させていただきました。
!' (例)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' 加筆修正加筆修正加筆修正加筆修正加筆修正加筆修正
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ----------------------------------------------------------------------------------------------------
DECLARE EXTERNAL FUNCTION SHUKU28$
DECLARE EXTERNAL FUNCTION CALC_ETO60$
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
DECLARE EXTERNAL FUNCTION TYOKU12$
DECLARE EXTERNAL FUNCTION CALC_ETO61$
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
PUBLIC STRING SEKKI24$(0 TO 23, 0 TO 1),QROKUYOU$,QJUKKAN$,Z$
PUBLIC NUMERIC QYEAR,QURUU,QMONTH,QDAY,QMAGE,QMAGENOON,QILLUMI,QMPHASE,RM_SUN0
LET A4=297/210
!' LET B5=257/182
!' LET B4=364/257
LET XSIZE=800
LET YSIZE=INT(XSIZE*A4)
LET XS=XSIZE*75/800
LET YS=YSIZE*250/800
CALL GINIT(XSIZE,YSIZE)
LET HEIGHT=XSIZE*50/800
SET TEXT HEIGHT HEIGHT
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' センター数学(BASIC)による「ゲームプログラミングの宝箱」をダウンロードして、実例\ユーティリティー\時間・日付\カレンダー.BASを開く。
!' https://hp.vector.co.jp/authors/VA008683/QA_Primary.htmも参照。
FUNCTION IsLeapYear(y) ! うるう年の判定
LET IsLeapYear=0
IF (MOD(y,4)=0 AND MOD(y,100)<>0) OR MOD(y,400)=0 THEN LET IsLeapYear=1 ! うるう年
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
DIM DD(12),MON$(12)
MAT READ DD
DATA 31,28,31,30,31,30,31,31,30,31,30,31
MAT READ MON$
DATA "睦月","如月","弥生","卯月","皐月","水無月","文月","葉月","長月","神無月","霜月","師走"
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' LET YEAR = INT(VAL(DATE$)/10000)
!' LET MONTH = MOD(INT(VAL(DATE$)/100),100)
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
INPUT PROMPT "西暦=":YEAR$
IF YEAR$<>"" THEN LET YEAR=VAL(YEAR$)
INPUT PROMPT "月=":MONTH$
IF MONTH$<>"" THEN LET MONTH=VAL(MONTH$)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF IsLeapYear(YEAR)<>0 THEN LET DD(2)=29 !うるう年なら
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
LET TM = YMDT2JD(YEAR, MONTH, 1, 0, 0, 0)
LET R=MOD(TM+2,7)
SET LINE COLOR "BLACK"
LET XX=R*XSIZE/8
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF ((YEAR= 2019 AND MONTH>= 5) AND (YEAR= 2019 AND MONTH=<12)) OR (YEAR>=2020 AND MONTH>= 1) THEN LET M$=" 令和"&STR$(YEAR-2018)&"年" !' 令和元年は2019年5月1日から。
IF ((YEAR>=1989 AND MONTH>= 1) AND (YEAR=<2018 AND MONTH=<12)) OR ((YEAR= 2019 AND MONTH>= 1) AND (YEAR= 2019 AND MONTH=< 4)) THEN LET M$=" 平成"&STR$(YEAR-1988)&"年" !' IF YEAR=<2018 AND YEAR>=1989 THEN LET GENGOUNEN$=STR$(YEAR-1988)
IF ((YEAR>=1926 AND MONTH>= 1) AND (YEAR=<1988 AND MONTH=<12)) THEN LET M$=" 昭和"&STR$(YEAR-1925)&"年" !' IF YEAR=<1988 AND YEAR>=1926 THEN LET GENGOUNEN$=STR$(YEAR-1925)
IF ((YEAR= 1912 AND MONTH>= 8) AND (YEAR= 1912 AND MONTH=<12)) OR ((YEAR>=1913 AND MONTH>= 1) AND (YEAR=<1925 AND MONTH=<12)) THEN LET M$=" 大正"&STR$(YEAR-1911)&"年" !' IF YEAR=<1925 AND YEAR>=1912 THEN LET GENGOUNEN$=STR$(YEAR-1911)
IF ((YEAR= 1868 AND MONTH>= 9) AND (YEAR= 1868 AND MONTH=<12)) OR ((YEAR>=1869 AND MONTH>= 1) AND (YEAR=<1911 AND MONTH=<12)) OR ((YEAR= 1912 AND MONTH>= 1) AND (YEAR= 1912 AND MONTH=< 7)) THEN LET M$=" 明治"&STR$(YEAR-1867)&"年" !' IF YEAR=<1911 AND YEAR>=1868 THEN LET GENGOUNEN$=STR$(YEAR-1867)
!' IF YEAR<1989 AND YEAR>=1926 THEN LET M$=" 昭和"&STR$(YEAR-1925)&"年"
!' IF YEAR<1926 AND YEAR>=1912 THEN LET M$=" 大正"&STR$(YEAR-1911)&"年"
!' IF YEAR<1912 AND YEAR>=1868 THEN LET M$=" 明治"&STR$(YEAR-1867)&"年"
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF ((YEAR= 2019 AND MONTH>= 5) AND (YEAR= 2019 AND MONTH=<12)) OR (YEAR>=2020 AND MONTH>= 1) THEN LET ERA$="令和"&RIGHT$(" "&STR$(YEAR-2018),2)&"年" ! 令和元年は2019年5月1日から。
IF ((YEAR>=1989 AND MONTH>= 1) AND (YEAR=<2018 AND MONTH=<12)) OR ((YEAR= 2019 AND MONTH>= 1) AND (YEAR= 2019 AND MONTH=< 4)) THEN LET ERA$="平成"&RIGHT$(" "&STR$(YEAR-1988),2)&"年"
IF ((YEAR>=1926 AND MONTH>= 1) AND (YEAR=<1988 AND MONTH=<12)) THEN LET ERA$="昭和"&RIGHT$(" "&STR$(YEAR-1925),2)&"年"
IF ((YEAR= 1912 AND MONTH>= 8) AND (YEAR= 1912 AND MONTH=<12)) OR ((YEAR>=1913 AND MONTH>= 1) AND (YEAR=<1925 AND MONTH=<12)) THEN LET ERA$="大正"&RIGHT$(" "&STR$(YEAR-1911),2)&"年"
IF ((YEAR= 1868 AND MONTH>= 9) AND (YEAR= 1868 AND MONTH=<12)) OR ((YEAR>=1869 AND MONTH>= 1) AND (YEAR=<1911 AND MONTH=<12)) OR ((YEAR= 1912 AND MONTH>= 1) AND (YEAR= 1912 AND MONTH=< 7)) THEN LET ERA$="明治"&RIGHT$(" "&STR$(YEAR-1867),2)&"年"
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
CALL SYMBOL(XSIZE/2-HEIGHT*3,YSIZE/8,"BLACK",STR$(YEAR)&"年"&" "&STR$(MONTH)&"月")
SET TEXT HEIGHT HEIGHT/2
CALL SYMBOL(XSIZE/2+HEIGHT*4,YSIZE/9,"BLACK",M$)
CALL SYMBOL(XSIZE/2+HEIGHT*5,YSIZE/9+HEIGHT*2/3,"BLACK",CALC_ETO60$(YEAR))
CALL SYMBOL(XSIZE/2+HEIGHT*5,YSIZE/9+HEIGHT*4/3,"BLACK",MON$(MONTH))
SET TEXT HEIGHT HEIGHT
FOR I=0 TO 6
READ A$,COL$
DATA "日","RED","月","BLACK","火","BLACK","水","BLACK","木","BLACK","金","BLACK","土","BLUE"
CALL SYMBOL(XS+I*XSIZE/8,YSIZE/4,COL$,A$)
NEXT I
CALL CALC_SEKKI24(YEAR)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
! メモ帳に用いる場合に使う。
PRINT USING ">######## >######## ":RIGHT$(" "&YEAR$,4)&"年",RIGHT$(" "&MONTH$,2)&"月"
PRINT USING ">######## >######## ":ERA$,MON$(MONTH)
PRINT USING ">######## ":CALC_ETO60$(YEAR)
PRINT USING " ######## #### ################ ########## ######## ######## ###### #### #### #### ######## ###### ######## ##########":"新暦","曜日","祝祭日","旧暦","零時月齢","正午月齢","輝面比","月相","六曜","干支","九星","十二直","二十八宿","二十四節気"
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
FOR I=1 TO DD(MONTH)
LET FL=0
SET TEXT HEIGHT HEIGHT
LET COL$=DAYCOLOR$(YEAR,MONTH,I,R)
CALL SYMBOL(XS+XX,YS+YY,COL$,USING$("##",I))
CALL CALC_KYUREKI(YEAR,MONTH,I)
IF QURUU<>0 THEN LET N$="閏" ELSE LET N$=""
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF QMONTH=1 AND QDAY=1 THEN LET Z$="旧正月"
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
LET TM = YMDT2JD(YEAR, MONTH, I, 0, 0, 0)
LET A$=CALC_JUKKAN$(TM)
LET B$=QSEI$(TM)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
! メモ帳に用いる場合に使う。
LET C$=MEMO_JUKKAN$(TM)
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
! メモ帳に用いる場合に使う。
IF MONTH=1 OR MONTH=2 THEN LET ye=YEAR-1
IF MONTH=1 THEN LET mo=13
IF MONTH=2 THEN LET mo=14
IF MONTH<>1 AND MONTH<>2 THEN LET ye=YEAR
IF MONTH<>1 AND MONTH<>2 THEN LET mo=MONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET NIJYUUHASSHUKU=MOD(INT(12.25*c)+INT(1.25*n)+INT(2.6*(mo+1))+16+I,28)
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
DIM SEKKIOF24$(31)
FOR K=0 TO 23
IF VAL(SEKKI24$(K, 0)(6:7))=MONTH AND VAL(SEKKI24$(K, 0)(9:10))=I THEN
IF Z$<>"" THEN
LET SEKKIOF24$(I)=SEKKI24$(K, 1)
LET FL=1
ELSE
LET SEKKIOF24$(I)=SEKKI24$(K, 1)
LET FL=2
END IF
EXIT FOR
END IF
NEXT K
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
LET JDSHOUKANN=YMDT2JD(YEAR, VAL(SEKKI24$(0, 0)(6:6))*10+VAL(SEKKI24$(0, 0)(7:7)), VAL(SEKKI24$(0, 0)(9:9))*10+VAL(SEKKI24$(0, 0)(10:10)), 0, 0, 0)
FOR JUSHI=1 TO 12 !' Jではなく、JUSHIとする。
LET JDSHOUKANNUSHIKOUHO=JDSHOUKANN+JUSHI !' Jではなく、JUSHIとする。
LET DATEOFSHOUKANNUSHIKOUHO$=JD2YMDT$(JDSHOUKANNUSHIKOUHO)
LET SHOUKANNUSHIKOUHOMONTH=VAL(DATEOFSHOUKANNUSHIKOUHO$(6:6))*10+VAL(DATEOFSHOUKANNUSHIKOUHO$(7:7))
LET SHOUKANNUSHIKOUHODAY=VAL(DATEOFSHOUKANNUSHIKOUHO$(9:9))*10+VAL(DATEOFSHOUKANNUSHIKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,SHOUKANNUSHIKOUHOMONTH,SHOUKANNUSHIKOUHODAY, 0, 0, 0)
IF SHOUKANNUSHIKOUHOMONTH=1 OR SHOUKANNUSHIKOUHOMONTH=2 THEN LET ye=YEAR-1
IF SHOUKANNUSHIKOUHOMONTH=1 THEN LET mo=13
IF SHOUKANNUSHIKOUHOMONTH=2 THEN LET mo=14
IF SHOUKANNUSHIKOUHOMONTH<>1 AND SHOUKANNUSHIKOUHOMONTH<>2 THEN LET ye=YEAR
IF SHOUKANNUSHIKOUHOMONTH<>1 AND SHOUKANNUSHIKOUHOMONTH<>2 THEN LET mo=SHOUKANNUSHIKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+SHOUKANNUSHIKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF SHOUKANNUSHIKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="丑" THEN LET SHOUKANNUSHIMONTH=SHOUKANNUSHIKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="丑" THEN LET SHOUKANNUSHIDAY=SHOUKANNUSHIKOUHODAY
IF ETOMOJIWATASHI$(2:2)="丑" THEN EXIT FOR
NEXT JUSHI !' Jではなく、JUSHIとする。
LET JDRISSHUNN=YMDT2JD(YEAR, VAL(SEKKI24$(2, 0)(6:6))*10+VAL(SEKKI24$(2, 0)(7:7)), VAL(SEKKI24$(2, 0)(9:9))*10+VAL(SEKKI24$(2, 0)(10:10)), 0, 0, 0)
FOR JTORA=1 TO 12 !' Jではなく、JTORAとする。
LET JDRISSHUNNTORAKOUHO=JDRISSHUNN+JTORA !' Jではなく、JTORAとする。
LET DATEOFRISSHUNNTORAKOUHO$=JD2YMDT$(JDRISSHUNNTORAKOUHO)
LET RISSHUNNTORAKOUHOMONTH=VAL(DATEOFRISSHUNNTORAKOUHO$(6:6))*10+VAL(DATEOFRISSHUNNTORAKOUHO$(7:7))
LET RISSHUNNTORAKOUHODAY=VAL(DATEOFRISSHUNNTORAKOUHO$(9:9))*10+VAL(DATEOFRISSHUNNTORAKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,RISSHUNNTORAKOUHOMONTH,RISSHUNNTORAKOUHODAY, 0, 0, 0)
IF RISSHUNNTORAKOUHOMONTH=1 OR RISSHUNNTORAKOUHOMONTH=2 THEN LET ye=YEAR-1
IF RISSHUNNTORAKOUHOMONTH=1 THEN LET mo=13
IF RISSHUNNTORAKOUHOMONTH=2 THEN LET mo=14
IF RISSHUNNTORAKOUHOMONTH<>1 AND RISSHUNNTORAKOUHOMONTH<>2 THEN LET ye=YEAR
IF RISSHUNNTORAKOUHOMONTH<>1 AND RISSHUNNTORAKOUHOMONTH<>2 THEN LET mo=RISSHUNNTORAKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+RISSHUNNTORAKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF RISSHUNNTORAKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="寅" THEN LET RISSHUNNTORAMONTH=RISSHUNNTORAKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="寅" THEN LET RISSHUNNTORADAY=RISSHUNNTORAKOUHODAY
IF ETOMOJIWATASHI$(2:2)="寅" THEN EXIT FOR
NEXT JTORA !' Jではなく、JTORAとする。
LET JDKEICHITU=YMDT2JD(YEAR, VAL(SEKKI24$(4, 0)(6:6))*10+VAL(SEKKI24$(4, 0)(7:7)), VAL(SEKKI24$(4, 0)(9:9))*10+VAL(SEKKI24$(4, 0)(10:10)), 0, 0, 0)
FOR JUU=1 TO 12 !' Jではなく、JUUとする。
LET JDKEICHITUUUKOUHO=JDKEICHITU+JUU !' Jではなく、JUUとする。
LET DATEOFKEICHITUUUKOUHO$=JD2YMDT$(JDKEICHITUUUKOUHO)
LET KEICHITUUUKOUHOMONTH=VAL(DATEOFKEICHITUUUKOUHO$(6:6))*10+VAL(DATEOFKEICHITUUUKOUHO$(7:7))
LET KEICHITUUUKOUHODAY=VAL(DATEOFKEICHITUUUKOUHO$(9:9))*10+VAL(DATEOFKEICHITUUUKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,KEICHITUUUKOUHOMONTH,KEICHITUUUKOUHODAY, 0, 0, 0)
IF KEICHITUUUKOUHOMONTH=1 OR KEICHITUUUKOUHOMONTH=2 THEN LET ye=YEAR-1
IF KEICHITUUUKOUHOMONTH=1 THEN LET mo=13
IF KEICHITUUUKOUHOMONTH=2 THEN LET mo=14
IF KEICHITUUUKOUHOMONTH<>1 AND KEICHITUUUKOUHOMONTH<>2 THEN LET ye=YEAR
IF KEICHITUUUKOUHOMONTH<>1 AND KEICHITUUUKOUHOMONTH<>2 THEN LET mo=KEICHITUUUKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+KEICHITUUUKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF KEICHITUUUKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="卯" THEN LET KEICHITUUUMONTH=KEICHITUUUKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="卯" THEN LET KEICHITUUUDAY=KEICHITUUUKOUHODAY
IF ETOMOJIWATASHI$(2:2)="卯" THEN EXIT FOR
NEXT JUU !' Jではなく、JUUとする。
LET JDSEIMEI=YMDT2JD(YEAR, VAL(SEKKI24$(6, 0)(6:6))*10+VAL(SEKKI24$(6, 0)(7:7)), VAL(SEKKI24$(6, 0)(9:9))*10+VAL(SEKKI24$(6, 0)(10:10)), 0, 0, 0)
FOR JTATSU=1 TO 12 !' Jではなく、JTATSUとする。
LET JDSEIMEITATSUKOUHO=JDSEIMEI+JTATSU !' Jではなく、JTATSUとする。
LET DATEOFSEIMEITATSUKOUHO$=JD2YMDT$(JDSEIMEITATSUKOUHO)
LET SEIMEITATSUKOUHOMONTH=VAL(DATEOFSEIMEITATSUKOUHO$(6:6))*10+VAL(DATEOFSEIMEITATSUKOUHO$(7:7))
LET SEIMEITATSUKOUHODAY=VAL(DATEOFSEIMEITATSUKOUHO$(9:9))*10+VAL(DATEOFSEIMEITATSUKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,SEIMEITATSUKOUHOMONTH,SEIMEITATSUKOUHODAY, 0, 0, 0)
IF SEIMEITATSUKOUHOMONTH=1 OR SEIMEITATSUKOUHOMONTH=2 THEN LET ye=YEAR-1
IF SEIMEITATSUKOUHOMONTH=1 THEN LET mo=13
IF SEIMEITATSUKOUHOMONTH=2 THEN LET mo=14
IF SEIMEITATSUKOUHOMONTH<>1 AND SEIMEITATSUKOUHOMONTH<>2 THEN LET ye=YEAR
IF SEIMEITATSUKOUHOMONTH<>1 AND SEIMEITATSUKOUHOMONTH<>2 THEN LET mo=SEIMEITATSUKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+SEIMEITATSUKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF SEIMEITATSUKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="辰" THEN LET SEIMEITATSUMONTH=SEIMEITATSUKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="辰" THEN LET SEIMEITATSUDAY=SEIMEITATSUKOUHODAY
IF ETOMOJIWATASHI$(2:2)="辰" THEN EXIT FOR
NEXT JTATSU !' Jではなく、JTATSUとする。
LET JDRIKKA=YMDT2JD(YEAR, VAL(SEKKI24$(8, 0)(6:6))*10+VAL(SEKKI24$(8, 0)(7:7)), VAL(SEKKI24$(8, 0)(9:9))*10+VAL(SEKKI24$(8, 0)(10:10)), 0, 0, 0)
FOR JMI=1 TO 12 !' Jではなく、JMIとする。
LET JDRIKKAMIKOUHO=JDRIKKA+JMI !' Jではなく、JMIとする。
LET DATEOFRIKKAMIKOUHO$=JD2YMDT$(JDRIKKAMIKOUHO)
LET RIKKAMIKOUHOMONTH=VAL(DATEOFRIKKAMIKOUHO$(6:6))*10+VAL(DATEOFRIKKAMIKOUHO$(7:7))
LET RIKKAMIKOUHODAY=VAL(DATEOFRIKKAMIKOUHO$(9:9))*10+VAL(DATEOFRIKKAMIKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,RIKKAMIKOUHOMONTH,RIKKAMIKOUHODAY, 0, 0, 0)
IF RIKKAMIKOUHOMONTH=1 OR RIKKAMIKOUHOMONTH=2 THEN LET ye=YEAR-1
IF RIKKAMIKOUHOMONTH=1 THEN LET mo=13
IF RIKKAMIKOUHOMONTH=2 THEN LET mo=14
IF RIKKAMIKOUHOMONTH<>1 AND RIKKAMIKOUHOMONTH<>2 THEN LET ye=YEAR
IF RIKKAMIKOUHOMONTH<>1 AND RIKKAMIKOUHOMONTH<>2 THEN LET mo=RIKKAMIKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+RIKKAMIKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF RIKKAMIKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="巳" THEN LET RIKKAMIMONTH=RIKKAMIKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="巳" THEN LET RIKKAMIDAY=RIKKAMIKOUHODAY
IF ETOMOJIWATASHI$(2:2)="巳" THEN EXIT FOR
NEXT JMI !' Jではなく、JMIとする。
LET JDBOUSHU=YMDT2JD(YEAR, VAL(SEKKI24$(10, 0)(6:6))*10+VAL(SEKKI24$(10, 0)(7:7)), VAL(SEKKI24$(10, 0)(9:9))*10+VAL(SEKKI24$(10, 0)(10:10)), 0, 0, 0)
FOR JUMA=1 TO 12 !' Jではなく、JUMAとする。
LET JDBOUSHUUMAKOUHO=JDBOUSHU+JUMA !' Jではなく、JUMAとする。
LET DATEOFBOUSHUUMAKOUHO$=JD2YMDT$(JDBOUSHUUMAKOUHO)
LET BOUSHUUMAKOUHOMONTH=VAL(DATEOFBOUSHUUMAKOUHO$(6:6))*10+VAL(DATEOFBOUSHUUMAKOUHO$(7:7))
LET BOUSHUUMAKOUHODAY=VAL(DATEOFBOUSHUUMAKOUHO$(9:9))*10+VAL(DATEOFBOUSHUUMAKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,BOUSHUUMAKOUHOMONTH,BOUSHUUMAKOUHODAY, 0, 0, 0)
IF BOUSHUUMAKOUHOMONTH=1 OR BOUSHUUMAKOUHOMONTH=2 THEN LET ye=YEAR-1
IF BOUSHUUMAKOUHOMONTH=1 THEN LET mo=13
IF BOUSHUUMAKOUHOMONTH=2 THEN LET mo=14
IF BOUSHUUMAKOUHOMONTH<>1 AND BOUSHUUMAKOUHOMONTH<>2 THEN LET ye=YEAR
IF BOUSHUUMAKOUHOMONTH<>1 AND BOUSHUUMAKOUHOMONTH<>2 THEN LET mo=BOUSHUUMAKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+BOUSHUUMAKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF BOUSHUUMAKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="午" THEN LET BOUSHUUMAMONTH=BOUSHUUMAKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="午" THEN LET BOUSHUUMADAY=BOUSHUUMAKOUHODAY
IF ETOMOJIWATASHI$(2:2)="午" THEN EXIT FOR
NEXT JUMA !' Jではなく、JUMAとする。
LET JDSHOUSHO=YMDT2JD(YEAR, VAL(SEKKI24$(12, 0)(6:6))*10+VAL(SEKKI24$(12, 0)(7:7)), VAL(SEKKI24$(12, 0)(9:9))*10+VAL(SEKKI24$(12, 0)(10:10)), 0, 0, 0)
FOR JHITUJI=1 TO 12 !' Jではなく、JHITUJIとする。
LET JDSHOUSHOHITUJIKOUHO=JDSHOUSHO+JHITUJI !' Jではなく、JHITUJIとする。
LET DATEOFSHOUSHOHITUJIKOUHO$=JD2YMDT$(JDSHOUSHOHITUJIKOUHO)
LET SHOUSHOHITUJIKOUHOMONTH=VAL(DATEOFSHOUSHOHITUJIKOUHO$(6:6))*10+VAL(DATEOFSHOUSHOHITUJIKOUHO$(7:7))
LET SHOUSHOHITUJIKOUHODAY=VAL(DATEOFSHOUSHOHITUJIKOUHO$(9:9))*10+VAL(DATEOFSHOUSHOHITUJIKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,SHOUSHOHITUJIKOUHOMONTH,SHOUSHOHITUJIKOUHODAY, 0, 0, 0)
IF SHOUSHOHITUJIKOUHOMONTH=1 OR SHOUSHOHITUJIKOUHOMONTH=2 THEN LET ye=YEAR-1
IF SHOUSHOHITUJIKOUHOMONTH=1 THEN LET mo=13
IF SHOUSHOHITUJIKOUHOMONTH=2 THEN LET mo=14
IF SHOUSHOHITUJIKOUHOMONTH<>1 AND SHOUSHOHITUJIKOUHOMONTH<>2 THEN LET ye=YEAR
IF SHOUSHOHITUJIKOUHOMONTH<>1 AND SHOUSHOHITUJIKOUHOMONTH<>2 THEN LET mo=SHOUSHOHITUJIKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+SHOUSHOHITUJIKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF SHOUSHOHITUJIKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="未" THEN LET SHOUSHOHITUJIMONTH=SHOUSHOHITUJIKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="未" THEN LET SHOUSHOHITUJIDAY=SHOUSHOHITUJIKOUHODAY
IF ETOMOJIWATASHI$(2:2)="未" THEN EXIT FOR
NEXT JHITUJI !' Jではなく、JHITUJIとする。
LET JDRISSHUU=YMDT2JD(YEAR, VAL(SEKKI24$(14, 0)(6:6))*10+VAL(SEKKI24$(14, 0)(7:7)), VAL(SEKKI24$(14, 0)(9:9))*10+VAL(SEKKI24$(14, 0)(10:10)), 0, 0, 0)
FOR JSARU=1 TO 12 !' Jではなく、JSARUとする。
LET JDRISSHUUSARUKOUHO=JDRISSHUU+JSARU !' Jではなく、JSARUとする。
LET DATEOFRISSHUUSARUKOUHO$=JD2YMDT$(JDRISSHUUSARUKOUHO)
LET RISSHUUSARUKOUHOMONTH=VAL(DATEOFRISSHUUSARUKOUHO$(6:6))*10+VAL(DATEOFRISSHUUSARUKOUHO$(7:7))
LET RISSHUUSARUKOUHODAY=VAL(DATEOFRISSHUUSARUKOUHO$(9:9))*10+VAL(DATEOFRISSHUUSARUKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,RISSHUUSARUKOUHOMONTH,RISSHUUSARUKOUHODAY, 0, 0, 0)
IF RISSHUUSARUKOUHOMONTH=1 OR RISSHUUSARUKOUHOMONTH=2 THEN LET ye=YEAR-1
IF RISSHUUSARUKOUHOMONTH=1 THEN LET mo=13
IF RISSHUUSARUKOUHOMONTH=2 THEN LET mo=14
IF RISSHUUSARUKOUHOMONTH<>1 AND RISSHUUSARUKOUHOMONTH<>2 THEN LET ye=YEAR
IF RISSHUUSARUKOUHOMONTH<>1 AND RISSHUUSARUKOUHOMONTH<>2 THEN LET mo=RISSHUUSARUKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+RISSHUUSARUKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF RISSHUUSARUKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="申" THEN LET RISSHUUSARUMONTH=RISSHUUSARUKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="申" THEN LET RISSHUUSARUDAY=RISSHUUSARUKOUHODAY
IF ETOMOJIWATASHI$(2:2)="申" THEN EXIT FOR
NEXT JSARU !' Jではなく、JSARUとする。
LET JDHAKURO=YMDT2JD(YEAR, VAL(SEKKI24$(16, 0)(6:6))*10+VAL(SEKKI24$(16, 0)(7:7)), VAL(SEKKI24$(16, 0)(9:9))*10+VAL(SEKKI24$(16, 0)(10:10)), 0, 0, 0)
FOR JTORI=1 TO 12 !' Jではなく、JTORIとする。
LET JDHAKUROTORIKOUHO=JDHAKURO+JTORI !' Jではなく、JTORIとする。
LET DATEOFHAKUROTORIKOUHO$=JD2YMDT$(JDHAKUROTORIKOUHO)
LET HAKUROTORIKOUHOMONTH=VAL(DATEOFHAKUROTORIKOUHO$(6:6))*10+VAL(DATEOFHAKUROTORIKOUHO$(7:7))
LET HAKUROTORIKOUHODAY=VAL(DATEOFHAKUROTORIKOUHO$(9:9))*10+VAL(DATEOFHAKUROTORIKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,HAKUROTORIKOUHOMONTH,HAKUROTORIKOUHODAY, 0, 0, 0)
IF HAKUROTORIKOUHOMONTH=1 OR HAKUROTORIKOUHOMONTH=2 THEN LET ye=YEAR-1
IF HAKUROTORIKOUHOMONTH=1 THEN LET mo=13
IF HAKUROTORIKOUHOMONTH=2 THEN LET mo=14
IF HAKUROTORIKOUHOMONTH<>1 AND HAKUROTORIKOUHOMONTH<>2 THEN LET ye=YEAR
IF HAKUROTORIKOUHOMONTH<>1 AND HAKUROTORIKOUHOMONTH<>2 THEN LET mo=HAKUROTORIKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+HAKUROTORIKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF RISSHUUSARUKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="酉" THEN LET HAKUROTORIMONTH=HAKUROTORIKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="酉" THEN LET HAKUROTORIDAY=HAKUROTORIKOUHODAY
IF ETOMOJIWATASHI$(2:2)="酉" THEN EXIT FOR
NEXT JTORI !' Jではなく、JTORIとする。
LET JDKANNRO=YMDT2JD(YEAR, VAL(SEKKI24$(18, 0)(6:6))*10+VAL(SEKKI24$(18, 0)(7:7)), VAL(SEKKI24$(18, 0)(9:9))*10+VAL(SEKKI24$(18, 0)(10:10)), 0, 0, 0)
FOR JINU=1 TO 12 !' Jではなく、JINUとする。
LET JDKANNROINUKOUHO=JDKANNRO+JINU !' Jではなく、JINUとする。転記ミス発見。LET JDKANNROINUKOUHO=JDHAKURO+JINUをLET JDKANNROINUKOUHO=JDKANNRO+JINUに直した。
LET DATEOFKANNROINUKOUHO$=JD2YMDT$(JDKANNROINUKOUHO)
LET KANNROINUKOUHOMONTH=VAL(DATEOFKANNROINUKOUHO$(6:6))*10+VAL(DATEOFKANNROINUKOUHO$(7:7))
LET KANNROINUKOUHODAY=VAL(DATEOFKANNROINUKOUHO$(9:9))*10+VAL(DATEOFKANNROINUKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,KANNROINUKOUHOMONTH,KANNROINUKOUHODAY, 0, 0, 0)
IF KANNROINUKOUHOMONTH=1 OR KANNROINUKOUHOMONTH=2 THEN LET ye=YEAR-1
IF KANNROINUKOUHOMONTH=1 THEN LET mo=13
IF KANNROINUKOUHOMONTH=2 THEN LET mo=14
IF KANNROINUKOUHOMONTH<>1 AND KANNROINUKOUHOMONTH<>2 THEN LET ye=YEAR
IF KANNROINUKOUHOMONTH<>1 AND KANNROINUKOUHOMONTH<>2 THEN LET mo=KANNROINUKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+KANNROINUKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF KANNROINUKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="戌" THEN LET KANNROINUMONTH=KANNROINUKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="戌" THEN LET KANNROINUDAY=KANNROINUKOUHODAY
IF ETOMOJIWATASHI$(2:2)="戌" THEN EXIT FOR
NEXT JINU !' Jではなく、JINUとする。
LET JDRITTOU=YMDT2JD(YEAR, VAL(SEKKI24$(20, 0)(6:6))*10+VAL(SEKKI24$(20, 0)(7:7)), VAL(SEKKI24$(20, 0)(9:9))*10+VAL(SEKKI24$(20, 0)(10:10)), 0, 0, 0)
FOR JII=1 TO 12 !' Jではなく、JIIとする。
LET JDRITTOUIIKOUHO=JDRITTOU+JII !' Jではなく、JIIとする。
LET DATEOFRITTOUIIKOUHO$=JD2YMDT$(JDRITTOUIIKOUHO)
LET RITTOUIIKOUHOMONTH=VAL(DATEOFRITTOUIIKOUHO$(6:6))*10+VAL(DATEOFRITTOUIIKOUHO$(7:7))
LET RITTOUIIKOUHODAY=VAL(DATEOFRITTOUIIKOUHO$(9:9))*10+VAL(DATEOFRITTOUIIKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,RITTOUIIKOUHOMONTH,RITTOUIIKOUHODAY, 0, 0, 0)
IF RITTOUIIKOUHOMONTH=1 OR RITTOUIIKOUHOMONTH=2 THEN LET ye=YEAR-1
IF RITTOUIIKOUHOMONTH=1 THEN LET mo=13
IF RITTOUIIKOUHOMONTH=2 THEN LET mo=14
IF RITTOUIIKOUHOMONTH<>1 AND RITTOUIIKOUHOMONTH<>2 THEN LET ye=YEAR
IF RITTOUIIKOUHOMONTH<>1 AND RITTOUIIKOUHOMONTH<>2 THEN LET mo=RITTOUIIKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+RITTOUIIKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF RITTOUIIKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="亥" THEN LET RITTOUIIMONTH=RITTOUIIKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="亥" THEN LET RITTOUIIDAY=RITTOUIIKOUHODAY
IF ETOMOJIWATASHI$(2:2)="亥" THEN EXIT FOR
NEXT JII !' Jではなく、JIIとする。
LET JDDAISETSU=YMDT2JD(YEAR, VAL(SEKKI24$(22, 0)(6:6))*10+VAL(SEKKI24$(22, 0)(7:7)), VAL(SEKKI24$(22, 0)(9:9))*10+VAL(SEKKI24$(22, 0)(10:10)), 0, 0, 0)
FOR JNE=1 TO 12 !' Jではなく、JNEとする。
LET JDDAISETSUNEKOUHO=JDDAISETSU+JNE !' Jではなく、JNEとする。
LET DATEOFDAISETSUNEKOUHO$=JD2YMDT$(JDDAISETSUNEKOUHO)
LET DAISETSUNEKOUHOMONTH=VAL(DATEOFDAISETSUNEKOUHO$(6:6))*10+VAL(DATEOFDAISETSUNEKOUHO$(7:7))
LET DAISETSUNEKOUHODAY=VAL(DATEOFDAISETSUNEKOUHO$(9:9))*10+VAL(DATEOFDAISETSUNEKOUHO$(10:10))
LET TM=YMDT2JD(YEAR,DAISETSUNEKOUHOMONTH,DAISETSUNEKOUHODAY, 0, 0, 0)
IF DAISETSUNEKOUHOMONTH=1 OR DAISETSUNEKOUHOMONTH=2 THEN LET ye=YEAR-1
IF DAISETSUNEKOUHOMONTH=1 THEN LET mo=13
IF DAISETSUNEKOUHOMONTH=2 THEN LET mo=14
IF DAISETSUNEKOUHOMONTH<>1 AND DAISETSUNEKOUHOMONTH<>2 THEN LET ye=YEAR
IF DAISETSUNEKOUHOMONTH<>1 AND DAISETSUNEKOUHOMONTH<>2 THEN LET mo=DAISETSUNEKOUHOMONTH
LET c=INT(ye/100)
LET n=ye-INT(ye/100)*100
LET JYUUNISHIJOUYOKEI=MOD(INT(44.25*c)+INT(5.25*n)+INT(30.6*(mo+1))+6+DAISETSUNEKOUHODAY,12)
LET ETOMOJIWATASHI$=CALC_ETO61$(JYUUNISHIJOUYOKEI) !' IF DAISETSUNEKOUHODAY>SD THENは不要かも?結局削除した。
IF ETOMOJIWATASHI$(2:2)="子" THEN LET DAISETSUNEMONTH=DAISETSUNEKOUHOMONTH
IF ETOMOJIWATASHI$(2:2)="子" THEN LET DAISETSUNEDAY=DAISETSUNEKOUHODAY
IF ETOMOJIWATASHI$(2:2)="子" THEN EXIT FOR
NEXT JNE !' Jではなく、JNEとする。
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
DIM TYOKUOF12$(42)
IF MONTH=SHOUKANNUSHIMONTH AND I <SHOUKANNUSHIDAY-JUSHI AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUKANNUSHIDAY+1,12))
IF MONTH=SHOUKANNUSHIMONTH AND I=>SHOUKANNUSHIDAY-JUSHI AND I=<DD(SHOUKANNUSHIMONTH) THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUKANNUSHIDAY,12))
IF MONTH=RISSHUNNTORAMONTH AND I <RISSHUNNTORADAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUKANNUSHIDAY +DD(SHOUKANNUSHIMONTH),12))
IF MONTH=RISSHUNNTORAMONTH AND I=>RISSHUNNTORADAY-JTORA AND I<RISSHUNNTORADAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUKANNUSHIDAY +DD(SHOUKANNUSHIMONTH)-1,12))
IF MONTH=RISSHUNNTORAMONTH AND I=>RISSHUNNTORADAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUNNTORADAY,12))
IF MONTH=KEICHITUUUMONTH AND I <KEICHITUUUDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUNNTORADAY +DD(RISSHUNNTORAMONTH),12))
IF MONTH=KEICHITUUUMONTH AND I=>KEICHITUUUDAY-JUU AND I<KEICHITUUUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUNNTORADAY +DD(RISSHUNNTORAMONTH)-1,12))
IF MONTH=KEICHITUUUMONTH AND I=>KEICHITUUUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KEICHITUUUDAY,12))
IF MONTH=SEIMEITATSUMONTH AND I <SEIMEITATSUDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KEICHITUUUDAY +DD(KEICHITUUUMONTH),12))
IF MONTH=SEIMEITATSUMONTH AND I=>SEIMEITATSUDAY-JTATSU AND I<SEIMEITATSUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KEICHITUUUDAY +DD(KEICHITUUUMONTH)-1,12))
IF MONTH=SEIMEITATSUMONTH AND I=>SEIMEITATSUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SEIMEITATSUDAY,12))
IF MONTH=RIKKAMIMONTH AND I <RIKKAMIDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SEIMEITATSUDAY +DD(SEIMEITATSUMONTH),12))
IF MONTH=RIKKAMIMONTH AND I=>RIKKAMIDAY-JMI AND I<RIKKAMIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SEIMEITATSUDAY +DD(SEIMEITATSUMONTH)-1,12))
IF MONTH=RIKKAMIMONTH AND I=>RIKKAMIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RIKKAMIDAY,12))
IF MONTH=BOUSHUUMAMONTH AND I <BOUSHUUMADAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RIKKAMIDAY +DD(RIKKAMIMONTH),12))
IF MONTH=BOUSHUUMAMONTH AND I=>BOUSHUUMADAY-JUMA AND I<BOUSHUUMADAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RIKKAMIDAY +DD(RIKKAMIMONTH)-1,12))
IF MONTH=BOUSHUUMAMONTH AND I=>BOUSHUUMADAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-BOUSHUUMADAY,12))
IF MONTH=SHOUSHOHITUJIMONTH AND I <SHOUSHOHITUJIDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-BOUSHUUMADAY +DD(BOUSHUUMAMONTH),12))
IF MONTH=SHOUSHOHITUJIMONTH AND I=>SHOUSHOHITUJIDAY-JHITUJI AND I<SHOUSHOHITUJIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-BOUSHUUMADAY +DD(BOUSHUUMAMONTH)-1,12))
IF MONTH=SHOUSHOHITUJIMONTH AND I=>SHOUSHOHITUJIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUSHOHITUJIDAY,12))
IF MONTH=RISSHUUSARUMONTH AND I <RISSHUUSARUDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUSHOHITUJIDAY +DD(SHOUSHOHITUJIMONTH),12))
IF MONTH=RISSHUUSARUMONTH AND I=>RISSHUUSARUDAY-JSARU AND I<RISSHUUSARUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-SHOUSHOHITUJIDAY +DD(SHOUSHOHITUJIMONTH)-1,12)) !' RISSHUUSARUDAY-JSARU =< I < RISSHUUSARUDAY を満たす日だけはRISSHUUSARUDAY-JSARUの日はRISSHUUSARUDAY-JSARU-1の十二直を一日だけ繰り返したあとで、さらに規則を続ける。
IF MONTH=RISSHUUSARUMONTH AND I=>RISSHUUSARUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUUSARUDAY,12))
IF MONTH=HAKUROTORIMONTH AND I <HAKUROTORIDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUUSARUDAY +DD(RISSHUUSARUMONTH),12))
IF MONTH=HAKUROTORIMONTH AND I=>HAKUROTORIDAY-JTORI AND I<HAKUROTORIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RISSHUUSARUDAY +DD(RISSHUUSARUMONTH)-1,12))
IF MONTH=HAKUROTORIMONTH AND I=>HAKUROTORIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-HAKUROTORIDAY,12))
IF MONTH=KANNROINUMONTH AND I <KANNROINUDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-HAKUROTORIDAY +DD(HAKUROTORIMONTH),12))
IF MONTH=KANNROINUMONTH AND I=>KANNROINUDAY-JINU AND I<KANNROINUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-HAKUROTORIDAY +DD(HAKUROTORIMONTH)-1,12))
IF MONTH=KANNROINUMONTH AND I=>KANNROINUDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KANNROINUDAY,12))
IF MONTH=RITTOUIIMONTH AND I <RITTOUIIDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KANNROINUDAY +DD(KANNROINUMONTH),12))
IF MONTH=RITTOUIIMONTH AND I=>RITTOUIIDAY-JII AND I<RITTOUIIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-KANNROINUDAY +DD(KANNROINUMONTH)-1,12))
IF MONTH=RITTOUIIMONTH AND I=>RITTOUIIDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RITTOUIIDAY,12))
IF MONTH=DAISETSUNEMONTH AND I <DAISETSUNEDAY AND I>0 THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RITTOUIIDAY +DD(RITTOUIIMONTH),12))
IF MONTH=DAISETSUNEMONTH AND I=>DAISETSUNEDAY-JNE AND I<DAISETSUNEDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-RITTOUIIDAY +DD(RITTOUIIMONTH)-1,12))
IF MONTH=DAISETSUNEMONTH AND I=>DAISETSUNEDAY THEN LET TYOKUOF12$(I)=TYOKU12$(MOD(I-DAISETSUNEDAY,12))
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
SET TEXT HEIGHT HEIGHT*.2
CALL MOON(XS+XX+HEIGHT*.6,YS+YY+HEIGHT*.5,HEIGHT*.5,QMAGENOON-.5,QILLUMI/100)
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*.25,COL$,QROKUYOU$&" "&N$&STR$(QMONTH)&"/"&STR$(QDAY))
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*.5,COL$,A$)
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*.75,COL$,B$)
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.0,COL$,TYOKUOF12$(I))
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.25,COL$,SHUKU28$(NIJYUUHASSHUKU))
IF Z$<>"" THEN CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.5,"GREEN",Z$)
FOR K=0 TO 23
IF VAL(SEKKI24$(K, 0)(6:7))=MONTH AND VAL(SEKKI24$(K, 0)(9:10))=I THEN
IF Z$<>"" THEN
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.75,"MAGENTA",SEKKI24$(K, 1))
LET FL=1
ELSE
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.5,"MAGENTA",SEKKI24$(K, 1))
LET FL=2
END IF
EXIT FOR
END IF
NEXT K
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
FOR K=0 TO 23
IF VAL(SEKKI24$(K, 0)(6:7))=MONTH THEN
IF VAL(SEKKI24$(K, 0)(9:10))= I THEN
IF MOD(I+R-1,7)=0 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","日",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=1 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","月",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=2 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","火",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=3 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","水",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=4 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","木",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=5 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","金",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=6 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","土",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
ELSE
IF MOD(I+R-1,7)=0 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","日",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=1 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","月",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=2 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","火",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=3 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","水",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=4 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","木",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=5 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","金",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
IF MOD(I+R-1,7)=6 THEN
PRINT USING ">######## ####>################>########## --.# --.#>######>####>####>####>########>######>########>##########" : RIGHT$(" "&MONTH$,2)&"月"&RIGHT$(" "&STR$(I),2)&"日","土",Z$,RIGHT$(" "&N$&STR$(QMONTH),3)&"月"&RIGHT$(" "&STR$(QDAY),2)&"日",QMAGE,QMAGENOON,QILLUMI,QMPHASE,QROKUYOU$,C$,B$,TYOKUOF12$(I),SHUKU28$(NIJYUUHASSHUKU),SEKKIOF24$(I)
END IF
END IF
EXIT FOR
END IF
NEXT K
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
IF QMPHASE=14 THEN
LET S$="満月"
ELSEIF QMPHASE=0 THEN
LET S$="新月"
ELSE
!'LET S$=USING$("##.#",QILLUMI)&"%"
LET S$=""
END IF
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF S$<>"" THEN
IF Z$="" AND FL<>2 THEN
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.6,"BLUE",S$)
ELSEIF FL<>1 THEN
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.8,"BLUE",S$)
ELSE
CALL SYMBOL(XS+XX,YS+YY+HEIGHT*2.0,"BLUE",S$)
END IF
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
LET XX=XX+XSIZE/8
IF MOD(R+I,7)=0 THEN
LET XX=0
LET YY=YY+YSIZE/8
END IF
NEXT I
END
EXTERNAL SUB GINIT(XSIZE,YSIZE)
SET BITMAP SIZE XSIZE,YSIZE
SET WINDOW 0,XSIZE-1,YSIZE-1,0
SET POINT STYLE 1
SET COLOR MODE "REGULAR"
CLEAR
END SUB
EXTERNAL SUB SYMBOL(X,Y,COL$,A$)
SET TEXT COLOR COL$
PLOT TEXT,AT X,Y:A$
END SUB
EXTERNAL FUNCTION DAYCOLOR$(Y,M,N,R)
LET DAYCOLOR$="BLACK"
LET Z$=""
IF MOD(N+R,7)=1 THEN LET DAYCOLOR$="RED"
IF MOD(N+R,7)=0 THEN LET DAYCOLOR$="BLUE"
IF M=1 AND N=1 THEN
LET DAYCOLOR$="RED"
LET Z$="元日"
END IF
IF Y>=1973 AND M=1 AND N=2 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF Y>=2000 THEN
IF M=1 AND ((R<=1 AND R+N=9) OR (R>1 AND R+N=16)) THEN
LET DAYCOLOR$="RED"
LET Z$="成人の日"
END IF
ELSE
IF M=1 AND N=15 THEN
LET DAYCOLOR$="RED"
LET Z$="成人の日"
END IF
IF Y>=1973 AND M=1 AND N=16 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
IF M=2 AND N=11 THEN
LET DAYCOLOR$="RED"
LET Z$="建国記念の日"
END IF
IF Y>=1973 AND M=2 AND N=12 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y>=2020 THEN
IF M=2 AND N=23 THEN
LET DAYCOLOR$="RED"
LET Z$="天皇誕生日"
END IF
IF M=2 AND N=24 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
IF Y>=1900 AND Y<1980 THEN
IF M=3 AND N=INT(20.8357+0.242194*(Y-1980)-INT((Y-1983)/4)) THEN
LET DAYCOLOR$="RED"
LET Z$="春分の日"
END IF
IF Y>=1973 AND M=3 AND N=INT(20.8357+0.242194*(Y-1980)-INT((Y-1983)/4))+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF M=9 AND N=INT(23.2588+0.242194*(Y-1980)-INT((Y-1983)/4)) THEN
LET DAYCOLOR$="RED"
LET Z$="秋分の日"
END IF
IF Y>=1973 AND M=9 AND N=INT(23.2588+0.242194*(Y-1980)-INT((Y-1983)/4))+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
ELSEIF Y>=1980 AND Y<2100 THEN
IF M=3 AND N=INT(20.8431 + 0.242194 * (Y - 1980)) - INT((Y - 1980)/4) THEN
LET DAYCOLOR$="RED"
LET Z$="春分の日"
END IF
IF M=3 AND N=INT(20.8431 + 0.242194 * (Y - 1980)) - INT((Y - 1980)/4)+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF M=9 AND N=INT(23.2488 + 0.242194 * (Y - 1980)) - INT((Y - 1980)/4) THEN
LET DAYCOLOR$="RED"
LET Z$="秋分の日"
END IF
IF M=9 AND N=INT(23.2488 + 0.242194 * (Y - 1980)) - INT((Y - 1980)/4)+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
ELSEIF Y>=2100 AND Y<2150 THEN
IF M=3 AND N=INT(21.8510+0.242194*(Y-1980)-INT((Y-1980)/4)) THEN
LET DAYCOLOR$="RED"
LET Z$="春分の日"
END IF
IF M=3 AND N=INT(21.8510+0.242194*(Y-1980)-INT((Y-1980)/4))+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF M=9 AND N=INT(24.2488+0.242194*(Y-1980)-INT((Y-1980)/4)) THEN
LET DAYCOLOR$="RED"
LET Z$="秋分の日"
END IF
IF M=9 AND N=INT(24.2488+0.242194*(Y-1980)-INT((Y-1980)/4))+1 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
IF M=4 AND N=29 THEN
LET DAYCOLOR$="RED"
IF Y>=2007 THEN
LET Z$="昭和の日"
ELSEIF Y>=1989 AND Y<2007 THEN
LET Z$="みどりの日"
ELSEIF Y>1948 THEN
LET Z$="天皇誕生日"
END IF
END IF
IF Y>=1973 AND M=4 AND N=30 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF Y=2019 AND M=4 AND N=30 AND MOD(N+R-1,7)<>1 THEN ! 令和元年昭和の日は2019年4月29日、即位の日は2019年5月1日。
LET DAYCOLOR$="RED" ! 間の2019年4月30日は振替休日でなくても公休日。
LET Z$="公休日"
END IF
IF Y=2019 AND M=5 AND N=1 THEN ! 令和元年即位の日は2019年5月1日。
LET DAYCOLOR$="RED"
LET Z$="即位の日"
END IF
IF Y=2019 AND M=5 AND N=2 AND MOD(N+R-1,7)=1 THEN ! 2019年5月2日が月曜なら振替休日とする。
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF Y=2019 AND M=5 AND N=2 AND MOD(N+R-1,7)<>1 THEN ! 令和元年即位の日は2019年5月1日、憲法記念日は西暦何年であっても5月3日。
LET DAYCOLOR$="RED" ! 間の2019年5月2日は振替休日でなくても公休日。
LET Z$="公休日"
END IF
IF M=5 AND N=3 THEN
LET DAYCOLOR$="RED"
LET Z$="憲法記念日"
END IF
IF Y>=2007 THEN
IF M=5 AND N=4 THEN
LET DAYCOLOR$="RED"
LET Z$="みどりの日"
END IF
ELSEIF Y>=1988 AND Y<2007 THEN
IF M=5 AND N=4 THEN
LET DAYCOLOR$="RED"
LET Z$="国民の休日"
END IF
END IF
IF M=5 AND N=5 THEN
LET DAYCOLOR$="RED"
LET Z$="こどもの日"
END IF
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
! IF Y>=1973 AND M=5 AND N=6 AND MOD(N+R-1,7)=1 THEN
! LET DAYCOLOR$="RED"
! LET Z$="振替休日"
! END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y>=1948 AND M=5 AND N=6 AND MOD(N+R-1,7)=1 THEN ! 5月6日が月曜なら5月6日を振替休日とする。
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!(!!)以下同様に、(!!)
IF Y>=1948 AND M=5 AND N=6 AND MOD(N+R-1,7)=2 THEN ! 5月6日が火曜なら5月6日を振替休日とする。
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!(!!)以下同様に、(!!)
IF Y>=1948 AND M=5 AND N=6 AND MOD(N+R-1,7)=3 THEN ! 5月6日が水曜なら5月6日を振替休日とする。
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y>=2003 THEN
IF Y=2021 AND M=7 AND N=22 THEN
LET DAYCOLOR$="RED"
LET Z$="海の日"
END IF
IF Y=2020 AND M=7 AND N=23 THEN
LET DAYCOLOR$="RED"
LET Z$="海の日"
END IF
IF Y<>2020 AND Y<>2021 AND M=7 AND ((R<=1 AND R+N=16) OR (R>1 AND R+N=23)) THEN
LET DAYCOLOR$="RED"
LET Z$="海の日"
END IF
ELSEIF Y>=1996 AND Y<2003 THEN
IF M=7 AND N=20 THEN
LET DAYCOLOR$="RED"
LET Z$="海の日"
END IF
IF M=7 AND N=21 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y>=2016 THEN
IF Y<>2020 AND Y<>2021 AND M=8 AND N=11 THEN
LET DAYCOLOR$="RED"
LET Z$="山の日"
END IF
IF Y<>2020 AND Y<>2021 AND M=8 AND N=12 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF Y=2021 AND M=8 AND N=8 THEN
LET DAYCOLOR$="RED"
LET Z$="山の日"
END IF
IF Y=2021 AND M=8 AND N=9 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
IF Y=2020 AND M=8 AND N=10 THEN
LET DAYCOLOR$="RED"
LET Z$="山の日"
END IF
IF Y=2020 AND M=8 AND N=11 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
IF Y>=2003 THEN
IF M=9 AND ((R<=1 AND R+N=16) OR (R>1 AND R+N=23)) THEN
LET DAYCOLOR$="RED"
LET Z$="敬老の日"
END IF
ELSEIF Y>=1966 AND Y<2003 THEN
IF M=9 AND N=15 THEN
LET DAYCOLOR$="RED"
LET Z$="敬老の日"
END IF
IF Y>=1973 AND M=9 AND N=16 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y=2019 AND M=10 AND N=22 THEN ! 令和元年即位礼正殿の儀は2019年10月22日に執り行われる。
LET DAYCOLOR$="RED"
LET Z$="即位礼正殿の儀"
END IF
IF Y=2019 AND M=10 AND N=23 AND MOD(N+R-1,7)=1 THEN ! 2019年10月23日が月曜なら振替休日とする。
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y>=2022 THEN
IF M=10 AND ((R<=1 AND R+N=9) OR (R>1 AND R+N=16)) THEN
LET DAYCOLOR$="RED"
LET Z$="体育の日"
END IF
END IF
IF Y=2021 THEN
IF M=7 AND N=23 THEN
LET DAYCOLOR$="RED"
LET Z$="スポーツの日"
END IF
IF M=7 AND N=24 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
IF Y=2020 THEN
IF M=7 AND N=24 THEN
LET DAYCOLOR$="RED"
LET Z$="スポーツの日"
END IF
IF M=7 AND N=25 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
IF Y>=2000 AND Y<2020 THEN
IF M=10 AND ((R<=1 AND R+N=9) OR (R>1 AND R+N=16)) THEN
LET DAYCOLOR$="RED"
LET Z$="体育の日"
END IF
ELSEIF Y>=1966 AND Y<2000 THEN
IF M=10 AND N=10 THEN
LET DAYCOLOR$="RED"
LET Z$="体育の日"
END IF
IF Y>=1973 AND M=10 AND N=11 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
IF M=11 AND N=3 THEN
LET DAYCOLOR$="RED"
LET Z$="文化の日"
END IF
IF M=11 AND N=23 THEN
LET DAYCOLOR$="RED"
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
LET Z$="勤労感謝の日"
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
END IF
IF Y>=1973 AND M=11 AND (N=4 OR N=24) AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
IF Y=2019 THEN
IF M=12 AND N=23 THEN
LET DAYCOLOR$="BLACK" ! 祝日にならない模様。∴LET DAYCOLOR$="BLACK"
LET Z$="平成の天皇誕生日"
END IF
END IF
IF Y>=1989 AND Y<=2018 THEN
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
IF M=12 AND N=23 THEN
LET DAYCOLOR$="RED"
LET Z$="天皇誕生日"
END IF
IF M=12 AND N=24 AND MOD(N+R-1,7)=1 THEN
LET DAYCOLOR$="RED"
LET Z$="振替休日"
END IF
END IF
LET D$=DATE$
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
! IF Y=VAL(D$(1:4)) AND M=VAL(D$(5:6)) AND N=VAL(D$(7:8)) THEN LET DAYCOLOR$="CYAN" ! ← 当日の日付の色がシアンになる。
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
END FUNCTION
EXTERNAL FUNCTION QSEI$(TM)
DIM A$(9)
MAT READ A$
LET QSEI$=A$(MOD(TM-1,9)+1)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' DATA 九紫火星
!' DATA 八白土星
!' DATA 七赤金星
!' DATA 六白金星
!' DATA 五黄土星
!' DATA 四緑木星
!' DATA 三碧木星
!' DATA 二黒土星
!' DATA 一白水星
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
DATA " "
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
Re: 月齢カレンダーの修正(二度目)
- gnuutera2012or文句うさびょん URL
2025/06/19 (Thu) 15:21:46
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
EXTERNAL FUNCTION CALC_ETO60$(ALLYEAR)
DIM A$(10),B$(12)
MAT READ A$,B$
LET CALC_ETO60$=A$(MOD(ALLYEAR+6,10)+1)&B$(MOD(ALLYEAR+8,12)+1)
DATA "甲", "乙", "丙", "丁", "戊"
DATA "己", "庚", "辛", "壬", "癸"
DATA "子", "丑", "寅", "卯", "辰", "巳"
DATA "午", "未", "申", "酉", "戌", "亥"
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
EXTERNAL FUNCTION CALC_ETO61$(JOUYOKEI)
DIM A$(60)
MAT READ A$
LET CALC_ETO61$=A$(JOUYOKEI+1)
DATA "甲子","乙丑","丙寅","丁卯","戊辰","己巳","庚午","辛未","壬申","癸酉","甲戌","乙亥","丙子","丁丑","戊寅","己卯","庚辰","辛巳","壬午","癸未"
DATA "甲申","乙酉","丙戌","丁亥","戊子","己丑","庚寅","辛卯","壬辰","癸巳","甲午","乙未","丙申","丁酉","戊戌","己亥","庚子","辛丑","壬寅","癸卯"
DATA "甲辰","乙巳","丙午","丁未","戊申","己酉","庚戌","辛亥","壬子","癸丑","甲寅","乙卯","丙辰","丁巳","戊午","己未","庚申","辛酉","壬戌","癸亥"
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' (1)黄道に沿って、天球を28に区分し、星宿(星座の意)の所在を明瞭にしたもの。太陰(月(つき))はおよそ1日に1宿ず
!' つ運行する。中国では蒼竜(東)・玄武(北)・白虎(西)・朱雀(南)の4宮に分け、さらに各宮を七分した。
!' 東は角(すぼし)・亢(あみぼし)・氏(とも)・房(そい)・心(なかご)・尾(あしたれ)・箕(み)
!' 北は斗(ひきつ)・牛(いなみ)・女(うるき)・虚(とみて)・危(うみやめ)・室(はつい)・壁(なまめ)
!' 西は奎(とかき)・婁(たたら)・胃(えきえ)・昴(すばる)・畢(あめふり)・觜(とろき)・參(からすき)
!' 南は井(ちちり)・鬼(たまほめ)・柳(ぬりこ)・星(ほとほり)・張(ちりこ)・翼(たすき)・軫(みつかけ)
!' (2)(1)のうち、牛宿を除いた二十七宿を月日にあてて吉凶を占う法。宿曜道の系統の選日。【広辞苑】
!' (注)氏(とも)と記載したものは、正しくは、五胡十六国時代の「てい」に該当し、低から人偏をとりさったものと同じである。以下同じ。
!' 二十八宿
EXTERNAL FUNCTION SHUKU28$(JOUYOKEI)
DIM A$(28)
MAT READ A$
LET SHUKU28$=A$(JOUYOKEI+1)
DATA "角","亢","氏","房","心","尾","箕","斗","牛","女","虚","危","室","壁"
DATA "奎","婁","胃","昴","畢","觜","參","井","鬼","柳","星","張","翼","軫"
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' 中国秦時代からある暦注で、出土した最古の元光元年暦に書かれている。建(たつ),除(のぞく),満(みつ),平(たいら)
!' ,定(さだん),執(とる),破(やぶる),危(あやぶ),成(なる),納(おさん),開(ひらく),閉(とづ)の12あり、納は古い具注暦
!' では収と書かれている。読みは「仮名暦」の記載である。選日法は立春後の最初の寅、啓蟄後の最初の卯、清明後の最
!' 初の辰、立夏後の最初の巳、芒種後の最初の午、小暑後の最初の未、立秋後の最初の申、白露後の最初の酉、寒露後の
!' 最初の戌、立冬後の最初の亥、大雪後の最初の子、小寒後の最初の丑の日を建として順番に配当する。【日本歴史大辞典】
!' 十二直
EXTERNAL FUNCTION TYOKU12$(JOUYOKEI)
DIM A$(12)
MAT READ A$
LET TYOKU12$=A$(JOUYOKEI+1)
DATA "建","除","満","平","定","執","破","危","成","納","開","閉"
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
EXTERNAL SUB MOON(X,Y,R,H,N)
DIM XX(73),YY(73)
SET COLOR "GRAY"
DRAW DISK WITH SCALE(R)*SHIFT(X,Y)
SET AREA COLOR "YELLOW"
IF H>15 THEN LET SW=-1 ELSE LET SW=1
LET RR=2*(N-.5)
IF RR>0 THEN
FOR T=0 TO 360 STEP 5
LET B=R
IF T>=90 AND T<=270 THEN LET B=R*RR
LET I=I+1
LET YY(I)=R*SIN(RAD(T))+Y
LET XX(I)=SW*B*COS(RAD(T))+X
NEXT T
ELSE
FOR T=-90 TO 90 STEP 5
LET I=I+1
LET YY(I)=R*SIN(RAD(T))+Y
LET XX(I)=SW*R*COS(RAD(T))+X
NEXT T
LET B=R*ABS(RR)
FOR T=85 TO -90 STEP -5
LET I=I+1
LET YY(I)=R*SIN(RAD(T))+Y
LET XX(I)=SW*B*COS(RAD(T))+X
NEXT T
END IF
IF RR>-1 THEN MAT PLOT AREA :XX,YY
END SUB
!'これより以下は、「旧暦 for VB」から「旧暦.bas」を(仮称)十進BASICに移植したものです。
!' http://www.vector.co.jp/soft/win95/personal/se243537.html?_ga=1.114790919.1276112294.1407498580
!' 旧暦計算 標準モジュール「旧暦.bas」Version 1.0
!' Arranged for Visual Basic 6.0 or 5.0 & Excel97 VBA & Access97 VBA
!' by Masayuki Kanari (C)2002
!'
!' 原典 「旧暦計算サンプルプログラム」
!' Copyright (C) 1993,1994 by H.Takano
!' http://www.vector.co.jp/soft/dos/personal/se016093.html
!'
!' 原典 旧暦計算 JavaScript(ECMAScript) Library "qreki.js" Version 1.5
!' Arranged for ECMAScript(ECMA-262) by Nagano Yutaka (C)1999-2001
!' http://www.ai.wakwak.com/~y-nagano/Programs/koyomi/
!'
!' この標準モジュールの計算結果は無保証です。
!' この標準モジュールはフリーソフトであり、自由に再利用・改良を行ってかまいませんが、
!' 著作権は原典のjgAWK版を開発された高野英明氏、およびJavaScript版を開発された長野隆氏に
!' 帰属しています。上記のリンクより高野氏の「QRSAMP」、長野氏の「qreki.js」を取得し、
!' そのドキュメント内に書かれている再配布規定に従ってください。
!'
!' 使用法
!' １．旧暦は下記コードをFormモジュールで実行すると、Kyurekiに旧暦が入っています。
!' Kyureki.QYear に旧暦年 Kyureki.QMonth に旧暦月 下記コードの Type Q_Rekiを参照
!' Calc_Kyureki "2002","5","26" "2002"などは当然ですが、変数でも可
!'
!' ２．二十四節季は下記コードをFormモジュールで実行すると、Sekki24に二十四節季が入っています。
!' Sekki24(i,0) に節季の日時 Sekki24(i,1) に節季の名称が入ります。
!' Calc_Sekki24 "2002" "2002"は当然ですが、変数でも可
!'Type Q_Reki ' ユーザー定義型を作成
!' QYear As Integer ' 旧暦年
!' QUruu As Boolean ' 平月:False 閏月:True
!' QMonth As Integer ' 旧暦月
!' QDay As Integer ' 旧暦日
!' QRokuyou As String ' 六曜名
!' QJukkan As String ' 十干十二支
!' QMage ' リアルタイム月齢
!' QMagenoon ' 正午月齢
!' QIllumi ' 輝面比 ％
!' QMphase As Integer ' 月相 0～27
!'End Type
!' 十干十二支
EXTERNAL FUNCTION CALC_JUKKAN$(TM)
DIM A$(10),B$(12)
MAT READ A$,B$
LET N$ = A$(MOD(INT(TM / 2), 5) * 2 + MOD(TM ,2) + 1)
DATA "甲", "乙", "丙", "丁", "戊"
DATA "己", "庚", "辛", "壬", "癸"
LET CALC_JUKKAN$ = N$ & " " & B$(MOD(TM - 10,12) + 1)
DATA "子", "丑", "寅", "卯", "辰", "巳"
DATA "午", "未", "申", "酉", "戌", "亥"
END FUNCTION
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
EXTERNAL FUNCTION MEMO_JUKKAN$(TM)
DIM A$(10),B$(12)
MAT READ A$,B$
LET N$ = A$(MOD(INT(TM / 2), 5) * 2 + MOD(TM ,2) + 1)
DATA "甲", "乙", "丙", "丁", "戊"
DATA "己", "庚", "辛", "壬", "癸"
LET MEMO_JUKKAN$ = N$ & "" & B$(MOD(TM - 10,12) + 1)
DATA "子", "丑", "寅", "卯", "辰", "巳"
DATA "午", "未", "申", "酉", "戌", "亥"
END FUNCTION
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' 二分二至の時刻または中気の時刻を求める二分二至の時刻
!' 引数 tm .... 計算対象となる時刻(ユリウス日)
!' logitudeas .... 二分二至の時90 中気の時30
!' 戻り値 .... 二分二至の時刻または中気の時刻(ユリウス日)
!' グローバル変数rm_sun0にその時の太陽黄経をセットする
EXTERNAL FUNCTION CALC_CHU(TM, LOGITUDEAS)
LET TM1 = INT(TM) !' 時刻引数を分解する
LET TM2 = TM - TM1 - 9 / 24 !' JST ==> DT
!' 二分二至の時刻または中気の黄経λsun0を求める
LET T = (TM2 + 0.5 + TM1 - 2451545) / 36525
LET RM_SUN = LONGITUDE_SUN(T)
LET RM_SUN0 = LOGITUDEAS * INT(RM_SUN / LOGITUDEAS)
!' 繰り返し計算によって中気の時刻を計算する(誤差が±1.0 sec以内になったら打ち切る)
DO
LET T = (TM2 + 0.5 + TM1 - 2451545) / 36525
LET RM_SUN = LONGITUDE_SUN(T) !' 太陽の黄経λsunを計算
LET DELTA_RM = RM_SUN - RM_SUN0 !' 黄経差Δλ
!' Δλの引き込み範囲(±180°)を逸脱した場合には、補正を行う
IF DELTA_RM > 180 THEN
LET DELTA_RM = DELTA_RM - 360
ELSEIF DELTA_RM < -180 THEN
LET DELTA_RM = DELTA_RM + 360
END IF
LET DELTA_T1 = INT(DELTA_RM * 365.24219878 / 360) !' 時刻引数の補正値 Δt
LET DELTA_T2 = DELTA_RM * 365.24219878 / 360
LET DELTA_T2 = DELTA_T2 - DELTA_T1
LET TM1 = TM1 - DELTA_T1 !' 時刻引数の補正
LET TM2 = TM2 - DELTA_T2
IF TM2 < 0 THEN
LET TM2 = TM2 + 1
LET TM1 = TM1 - 1
END IF
LOOP UNTIL ABS(DELTA_T1 + DELTA_T2) < (1 / 86400)
LET CALC_CHU = TM1 + TM2 + 9 / 24
END FUNCTION
!' 朔の計算
!' 与えられた時刻の直近の朔の時刻(JST)を求める
!' 引数 tm ........ 計算対象となる時刻(ユリウス日)
!' 戻り値 ........ 朔の時刻 引数、戻り値ともユリウス日で表し、時分秒は日の小数で表す
EXTERNAL FUNCTION CALC_SAKU(TM)
LET LC = 1 !' ループカウンタのセット
LET TM1 = INT(TM) !' 時刻引数を分解する
LET TM2 = TM - TM1 - 9 / 24 !' JST ==> DT
!' 繰り返し計算によって朔の時刻を計算する(誤差が±1.0 sec以内になったら打ち切る)
DO
LET T = (TM2 + 0.5 + TM1 - 2451545) / 36525
LET RM_SUN = LONGITUDE_SUN(T) !' 太陽の黄経λsunを計算
LET RM_MOON = LONGITUDE_MOON(T) !' 月の黄経λmoonを計算
LET DELTA_RM = RM_MOON - RM_SUN !' 月と太陽の黄経差Δλ
!' ループの１回目(Lc=1)で delta_rm < 0 の場合には引き込み範囲に入るように補正する
IF LC = 1 AND DELTA_RM < 0 THEN
LET DELTA_RM = NORMALIZATION_ANGLE(DELTA_RM)
!' 春分の近くで朔がある場合(0 ≦λsun≦ 20)で、月の黄経λmoon≧300 の
!' 場合には、Δλ＝ 360 － Δλ と計算して補正する
ELSEIF RM_SUN >= 0 AND RM_SUN <= 20 AND RM_MOON >= 300 THEN
LET DELTA_RM = NORMALIZATION_ANGLE(DELTA_RM)
LET DELTA_RM = 360 - DELTA_RM
!' Δλの引き込み範囲(±40°)を逸脱した場合には、補正を行う
ELSEIF ABS(DELTA_RM) > 40 THEN
LET DELTA_RM = NORMALIZATION_ANGLE(DELTA_RM)
END IF
LET DELTA_T1 = INT(DELTA_RM * 29.530589 / 360) !' 時刻引数の補正値 Δt
LET DELTA_T2 = DELTA_RM * 29.530589 / 360
LET DELTA_T2 = DELTA_T2 - DELTA_T1
LET TM1 = TM1 - DELTA_T1 !' 時刻引数の補正
LET TM2 = TM2 - DELTA_T2
IF TM2 < 0 THEN
LET TM2 = TM2 + 1
LET TM1 = TM1 - 1
END IF
!' ループ回数が15回になったら、初期値 tm を tm-26 とする
IF LC = 15 AND ABS(DELTA_T1 + DELTA_T2) > (1 / 86400) THEN
LET TM1 = INT(TM - 26)
LET TM2 = 0
!' 初期値を補正したにも関わらず､振動を続ける場合には初期値を答えとして返して強制的にループを抜け出して異常終了させる
ELSEIF LC > 30 AND ABS(DELTA_T1 + DELTA_T2) > (1 / 86400) THEN
LET TM1 = TM
LET TM2 = 0
EXIT DO
END IF
LET LC = LC + 1
LOOP UNTIL ABS(DELTA_T1 + DELTA_T2) < (1 / 86400)
!' 時刻引数を合成するのと、DT ==> JST 変換を行い、戻り値とする
LET CALC_SAKU = TM2 + TM1 + 9 / 24
END FUNCTION
REM 続き
!' 角度の正規化を行う。すなわち引数の範囲を０≦θ＜３６０にする
EXTERNAL FUNCTION NORMALIZATION_ANGLE(ANGLE)
LET NORMALIZATION_ANGLE = MOD(ANGLE+360,360)
END FUNCTION
EXTERNAL FUNCTION LONGITUDE_SUN(T) !' 太陽の黄経λsunを計算する
!' 摂動項の計算
LET ANG = NORMALIZATION_ANGLE(31557 * T + 161)
LET TH = 0.0004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(29930 * T + 48)
LET TH = TH + 0.0004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(2281 * T + 221)
LET TH = TH + 0.0005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(155 * T + 118)
LET TH = TH + 0.0005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(33718 * T + 316)
LET TH = TH + 0.0006 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(9038 * T + 64)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(3035 * T + 110)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(65929 * T + 45)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(22519 * T + 352)
LET TH = TH + 0.0013 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(45038 * T + 254)
LET TH = TH + 0.0015 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(445267 * T + 208)
LET TH = TH + 0.0018 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(19 * T + 159)
LET TH = TH + 0.0018 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(32964 * T + 158)
LET TH = TH + 0.002 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(71998.1 * T + 265.1)
LET TH = TH + 0.02 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(35999.05 * T + 267.52)
LET TH = TH - 0.0048 * T * COS(PI * ANG / 180)
LET TH = TH + 1.9147 * COS(PI * ANG / 180)
!' 比例項の計算
LET ANG = NORMALIZATION_ANGLE(36000.7695 * T)
LET ANG = NORMALIZATION_ANGLE(ANG + 280.4659)
LET LONGITUDE_SUN = NORMALIZATION_ANGLE(TH + ANG)
END FUNCTION
EXTERNAL FUNCTION LONGITUDE_MOON(T) !' 月の黄経λmoonを計算する
!' 摂動項の計算
LET ANG = NORMALIZATION_ANGLE(2322131 * T + 191)
LET TH = 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(4067 * T + 70)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(549197 * T + 220)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1808933 * T + 58)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(349472 * T + 337)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(381404 * T + 354)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(958465 * T + 340)
LET TH = TH + 0.0003 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(12006 * T + 187)
LET TH = TH + 0.0004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(39871 * T + 223)
LET TH = TH + 0.0004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(509131 * T + 242)
LET TH = TH + 0.0005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1745069 * T + 24)
LET TH = TH + 0.0005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1908795 * T + 90)
LET TH = TH + 0.0005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(2258267 * T + 156)
LET TH = TH + 0.0006 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(111869 * T + 38)
LET TH = TH + 0.0006 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(27864 * T + 127)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(485333 * T + 186)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(405201 * T + 50)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(790672 * T + 114)
LET TH = TH + 0.0007 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1403732 * T + 98)
LET TH = TH + 0.0008 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(858602 * T + 129)
LET TH = TH + 0.0009 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1920802 * T + 186)
LET TH = TH + 0.0011 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1267871 * T + 249)
LET TH = TH + 0.0012 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1856938 * T + 152)
LET TH = TH + 0.0016 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(401329 * T + 274)
LET TH = TH + 0.0018 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(341337 * T + 16)
LET TH = TH + 0.0021 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(71998 * T + 85)
LET TH = TH + 0.0021 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(990397 * T + 357)
LET TH = TH + 0.0021 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(818536 * T + 151)
LET TH = TH + 0.0022 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(922466 * T + 163)
LET TH = TH + 0.0023 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(99863 * T + 122)
LET TH = TH + 0.0024 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1379739 * T + 17)
LET TH = TH + 0.0026 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(918399 * T + 182)
LET TH = TH + 0.0027 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1934 * T + 145)
LET TH = TH + 0.0028 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(541062 * T + 259)
LET TH = TH + 0.0037 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1781068 * T + 21)
LET TH = TH + 0.0038 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(133 * T + 29)
LET TH = TH + 0.004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1844932 * T + 56)
LET TH = TH + 0.004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1331734 * T + 283)
LET TH = TH + 0.004 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(481266 * T + 205)
LET TH = TH + 0.005 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(31932 * T + 107)
LET TH = TH + 0.0052 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(926533 * T + 323)
LET TH = TH + 0.0068 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(449334 * T + 188)
LET TH = TH + 0.0079 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(826671 * T + 111)
LET TH = TH + 0.0085 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1431597 * T + 315)
LET TH = TH + 0.01 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1303870 * T + 246)
LET TH = TH + 0.0107 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(489205 * T + 142)
LET TH = TH + 0.011 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1443603 * T + 52)
LET TH = TH + 0.0125 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(75870 * T + 41)
LET TH = TH + 0.0154 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(513197.9 * T + 222.5)
LET TH = TH + 0.0304 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(445267.1 * T + 27.9)
LET TH = TH + 0.0347 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(441199.8 * T + 47.4)
LET TH = TH + 0.0409 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(854535.2 * T + 148.2)
LET TH = TH + 0.0458 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(1367733.1 * T + 280.7)
LET TH = TH + 0.0533 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(377336.3 * T + 13.2)
LET TH = TH + 0.0571 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(63863.5 * T + 124.2)
LET TH = TH + 0.0588 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(966404 * T + 276.5)
LET TH = TH + 0.1144 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(35999.05 * T + 87.53)
LET TH = TH + 0.1851 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(954397.74 * T + 179.93)
LET TH = TH + 0.2136 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(890534.22 * T + 145.7)
LET TH = TH + 0.6583 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(413335.35 * T + 10.74)
LET TH = TH + 1.274 * COS(PI * ANG / 180)
LET ANG = NORMALIZATION_ANGLE(477198.868 * T + 44.963)
LET TH = TH + 6.2888 * COS(PI * ANG / 180)
!' 比例項の計算
LET ANG = NORMALIZATION_ANGLE(481267.8809 * T)
LET ANG = NORMALIZATION_ANGLE(ANG + 218.3162)
LET LONGITUDE_MOON = NORMALIZATION_ANGLE(TH + ANG)
END FUNCTION
!' ユリウス日(JD)から年月日、時分秒(世界時)を計算する
!' この関数で求めた年月日は、グレゴリオ暦法によって表されている
EXTERNAL FUNCTION JD2YMDT$(JD)
LET X0 = INT(JD + 68570)
LET X1 = INT(X0 / 36524.25)
LET X2 = X0 - INT(36524.25 * X1 + 0.75)
LET X3 = INT((X2 + 1) / 365.2425)
LET X4 = X2 - INT(365.25 * X3) + 31
LET X5 = INT(INT(X4) / 30.59)
LET X6 = INT(INT(X5) / 11)
LET GDAY = X4 - INT(30.59 * X5)
LET GMONTH = X5 - 12 * X6 + 2
LET GYEAR = 100 * (X1 - 49) + X3 + X6
!' 2月30日の補正
IF GMONTH = 2 AND GDAY > 28 THEN
IF MOD(GYEAR,100) = 0 AND MOD(GYEAR,400) = 0 THEN
LET GDAY = 29
ELSEIF MOD(GYEAR,4) = 0 AND MOD(GYEAR,100) > 0 THEN
LET GDAY = 29
ELSE
LET GDAY = 28
END IF
END IF
LET X0 = 24 * (JD - INT(JD))
LET GHOUR = INT(X0)
LET GMINUTE = INT((X0 - GHOUR) * 60)
LET GSECOND = INT((X0 - GHOUR - GMINUTE / 60) * 3600 + 0.05)
LET JD2YMDT$ = STR$(GYEAR) & "/" & RIGHT$("0"&STR$(GMONTH),2) & "/" & RIGHT$("0"&STR$(GDAY),2) & " " & RIGHT$("0"&STR$(GHOUR),2) & ":" & RIGHT$("0"&STR$(GMINUTE),2) & ":" & RIGHT$("0"&STR$(GSECOND),2)
END FUNCTION
!' 年月日、時分秒(世界時)からユリウス日(JD)を計算する
EXTERNAL FUNCTION YMDT2JD(GYEAR, GMONTH, GDAY, GHOUR, GMINUTE, GSECOND)
IF GMONTH < 3 THEN
LET CALC_GYEAR = GYEAR - 1
LET CALC_GMONTH = GMONTH + 12
ELSE
LET CALC_GYEAR = GYEAR
LET CALC_GMONTH = GMONTH
END IF
LET Y = INT(365.25 * CALC_GYEAR) + INT(CALC_GYEAR / 400) - INT(CALC_GYEAR / 100)
LET Y = Y + INT(30.59 * (CALC_GMONTH - 2)) + 1721088 + GDAY
LET YMDT2JD = Y + (GHOUR + GMINUTE / 60 + GSECOND / 3600) / 24
END FUNCTION
!' 二十四節季
!' Sekki(x,0) .... 節季日
!' Sekki(x,1) .... 節季
EXTERNAL SUB CALC_SEKKI24(GYEAR)
DIM A$(24)
MAT READ A$
LET YMD = YMDT2JD(GYEAR, 1, 1, 0, 0, 0)
LET J = 0
FOR I = 0 TO 400 STEP 15
LET SEKKI$ = JD2YMDT$(CALC_CHU(YMD + I, 15))
IF VAL(LEFT$(SEKKI$, 4)) = GYEAR THEN
LET SEKKI24$(J, 0) = SEKKI$
LET SEKKI24$(J, 1) = A$(RM_SUN0 / 15+1)
DATA "春分", "清明", "穀雨", "立夏", "小満", "芒種"
DATA "夏至", "小暑", "大暑", "立秋", "処暑", "白露"
DATA "秋分", "寒露", "霜降", "立冬", "小雪", "大雪"
DATA "冬至", "小寒", "大寒", "立春", "雨水", "啓蟄"
LET J = J + 1
END IF
NEXT I
END SUB
!' 新暦に対応する、旧暦を求める
!' 引数 tm .... 計算する日付(ユリウス日)
!' 戻り値 .... kyureki
EXTERNAL SUB CALC_KYUREKI(GYEAR, GMONTH, GDAY)
DIM CHU(0 TO 4), SAKU(0 TO 5), M(0 TO 5, 0 TO 2),ROKU$(6)
LET TM = YMDT2JD(GYEAR, GMONTH, GDAY, 0, 0, 0)
LET CHU(0) = CALC_CHU(TM, 90) !' 計算対象の直前にあたる二分二至の時刻を求める
LET M(0, 0) = INT(RM_SUN0 / 30) + 2 !' 上で求めた二分二至の時の太陽黄経をもとに朔日行列の先頭に月名をセット
FOR I = 1 TO 4
LET CHU(I) = CALC_CHU(CHU(I - 1) + 32, 30)
NEXT I
!' 計算対象の直前にあたる二分二至の直前の朔の時刻を求める
LET SAKU(0) = CALC_SAKU(CHU(0))
!' 朔の時刻を求める
FOR I = 1 TO 5
LET SAKU(I) = CALC_SAKU(SAKU(I - 1) + 30)
!' 前と同じ時刻を計算した場合(両者の差が26日以内)には、初期値を+33日にして再実行させる
IF ABS(INT(SAKU(I - 1)) - INT(SAKU(I))) <= 26 THEN
LET SAKU(I) = CALC_SAKU(SAKU(I - 1) + 35)
END IF
NEXT I
!' saku(1)が二分二至の時刻以前になってしまった場合には、朔をさかのぼり過ぎたと考えて、
!' 朔の時刻を繰り下げて修正する
!' その際、計算もれsaku(4)になっている部分を補うため、朔の時刻を計算する
!' 近日点通過の近辺で朔があると起こる事があるようだ...？
IF INT(SAKU(1)) <= INT(CHU(0)) THEN
FOR I = 0 TO 4
LET SAKU(I) = SAKU(I + 1)
NEXT I
LET SAKU(4) = CALC_SAKU(SAKU(3) + 35)
!' saku(0)が二分二至の時刻以後になってしまった場合には、朔をさかのぼり足りないと見て、
!' 朔の時刻を繰り上げて修正する
!' その際、計算もれsaku(0)になっている部分を補うため、朔の時刻を計算する
!' 春分点の近辺で朔があると起こる事があるようだ...？
ELSEIF INT(SAKU(0)) > INT(CHU(0)) THEN
FOR I = 4 TO 1 STEP -1
LET SAKU(I) = SAKU(I - 1)
NEXT I
LET SAKU(0) = CALC_SAKU(SAKU(0) - 27)
END IF
!' 閏月検索Flagセット 節月で４ヶ月の間に朔が５回あると、閏月がある可能性がある
!' lap=false:平月 lap=true:閏月
IF INT(SAKU(4)) <= INT(CHU(3)) THEN LET LAP=1 ELSE LET LAP=0
!' 朔日行列の作成
!' m(i,0) ... 月名(1:正月 2:２月 3:３月 ....)
!' m(i,1) ... 閏フラグ(false:平月 true:閏月)
!' m(i,2) ... 朔日のjd
!' m(0, 0)はこの関数の始めの方ですでに代入済み
LET M(0, 1) = 0
LET M(0, 2) = INT(SAKU(0))
FOR I = 1 TO 5
IF LAP=1 AND I > 1 THEN
IF CHU(I - 1) <= INT(SAKU(I - 1)) OR CHU(I - 1) >= INT(SAKU(I)) THEN
LET M(I - 1, 0) = M(I - 2, 0)
LET M(I - 1, 1) = 1
LET M(I - 1, 2) = INT(SAKU(I - 1))
LET LAP = 0
END IF
END IF
LET M(I, 0) = M(I - 1, 0) + 1
IF M(I, 0) > 12 THEN
LET M(I, 0) = M(I, 0) - 12
END IF
LET M(I, 2) = INT(SAKU(I))
LET M(I, 1) = 0
NEXT I
!' 朔日行列から旧暦を求める
LET STATE = 0
FOR I = 0 TO 5
IF INT(TM) < INT(M(I, 2)) THEN
LET STATE = 1
EXIT FOR
ELSEIF INT(TM) = INT(M(I, 2)) THEN
LET STATE = 2
EXIT FOR
END IF
NEXT I
IF STATE = 0 OR STATE = 1 THEN
LET I = I - 1
END IF
LET QURUU = M(I, 1)
LET QMONTH = M(I, 0)
LET QDAY = INT(TM) - INT(M(I, 2)) + 1
!'旧暦年の計算 旧暦月が10以上でかつ新暦月より大きい場合には、まだ年を越していないはず...
!'YMD$ = JD2YMDT$(tm)
!'QYear = Val(Left$(YMD$, 4))
!'If QMonth > 9 And QMonth > Val(Mid$(YMD$, 6, 2)) Then
LET QYEAR = GYEAR
IF QMONTH > 9 AND QMONTH > GMONTH THEN
LET QYEAR = QYEAR - 1
END IF
!' 六曜を求める
MAT READ ROKU$
DATA "大安", "赤口", "先勝", "友引", "先負", "仏滅"
LET QROKUYOU$ = ROKU$(MOD((QMONTH + QDAY) ,6) + 1)
!' 十干十二支を求める
LET QJUKKAN$ = CALC_JUKKAN$(TM)
!' リアルタイム月齢を求める
LET QMAGE = TM - SAKU(I)
IF QMAGE < 0 THEN
LET QMAGE = TM - SAKU(I - 1)
END IF
!' 正午月齢を求める
LET QMAGENOON = INT(TM) + 0.5 - SAKU(I)
IF QMAGENOON < 0 THEN
LET QMAGENOON = INT(TM) + 0.5 - SAKU(I - 1)
END IF
!' 輝面比を求める
LET TM1 = INT(TM)
LET TM2 = TM - TM1 - 9 / 24
LET T = (TM2 + 0.5) / 36525 + (TM1 - 2451545) / 36525
LET QILLUMI = (1 - COS(PI * NORMALIZATION_ANGLE(LONGITUDE_MOON(T) - LONGITUDE_SUN(T)) / 180)) * 50
!' 月相を求める 輝面比の計算で求めた変数tを使用
LET QMPHASE = INT(NORMALIZATION_ANGLE(LONGITUDE_MOON(T) - LONGITUDE_SUN(T)) / 360 * 28 + 0.5)
LET QMPHASE = MOD(QMPHASE, 28)
END SUB
Re: Re: 月齢カレンダーの修正(二度目)
- gnuutera2012or文句うさびょん URL
2025/06/19 (Thu) 15:24:40
修正した理由です。
ゴールデンウィークに間違いがございました。
https://x.com/gnuutera2012/status/1919563843304620113?t=JH8cOLz0yVmbANp2qzsZHw&s=19