!広範囲B.C.4713(-4712)~2400~のユリウス日...

!広範囲B.C.4713(-4712)~2400~のユリウス日の計算(julian date)

!消滅して存在しない日がある。1582.10.5~1582.10.14 の区間。

!----------------------------------------------------------
!入力とテキスト・ウィンドウの、左上位置(x0,y0)と、枠幅(xw,yw) 設定。
CALL SetWindowPos( WinHandle("TEXT" ),0, 300,100,465,400, 0)
CALL SetWindowPos( WinHandle("INPUT"),0, 300,500,355,300, 0)

SUB SetWindowPos( handle,C2, x0,y0,xw,yw, nFLG ) !　nFLG, 0=x0y0xwyw 1=x0y0 2=xwyw
ASSIGN "user32.dll","SetWindowPos"
END SUB
!----------------------------------------------------------

DIM W$(0 TO 7)
MAT READ W$
DATA "SUN","MON","TUE","WED","THU","FRI","SAT","… "

LET J0000= 1721058-1 !　0000. 1.0 julian date
LET J1582A4= 2299160 !　1582.10.4
LET J1700= 2341973-1 !　1700. 1.0

!--------------テストＤａｔｅ
DATA "-4712/1/1"
DATA "1500/1/1"
DATA "1582/1/1"
DATA "1582/10/4" !　2299160
DATA "1582/10/5" !　-1(2299161)
DATA "1582/10/14" !　-1(2299170)
DATA "1582/10/15" !　2299161
DATA "1582/12/31"
DATA "1583/1/1" !　2299239
DATA "1600/1/1"
DATA "1900/1/1"
DATA "2000/1/1"
DATA "2100/1/1"

DATA "-1000/1/1"
DATA "-900/2/28"
DATA "-800/2/29"
DATA "-801/2/29"
DATA "-600/5/1"
DATA "-500/6/1"
DATA "-400/7/1"
DATA "-300/8/1"
DATA "-200/9/1"
DATA "-100/10/1"
DATA "0/11/1"
DATA "0200/12/1"
DATA "-4712/1/1"

DATA "2001/1/1"
DATA "2000/3/1"
DATA "2099/3/1"
DATA "1947/3/10"
DATA "1948/3/10"
DATA "1949/3/10"
DATA "1954/6/10"
DATA "1999/3/1"
DATA "2100/2/28"
DATA "2100/1/0"
DATA "1900/1/0"
DATA "1900/1/1"
DATA "-4712/1/1"

DATA "2008/1/13"

DO
READ IF MISSING THEN EXIT DO:d$
CALL d_julian
LOOP

DO
PRINT "　紀元前は、天文年( ,,,-2,-1,0,1 )で、"
INPUT PROMPT"yyyy/mm/dd= ":d$
CALL d_julian
LOOP

SUB d_julian
LET p1=POS(d$,"/",1)
LET p2=POS(d$,"/",p1+1)
LET p3=LEN(d$)
WHEN EXCEPTION IN
LET YY=VAL(d$(1:p1-1))
LET MM=VAL(d$(p1+1:p2-1))
LET DD=VAL(d$(p2+1:p3))
CALL julian
USE
PRINT " d$=""";d$;""" ≠ ""yyyy/mm/dd"" error."
END WHEN
END SUB

SUB julian
PRINT USING "-#### ## ## → ":YY,MM,DD;
CALL L_JU200
PRINT USING "-####### → " :J2_;
CALL L_DJ200
PRINT USING "-#### ## ## ": LY,LM,LD;
PRINT W$(WEEK)
END SUB

!続く

Re: 干支(えと) の計算	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/01/13 14:35:13 ** この記事は3回修正されてます
!広範囲B.C.4713(-4712)~2400~のユリウス日の計算(julian date) !消滅して存在しない日がある。1582.10.5~1582.10.14 の区間。 !---------------------------------------------------------- !入力とテキスト・ウィンドウの、左上位置(x0,y0)と、枠幅(xw,yw) 設定。 CALL SetWindowPos( WinHandle("TEXT" ),0, 300,100,465,400, 0) CALL SetWindowPos( WinHandle("INPUT"),0, 300,500,355,300, 0) SUB SetWindowPos( handle,C2, x0,y0,xw,yw, nFLG ) !　nFLG, 0=x0y0xwyw 1=x0y0 2=xwyw ASSIGN "user32.dll","SetWindowPos" END SUB !---------------------------------------------------------- DIM W$(0 TO 7) MAT READ W$ DATA "SUN","MON","TUE","WED","THU","FRI","SAT","… " LET J0000= 1721058-1 !　0000. 1.0 julian date LET J1582A4= 2299160 !　1582.10.4 LET J1700= 2341973-1 !　1700. 1.0 !--------------テストＤａｔｅ DATA "-4712/1/1" DATA "1500/1/1" DATA "1582/1/1" DATA "1582/10/4" !　2299160 DATA "1582/10/5" !　-1(2299161) DATA "1582/10/14" !　-1(2299170) DATA "1582/10/15" !　2299161 DATA "1582/12/31" DATA "1583/1/1" !　2299239 DATA "1600/1/1" DATA "1900/1/1" DATA "2000/1/1" DATA "2100/1/1" DATA "-1000/1/1" DATA "-900/2/28" DATA "-800/2/29" DATA "-801/2/29" DATA "-600/5/1" DATA "-500/6/1" DATA "-400/7/1" DATA "-300/8/1" DATA "-200/9/1" DATA "-100/10/1" DATA "0/11/1" DATA "0200/12/1" DATA "-4712/1/1" DATA "2001/1/1" DATA "2000/3/1" DATA "2099/3/1" DATA "1947/3/10" DATA "1948/3/10" DATA "1949/3/10" DATA "1954/6/10" DATA "1999/3/1" DATA "2100/2/28" DATA "2100/1/0" DATA "1900/1/0" DATA "1900/1/1" DATA "-4712/1/1" DATA "2008/1/13" DO READ IF MISSING THEN EXIT DO:d$ CALL d_julian LOOP DO PRINT "　紀元前は、天文年( ,,,-2,-1,0,1 )で、" INPUT PROMPT"yyyy/mm/dd= ":d$ CALL d_julian LOOP SUB d_julian LET p1=POS(d$,"/",1) LET p2=POS(d$,"/",p1+1) LET p3=LEN(d$) WHEN EXCEPTION IN LET YY=VAL(d$(1:p1-1)) LET MM=VAL(d$(p1+1:p2-1)) LET DD=VAL(d$(p2+1:p3)) CALL julian USE PRINT " d$=""";d$;""" ≠ ""yyyy/mm/dd"" error." END WHEN END SUB SUB julian PRINT USING "-#### ## ## → ":YY,MM,DD; CALL L_JU200 PRINT USING "-####### → " :J2_; CALL L_DJ200 PRINT USING "-#### ## ## ": LY,LM,LD; PRINT W$(WEEK) END SUB !続く