!' カレンダー
!'  
!'    投稿者：しばっち 
!'   投稿日：2014年 9月 2日(火)19時16分5秒 　 通報 返信・引用
!' 
!' ----------------------------------------------------------------------------------------------------
!' 加筆修正者：gnuutera2012
!' ※新元号が令和となり、あちこち加筆修正させていただきました。
!' (例)
!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' 加筆修正加筆修正加筆修正加筆修正加筆修正加筆修正
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
!' ----------------------------------------------------------------------------------------------------
DECLARE EXTERNAL  FUNCTION SHUKU28$
DECLARE EXTERNAL  FUNCTION CALC_ETO60$
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

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
IF IsLeapYear(y)<>0 THEN LET DD(2)=29 !うるう年なら

!' 入力後の変更の場合。
!' INPUT  PROMPT "西暦  年=":YEAR$
!' IF YEAR$<>"" THEN LET YEAR=VAL(YEAR$)
!' INPUT  PROMPT "月=":MONTH$
!' IF MONTH$<>"" THEN LET MONTH=VAL(MONTH$)
!' !' ※表示月のうるう年
!' IF MOD(YEAR,100) = 0 AND MOD(YEAR,400) = 0 THEN
!'    LET DD(2) = 29
!' ELSEIF MOD(GYEAR,4) = 0 AND MOD(YEAR,100) > 0 THEN
!'    LET DD(2) = 29
!' ELSE
!'    LET DD(2) = 28
!' END IF

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$)
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$=""
   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)
   !' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
   SET TEXT HEIGHT HEIGHT*.25
   CALL MOON(XS+XX+HEIGHT*.6,YS+YY+HEIGHT*.5,HEIGHT*.5,QMAGENOON-.5,QILLUMI/100)
   CALL SYMBOL(XS+XX,YS+YY+HEIGHT*.3,COL$,QROKUYOU$&" "&N$&STR$(QMONTH)&"/"&STR$(QDAY))
   CALL SYMBOL(XS+XX,YS+YY+HEIGHT*.6,COL$,A$)
   CALL SYMBOL(XS+XX,YS+YY+HEIGHT*.9,COL$,B$)
   IF Z$<>"" THEN CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.2,"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.5,"MAGENTA",SEKKI24$(K, 1))
            LET FL=1
         ELSE
            CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.2,"MAGENTA",SEKKI24$(K, 1))
            LET FL=2
         END IF
         EXIT FOR
      END IF
   NEXT K
   !' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
   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
   !' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲
   !' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
   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$,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$,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$,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$,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$,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$,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$,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$,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$,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$,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$,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$,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$,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$,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.2,"BLUE",S$)
      ELSEIF FL<>1 THEN
         CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.5,"BLUE",S$)
      ELSE
         CALL SYMBOL(XS+XX,YS+YY+HEIGHT*1.8,"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>=2003 THEN
   IF Y=2020 AND M=7 AND N=23 THEN
      LET DAYCOLOR$="RED"
      LET Z$="海の日"
   END IF
   IF Y<>2020 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 M=8 AND N=10 THEN
      LET DAYCOLOR$="RED"
      LET Z$="山の日"
   END IF
   IF Y<>2020 AND M=8 AND N=11 THEN
      LET DAYCOLOR$="RED"
      LET Z$="山の日"
   END IF
   IF M=8 AND N=12 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>=2021 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=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
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
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
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

!' ▼▼▼▼▼▼▼▼▼▼ここから▼▼▼▼▼▼▼▼▼▼
!' (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
!' ▲▲▲▲▲▲▲▲▲▲ここまで▲▲▲▲▲▲▲▲▲▲

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