新しく発言する  EXIT  インデックスへ
干支(えと)の計算

  干支(えと)  の計算 SECOND 2008/01/12 02:18:50  (修正1回)
  !干支(えと)の計算4※こちらの「空打ち」は... SECOND 2008/01/12 15:43:11  (修正4回)
  テキストWindowを起動時に、位置と、大きさ... SECOND 2008/01/12 16:18:03 
  │└WINHANDLE関数を使うとWin32APIに渡すための... 白石 和夫 2008/01/12 18:31:28 
  │ └すみません、トップページも見るようにしま... SECOND 2008/01/12 20:15:11 
  !広範囲B.C.4713(-4712)~2400~のユリウス日... SECOND 2008/01/13 14:35:13  (修正3回)
  │└!続く SECOND 2008/01/13 14:36:31  (修正2回)
  │ └ユリウス日とは、何か。 SECOND 2008/01/14 06:45:15 
  グレゴリオ暦とユリウス暦の両方を表示でき... 荒田浩二 2008/01/20 11:40:55 
   ├!<続き> 荒田浩二 2008/01/20 11:44:36 
   │└![続き] 荒田浩二 2008/01/20 11:52:14 
   │ └!(続き) 荒田浩二 2008/01/20 11:56:51 
   │  └!"続き" 荒田浩二 2008/01/20 11:58:05 
   └紀元0年については、理科年表の「ユリウス... SECOND 2008/01/20 15:50:59  (修正6回)
    └続く SECOND 2008/01/21 16:02:27 
     └天文関係では紀元0年を設定しているとは不明... 荒田浩二 2008/01/23 20:25:33 
      └私も、初めてお聞きする事で、できれば・・... SECOND 2008/01/24 05:50:01  (修正1回)

  干支(えと)  の計算 SECOND 2008/01/12 02:18:50  (修正1回)  ツリーへ

干支(えと) の計算  返事を書く  ノートメニュー
SECOND <jjqdmekgpt> 2008/01/12 02:18:50 ** この記事は1回修正されてます
!干支(えと) の計算

DIM 干支$(0 TO 9), 十二支$(0 TO 11)

MAT READ 干支$
DATA "庚 こう  かのえ  金の兄" ! 0
DATA "辛 しん  かのと  金の弟" ! 1
DATA "壬 じん みずのえ  水の兄" ! 2
DATA "癸 き  みずのと  水の弟" ! 3
DATA "甲 こう  きのえ  木の兄" ! 4
DATA "乙 おつ  きのと  木の弟" ! 5
DATA "丙 へい  ひのえ  火の兄" ! 6
DATA "丁 てい  ひのと  火の弟" ! 7
DATA "戊 ぼ  つちのえ  土の兄" ! 8
DATA "己 き  つちのと  土の弟" ! 9

MAT READ 十二支$
DATA "申 しん   さる   さる" ! 0
DATA "酉 ゆう   とり   とり" ! 1
DATA "戌 じゅつ  いぬ   いぬ" ! 2
DATA "亥 がい    い いのしし" ! 3
DATA "子 し     ね  ねずみ" ! 4
DATA "丑 ちゅう  うし   うし" ! 5
DATA "寅 いん   とら   とら" ! 6
DATA "卯 ぼう    う  うさぎ" ! 7
DATA "辰 しん   たつ   たつ" ! 8
DATA "巳 し     み   へび" ! 9
DATA "午 ご    うま   うま" ! 10
DATA "未 び   ひつじ  ひつじ" ! 11

CALL 干支十二支(2006)
CALL 干支十二支(2007)
CALL 干支十二支(2008)

SUB 干支十二支(yyyy)
PRINT "____________________________"
PRINT yyyy;"年の干支(えと)"
PRINT "  音     訓   意味"
PRINT "----------------------------"
PRINT 干支$(MOD(yyyy,10))
PRINT 十二支$(MOD(yyyy,12))
PRINT yyyy-60;"年生れの方は、この年(";yyyy;"年)が、還暦です。"
PRINT
END SUB

!----------------------
SET ECHO "off"
DO
INPUT PROMPT "調べる年は、西暦何年?(空打ち終了)": y$
IF y$="" THEN EXIT DO
WHEN EXCEPTION IN
CALL 干支十二支(VAL(y$))
USE
beep
PRINT "半角数字で、西暦を。(空打ち終了)"
END WHEN
LOOP
PRINT "終了。"

END

  !干支(えと)の計算4※こちらの「空打ち」は... SECOND 2008/01/12 15:43:11  (修正4回)  ツリーへ

Re: 干支(えと) の計算  返事を書く  ノートメニュー
SECOND <jjqdmekgpt> 2008/01/12 15:43:11 ** この記事は4回修正されてます
!干支(えと) の計算4 ※こちらの「空打ち」は、翌年となります。

!ダブル・クリックのように「ダブル空打ち」すると終了。
!翌年を見る時、(Enter) は、たたく様に「空打ち」して下さい。
!長く押すと、オートリピートで、同様に、終了します。

!還暦は、干支(えと) と、十二支の LCM( Least Common Multiple)

!----------------------------------------------------------
!入力とテキスト・ウィンドウの、左上位置(x0,y0)と、幅(xw,yw) 設定。

CALL SetWindowPos( WinHandle("TEXT" ),0, 350,70,450,530, 0)
CALL SetWindowPos( WinHandle("INPUT"),0, 620,380,350,100, 0)

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

!----------------------------------------------------------
DIM 干支$(0 TO 9), 十二支$(0 TO 11)

MAT READ 干支$
DATA "庚 こう  かのえ  金の兄" ! 0
DATA "辛 しん  かのと  金の弟" ! 1
DATA "壬 じん みずのえ  水の兄" ! 2
DATA "癸 き  みずのと  水の弟" ! 3
DATA "甲 こう  きのえ  木の兄" ! 4
DATA "乙 おつ  きのと  木の弟" ! 5
DATA "丙 へい  ひのえ  火の兄" ! 6
DATA "丁 てい  ひのと  火の弟" ! 7
DATA "戊 ぼ  つちのえ  土の兄" ! 8
DATA "己 き  つちのと  土の弟" ! 9

MAT READ 十二支$
DATA "申 しん   さる   さる" ! 0
DATA "酉 ゆう   とり   とり" ! 1
DATA "戌 じゅつ  いぬ   いぬ" ! 2
DATA "亥 がい    い いのしし" ! 3
DATA "子 し     ね  ねずみ" ! 4
DATA "丑 ちゅう  うし   うし" ! 5
DATA "寅 いん   とら   とら" ! 6
DATA "卯 ぼう    う  うさぎ" ! 7
DATA "辰 しん   たつ   たつ" ! 8
DATA "巳 し     み   へび" ! 9
DATA "午 ご    うま   うま" ! 10
DATA "未 び   ひつじ  ひつじ" ! 11

CALL 干支十二支( 2006)
CALL 干支十二支( 2007)
CALL 干支十二支( 2008)

SUB 干支十二支( Year)
PRINT "____________________________"
PRINT "西暦";year;"年の干支(えと)"
PRINT "  音     訓   意味"
PRINT "----------------------------"
PRINT 干支$(MOD( Year,10))
PRINT 十二支$(MOD( Year,12))
PRINT Year-60;"年生れの方は、この年(";Year;"年)が、還暦です。"
PRINT
LET Memo=Year
END SUB

!----------------------
SET ECHO "off"
DO
INPUT PROMPT "(ダブル空打:終了) 調べる西暦年は?(空打:翌年)": k$
WHEN EXCEPTION IN
IF k$="" THEN LET Memo=Memo+1 ELSE LET Memo=VAL(k$)
INPUT TIMEOUT 0.3,PROMPT "(ダブル空打:終了) 調べる西暦年は?(空打:翌年)":k$
EXIT DO
USE
IF EXTYPE=8401 THEN
CALL 干支十二支( Memo)
ELSE
beep
PRINT "半角数字で、西暦を。(空打ち:翌年)"
END IF
END WHEN
LOOP
PRINT "終了。"

END

  テキストWindowを起動時に、位置と、大きさ... SECOND 2008/01/12 16:18:03   ツリーへ

Re: 干支(えと) の計算  返事を書く  ノートメニュー
SECOND <jjqdmekgpt> 2008/01/12 16:18:03
テキストWindowを起動時に、位置と、大きさを制御する方法は、
ないでしょうか? キー入力Windowの位置なども・・

  │└WINHANDLE関数を使うとWin32APIに渡すための... 白石 和夫 2008/01/12 18:31:28   ツリーへ

Re: テキストWindowを起動時に、位置と、大きさ...  返事を書く  ノートメニュー
白石 和夫 <ynwythjfwu> 2008/01/12 18:31:28
WINHANDLE関数を使うとWin32APIに渡すための,ウィンドウのハンドル値の取得ができます。
http://www.geocities.jp/thinking_math_education/BASICHelp/html/basi58th.htm
http://hp.vector.co.jp/authors/VA008683/QA_WindowPos.htm

  │ └すみません、トップページも見るようにしま... SECOND 2008/01/12 20:15:11   ツリーへ

Re: WINHANDLE関数を使うとWin32APIに渡すための...  返事を書く  ノートメニュー
SECOND <jjqdmekgpt> 2008/01/12 20:15:11
すみません、トップページも見るようにします。

  !広範囲B.C.4713(-4712)~2400~のユリウス日... SECOND 2008/01/13 14:35:13  (修正3回)  ツリーへ

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

!--------------テストDate
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

!続く

  │└!続く SECOND 2008/01/13 14:36:31  (修正2回)  ツリーへ

Re: !広範囲B.C.4713(-4712)~2400~のユリウス日...  返事を書く  ノートメニュー
SECOND <jjqdmekgpt> 2008/01/13 14:36:31 ** この記事は2回修正されてます
!続く
!--------------------------------------------------------------
!Julian Day number

!広範囲の式。(-4712.1.1~2400. . ) 消滅区間1582.10.5~1582.10.14
!--------------------------------------------------------------

!西暦年月日 YY.MM.DD から、ユリウス日 J2_ の計算
SUB L_JU200
LET WY=YY
IF 1582<WY THEN
!-- ( 1583.1.1~ yyyy.12.31), J1700= J.(1600+100. 1.0)
LET ww=INT(WY/100)
LET WY=WY-100*ww
LET J0_=J1700+INT(36524.25*(ww-17))
IF MOD(ww,4)<>0 THEN LET J1=365 ELSE LET J1=366
!--- WY.MM.DD=00.1.1~99.12.31, J0_=J.(ww00.1.0) J1=365|366
CALL L_JU26
ELSE
!--
LET J0_=J0000
LET J1=366
CALL L_JU26 !     J0_=J.(0000.1.0) J1=366
IF J1582A4<J2_ THEN ! 1582.10.4<
LET J2_=J2_-10
IF J2_=< J1582A4 THEN LET J2_=-1 ! 1582.10.5 ~1582.10.14 error
END IF
END IF
END SUB ! ~1582.10.4 1582.10.15~1582.12.31 ok.

SUB L_JU26
IF 2<MM THEN
LET WM=MM+1
ELSE
LET WM=MM+13
LET WY=WY-1
END IF
IF WY=-1 THEN
LET J2_=J0_-428 +INT(30.6001*WM)+DD
ELSE
LET J2_=J0_-428+J1+INT(365.25*WY)+INT(30.6001*WM)+DD
END IF
END SUB

!---------------
!ユリウス日 J2_ から、西暦年月日 曜日 LY.LM.LD WEEK( 0:SUN~6:SAT)の逆計算
SUB L_DJ200
IF J1582A4 <J2_ THEN !   1582.10.4<
!'--(1582.10.15~1582~12.31) (1583.1.1~ ) J1700=J.(1700.01.00)
LET ww=INT((J2_-J1700)/36524.25)+17 !  ( ww00.01.00)
LET J0_=J1700+INT(36524.25*(ww-17))
IF MOD(ww,4)<>0 THEN LET J1=365 ELSE LET J1=366
CALL L_DJ27
LET LY=LY+100*ww
ELSE
LET J0_=J0000
LET J1=366 !  J0000= J.(0000.1.0)
CALL L_DJ27
END IF
END SUB

SUB L_DJ27
LET D_=J2_-J0_+428-J1
LET LY=INT((D_-122.0001)/365.25)
IF LY=-1 THEN LET W_=D_+J1 ELSE LET W_=D_-INT(365.25*LY)
LET LM=INT( W_/30.6001)
LET LD=W_-INT( 30.6001*LM)
IF LM<14 THEN LET LM=LM-1 ELSE LET LM=LM-13
IF LM< 3 THEN LET LY=LY+1
!'--
LET WEEK=MOD(J2_+1,7)
END SUB

END

  │ └ユリウス日とは、何か。 SECOND 2008/01/14 06:45:15   ツリーへ

Re: !続く  返事を書く  ノートメニュー
SECOND <jjqdmekgpt> 2008/01/14 06:45:15
ユリウス日とは、何か。

紀元前4713年(−4712天文年)1月1日(月曜日)0起点の通し日数です。
 ×:B.C.4713  ○:4713B.C.( Before Christ )

紀元前4713年 −4712天文年 1月 1日 ユリウス日=      0(月)
紀元前4713年 −4712天文年 1月 2日 ユリウス日=      1(火)
紀元前4713年 −4712天文年 1月 3日 ユリウス日=      2(水)
      :      :       :              :
紀元前   3年    −2天文年 1月 1日 ユリウス日=1720328(火)
紀元前   2年    −1天文年 1月 1日 ユリウス日=1720693(水)
紀元前   元年     0天文年 1月 1日 ユリウス日=1721058(木)
紀元    元年     1天文年 1月 1日 ユリウス日=1721424(土)
紀元    2年     2天文年 1月 1日 ユリウス日=1721789(日)
紀元    3年     3天文年 1月 1日 ユリウス日=1722154(月)
      :      :       :              :
紀元 1582年  1582天文年10月 4日 ユリウス日=2299160(木)
紀元 1582年  1582天文年10月15日 ユリウス日=2299161(金)
      :      :       :              :
紀元 2008年  2008天文年 1月 1日 ユリウス日=2454467(火)

西暦紀元2008年
 ○:A.D.2008  ○:2008A.D.( Anno Domini )


西暦紀元1582年10月 4日 ユリウス日=2299160(木)
            (
     この区間の日は、ありません。4日の翌日は、15日。
              )
西暦紀元1582年10月15日 ユリウス日=2299161(金)

  グレゴリオ暦とユリウス暦の両方を表示でき... 荒田浩二 2008/01/20 11:40:55   ツリーへ

Re: 干支(えと) の計算  返事を書く  ノートメニュー
荒田浩二 <knrztrhoel> 2008/01/20 11:40:55
グレゴリオ暦とユリウス暦の両方を表示できるカレンダーです。
SECONDさんも苦労されていますが、ユリウス日から元の年月日を取り出すのが大変なんですよね。
ユリウス暦の制定は紀元前45年ですが当初は3年に1度の閏年だったそうで、それを取り入れています。参考にしたのは、2006年2月ごろのWikipediaの記事です。
ぜひ、1582年10月の日付を入力してみてください。変換期のカレンダーを表示できます。
ところで、SECONDさんのプログラムでは西暦1年の前年が西暦0年となりませんか?

REM ** グレゴリオ暦/ユリウス暦 カレンダー **
!閏年 -44年,-41,-38,-35,-32,-29,-26,-23,-20,-17,-14,-11,-8,+8,+12,+16年,,,
DECLARE FUNCTION y_m_d,gMJD,jMJD,weekcode
OPTION BASE 0
DIM w$(7-1),md(1 TO 12),weekcirc(7*4-1),juweekcirc(7*3-1)
DIM 十干$(10-1),十干かな$(10-1),十二支$(12-1),十二支かな$(12-1)
SET ECHO "OFF"
LINE INPUT PROMPT "西暦年/月/日 (半角入力)":ymd0$ ! 区切り文字は何でも可(/-,.文字や空白も可)
CALL data_check ! 入力データチェック
WHEN EXCEPTION IN ! 年,月,日の取得
LET y=y_m_d(1) ! 年
LET m=y_m_d(fi+1) ! 月
LET d=y_m_d(fi+1) ! 日
LET sy$=STR$(y)
LET sm$=STR$(m)
LET sd$=STR$(d)
USE
CALL error(1)
END WHEN
MAT READ w$,md,weekcirc,juweekcirc
DATA 日,月,火,水,木,金,土
DATA 31,28,31,30,31,30,31,31,30,31,30,31
DATA 0,1,2,3,5,6,0,1,3,4,5,6,1,2,3,4,6,0,1,2,4,5,6,0,2,3,4,5 ! 1月1日の曜日
DATA 5,6,1,2,3,5,6,0,2,3,4,6,0,1,3,4,5,0,1,2,4 ! 初期ユリウス暦
CALL error_check ! エラーチェック
LET leap=0 ! うるう年 off
LET tjleap=0 ! 通年ユリウス暦うるう年 off
IF y>0 AND MOD(y,4)=0 THEN LET tjleap=1
LET jdy=y
LET jdm=m
LET jdd=d
LET jdleap=0 ! ユリウス通日での閏年 off
IF m=1 OR m=2 THEN ! 1月2月は前年の13月14月として計算
LET jdy=y-1
LET jdm=m+12
END IF
! ユリウス通日(AJD),Lilian日(LD),修正ユリウス日(MJD)
DEF AJD=MJD+2400000.5 ! -4713/1/1=-0.5 (-4713/1/1/12:00=0) ユリウス通日
DEF LD=AJD-2299159.5 ! LD=MJD+100841 1582/10/15=1 Lilian日
IF y>1582 OR (y=1582 AND (m>10 OR (m=10 AND d>=15))) THEN
LET gg=1 ! 1582/10/15以降
LET r$="(グレゴリオ暦・"
CALL greg ! グレゴリオ暦の曜日閏年計算
LET jdleap=leap
IF MOD(y,4)=0 THEN LET tjleap=1
LET MJD=gMJD(jdy,jdm,jdd) ! 修正ユリウス日
ELSE
LET gg=0
IF y=1582 AND m=10 AND (d>4 AND d<15) THEN
PRINT "ユリウス暦・グレゴリオ暦 期間外 !!"
LET jg=-1
END IF
LET r$="(ユリウス暦・"
LET MJD=jMJD(jdy,jdm,jdd) ! 修正ユリウス日
SELECT CASE y
CASE IS >=8 ! 改良ユリウス暦
LET y1w=weekcirc(MOD(y+15,7*4))
IF MOD(y,4)=0 THEN LET leap=1
LET jdleap=leap
CASE 1 TO 7 ! AD.移行期間
LET y1w=MOD(y+6,7)
IF y=4 THEN LET jdleap=1
CASE -7 TO -1 ! BC.移行期間
LET y1w=y+7
IF MOD(y,4)=3 THEN LET jdleap=1
!<続く>

   ├!<続き> 荒田浩二 2008/01/20 11:44:36   ツリーへ

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

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

   │└![続き] 荒田浩二 2008/01/20 11:52:14   ツリーへ

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

   │ └!(続き) 荒田浩二 2008/01/20 11:56:51   ツリーへ

Re: ![続き]  返事を書く  ノートメニュー
荒田浩二 <knrztrhoel> 2008/01/20 11:56:51
!(続き)
SUB today ! A)本日との日数差
LET ttd$=DATE$ ! tAJD = 今日のユリウス通日
LET ty=VAL(ttd$(1:4))
LET tm=VAL(ttd$(5:6))
LET td=VAL(ttd$(7:8))
IF tm=1 OR tm=2 THEN
LET ty=ty-1
LET tm=tm+12
END IF
LET tAJD=INT(365.25*ty)+INT(ty/400)-INT(ty/100)+INT(30.59*(tm-2))+td-678912+2400000.5
IF AJD-tAJD>=0 THEN
PRINT USING " A) 今日(####/##/##)から ######### 日後":ttd$(1:4),ttd$(5:6),ttd$(7:8),AJD-tAJD
ELSE
PRINT USING " A) 今日(####/##/##)から ######### 日前":ttd$(1:4),ttd$(5:6),ttd$(7:8),tAJD-AJD
END IF
PRINT
END SUB
SUB eto ! B)干支
MAT READ 十干$,十干かな$,十二支$,十二支かな$
DATA 甲,乙,丙,丁,戊,己,庚,辛,壬,癸
DATA きのえ,きのと,ひのえ,ひのと,つちのえ,つちのと,かのえ,かのと,みずのえ,みずのと
DATA 子,丑,寅,卯,辰,巳,午,未,申,酉,戌,亥
DATA ね,うし,とら,う,たつ,み,うま,ひつじ,さる,とり,いぬ,い
LET y10a=6
IF y<0 THEN LET y10a=7
LET y十干code=MOD(y+y10a,10)
LET y12a=8
IF y<0 THEN LET y12a=9
LET y十二支code=MOD(y+y12a,12)
LET 十干code=MOD(AJD+9.5,10)
LET 十二支code=MOD(AJD+1.5,12)
LET jdweekcode=MOD(AJD+1.5,7) ! ユリウス通日から曜日を算出
PRINT " B) ユリウス通日から算出した干支と曜日"
PRINT TAB(4);十干$(y十干code);十二支$(y十二支code);
PRINT "(";十干かな$(y十干code);十二支かな$(y十二支code);")年;";
PRINT 十干$(十干code);十二支$(十二支code);
PRINT "(";十干かな$(十干code);十二支かな$(十二支code);")日:";
PRINT w$(jdweekcode);"曜日"
PRINT
END SUB
SUB all_greg ! C)通年グレゴリオ年月日
LET pMJD=jMJD(jdy,jdm,jdd)
LET gjdy=(pMJD+678912-30)/365.25 ! 調整値;-30
LET gjdy=INT(gjdy+(-INT(gjdy/400)+INT(gjdy/100))/365.25)
LET gjdm=INT((pMJD-(INT(365.25*gjdy)+INT(gjdy/400)-INT(gjdy/100)-678912))/30.59+2)
LET gjdd=pMJD-(INT(365.25*gjdy)+INT(gjdy/400)-INT(gjdy/100)+INT(30.59*(gjdm-2))-678912)
IF gjdm=2 AND gjdd=30 THEN
LET gjdy=gjdy-1
LET gjdm=14
LET gjdd=29
END IF
IF (gjdy+1)/100=INT((gjdy+1)/100) AND (gjdy+1)/400<>INT((gjdy+1)/400) AND gjdm=14 AND gjdd=29 THEN
LET gjdy=gjdy+1
LET gjdm=3
LET gjdd=1
END IF
IF gjdm>12 THEN
LET gjdy=gjdy+1
LET gjdm=gjdm-12
END IF
LET y1w=weekcirc(MOD(y+15,7*4))
PRINT " C) ユリウス暦";sy$;"年";sm$;"月";sd$;"日(";w$(weekcode(d));")をグレゴリオ暦で表示"
PRINT USING " -########年##月##日(##)":gjdy,gjdm,gjdd,w$(weekcode(d));
PRINT " === 現行のカレンダーでの位置"
PRINT
END SUB
!"続く"

   │  └!"続き" 荒田浩二 2008/01/20 11:58:05   ツリーへ

Re: !(続き)  返事を書く  ノートメニュー
荒田浩二 <knrztrhoel> 2008/01/20 11:58:05
!"続き"
SUB all_julius ! D)通年ユリウス年月日
LET pMJD=gMJD(jdy,jdm,jdd)
LET adjust=-30
LET adjust2=0.022
LET adjust3=-1.00273
LET jjdy=(pMJD+678914-jda+adjust)/365.25
IF jjdy<1 THEN LET jjdy=jjdy+adjust3
LET jjdy=INT(jjdy)
LET jjdm=(pMJD-INT(365.25*jjdy+jda)+678914)/30.59+2
IF jjdy<1 THEN LET jjdm=jjdm-12+adjust2
LET jjdm=INT(jjdm)
LET jjdd=pMJD-(INT(365.25*jjdy+jda)+INT(30.59*(jjdm-2))-678914)
IF jjdy<1 THEN LET jjdd=jjdd
IF jjdy=1 AND jMJD(jjdy,jjdm,jjdd)<>pMJD THEN
LET jjdy=-1
LET jjdm=14
LET jjdd=jjdd+27
END IF
IF jjdm>12 THEN
LET jjdy=jjdy+1
LET jjdm=jjdm-12
END IF
IF jjdy<=0 THEN LET jjdd=jjdd-366
IF jjdy=0 THEN LET jjdy=jjdy+1
CALL greg ! グレゴリオ暦の曜日閏年計算
PRINT " D) グレゴリオ暦";sy$;"年";sm$;"月";sd$;"日(";w$(weekcode(d));")をユリウス暦で表示"
PRINT USING " -########年##月##日(##) ":jjdy,jjdm,jjdd,w$(weekcode(d))
END SUB
SUB error_check ! エラーチェック
IF y<>INT(y) THEN CALL error(2)
IF y=0 THEN CALL error(2.5)
IF m<1 OR m>12 OR m<>INT(m) THEN CALL error(3)
IF d<1 OR (m<>2 AND d>md(m)) OR (m=2 AND d>29) OR d<>INT(d) THEN CALL error(4)
END SUB
SUB error(er) ! エラー処理
PRINT ymd0$
PRINT " ERROR !!"
PRINT
SELECT CASE er
CASE 1
PRINT "入力形式に誤りがあります。"
PRINT "半角で年月日の順に、間に区切り文字を1字入れて入力してください。"
PRINT "区切り文字は記号,英字,漢字等。空白でもかまいません。"
CASE 2
PRINT "年号の入力に誤りがあります。"
CASE 2.5
PRINT "西暦 0 年は存在しません。"
CASE 3
PRINT "月の入力に誤りがあります。"
CASE 4
PRINT "日付の入力に誤りがあります。"
END SELECT
PRINT
PRINT "正しい入力例 : 2006/3/17 ; 2006-03-17 ; 2006 3 17"
PRINT "正しい入力例 : 2006年3月17日 ; Y2006M03D17 ; '06.03.17"
PRINT "紀元前は負号を入力 : -42/11/28"
PRINT
PRINT " STOP !!"
STOP
END SUB
END
!** グレゴリオ暦 採用年 **
! 1582年10月15日 イタリア、スペイン、ポルトガル、ポーランド
! 1582年12月20日 フランス(1793年11月24日〜1805年12月31日はフランス共和暦)
! 1583年から1587年にかけ ドイツ、スイス、オランダのカトリック地域
! 1700年 3月 1日 ドイツ、オランダのプロテスタント地域
! 1752年 9月14日 イギリス
! 1783年 アメリカ
! 1873年(明治6年)1月1日 日本=明治5年12月2日(1872年12月31日)の翌日から
! 1875年 エジプト
! 1912年 中国
! 1918年 ソビエト
! 1924年 ギリシャ

   └紀元0年については、理科年表の「ユリウス... SECOND 2008/01/20 15:50:59  (修正6回)  ツリーへ

Re: グレゴリオ暦とユリウス暦の両方を表示でき...  返事を書く  ノートメニュー
SECOND <jjqdmekgpt> 2008/01/20 15:50:59 ** この記事は6回修正されてます
紀元0年については、理科年表の「ユリウス日」に依っています。
天文学で、使われていて、便利でした。
数値の信頼性についても、理科年表を、使用しています。
( -1000年~2400年)
この他の区間は、表が無くて、照合は、できませんでした。

「照合結果」

  R: 理科年表 ( -1000.1.1~ 2499.12.31 )
 J2: 広範囲の式( -4712.1.1~ グレゴリオ暦 調整まで全域 )
  T: 太陽年日 ( 1900.1.1 のユリウス日を基準に、年単位の加算日 )

                          (誤差J2-T)
 -4712 1 1  R    ? J2    0 T   38.24 -38.2  -4712 1 1 MON
 -1100 1 1  R    ? J2 1319283 T 1319294.13 -11.1  -1100 1 1 MON
 -1000 1 1  R 1355808 J2 1355808 T 1355818.37 -10.4  -1000 1 1 SUN
  -900 2 28  R 1392391 J2 1392391 T     ?       -900 2 28 MON
  -800 2 29  R 1428917 J2 1428917 T     ?       -800 2 29 MON
  -801 2 29  R 1428552 J2 1428552 T     ?       -801 3 1 SUN
  -600 5 1  R 1502029 J2 1502029 T     ?       -600 5 1 FRI
  -500 6 1  R 1538585 J2 1538585 T     ?       -500 6 1 SUN
  -400 7 1  R 1575140 J2 1575140 T     ?       -400 7 1 MON
  -300 8 1  R 1611696 J2 1611696 T     ?       -300 8 1 WED
  -200 9 1  R 1648252 J2 1648252 T     ?       -200 9 1 FRI
  -100 10 1  R 1684807 J2 1684807 T     ?       -100 10 1 SAT
   0 11 1  R 1721363 J2 1721363 T     ?        0 11 1 MON
  200 12 1  R 1794443 J2 1794443 T     ?       200 12 1 MON
  1500 1 1  R 2268933 J2 2268933 T 2268924.12  8.9   1500 1 1 WED
  1582 1 1  R 2298884 J2 2298884 T 2298873.98  10.0   1582 1 1 MON
  1582 10 4  R 2299160 J2 2299160 T     ?       1582 10 4 THU
  1582 10 5  R    ? J2    ? T     ?        ? ? ? ?
  1582 10 14  R    ? J2    ? T     ?        ? ? ? ?
  1582 10 15  R    ? J2 2299161 T     ?       1582 10 15 FRI
  1600 1 1  R 2305448 J2 2305448 T 2305448.34  -0.3   1600 1 1 SAT
  1700 1 1  R 2341973 J2 2341973 T 2341972.56  0.4   1700 1 1 FRI
  1800 1 1  R 2378497 J2 2378497 T 2378496.78  0.2   1800 1 1 WED
  1900 1 1  R 2415021 J2 2415021 T 2415021.00  0.0   1900 1 1 MON
  2000 1 1  R 2451545 J2 2451545 T 2451545.22  -0.2   2000 1 1 SAT
  2100 1 1  R 2488070 J2 2488070 T 2488069.44  0.6   2100 1 1 FRI


(誤差J2-T)の計算の基準、太陽年日 T は、以下の式を、使用しました。

Days/year= 365.24219878-0.0000000614*(yyyy-1900)

太陽年日 T(yyyy.1.1 12:00)= 365.24219878*(yyyy-1900)-0.0000000614*(yyyy-1900)^2/2 +2415021.0

オフセットの、ユリウス日(1900.1.1 12:00)= 2415021.0

続く

    └続く SECOND 2008/01/21 16:02:27   ツリーへ

Re: 紀元0年については、理科年表の「ユリウス...  返事を書く  ノートメニュー
SECOND <jjqdmekgpt> 2008/01/21 16:02:27
続く
                          (誤差J2-T)
  2100 1 1  R 2488070 J2 2488070 T 2488069.44  0.6   2100 1 1 FRI
  2200 1 1  R 2524594 J2 2524594 T 2524593.66  0.3   2200 1 1 WED
  2300 1 1  R 2561118 J2 2561118 T 2561117.87  0.1   2300 1 1 MON
  2400 1 1  R 2597642 J2 2597642 T 2597642.09  -0.1   2400 1 1 SAT
  2497 1 1  R 2633072 J2 2633072 T 2633070.58  1.4   2497 1 1 TUE
 ユリウス日(J2)-太陽年日(T・1900.1.1~)= 誤差が1.4日を越えた。
  2500 1 1  R    ? J2 2634167 T 2634166.31  0.7   2500 1 1 FRI
  2600 1 1  R    ? J2 2670691 T 2670690.52  0.5   2600 1 1 WED
  2700 1 1  R    ? J2 2707215 T 2707214.74  0.3   2700 1 1 MON
  2800 1 1  R    ? J2 2743739 T 2743738.95  0.0   2800 1 1 SAT
  2877 1 1  R    ? J2 2771864 T 2771862.60  1.4   2877 1 1 FRI
 ユリウス日(J2)-太陽年日(T・1900.1.1~)= 誤差が1.4日を越えた。
  2881 1 1  R    ? J2 2773325 T 2773323.57  1.4   2881 1 1 WED
 ユリウス日(J2)-太陽年日(T・1900.1.1~)= 誤差が1.4日を越えた。
  2885 1 1  R    ? J2 2774786 T 2774784.54  1.5   2885 1 1 MON
 ユリウス日(J2)-太陽年日(T・1900.1.1~)= 誤差が1.4日を越えた。
  2889 1 1  R    ? J2 2776247 T 2776245.50  1.5   2889 1 1 SAT
 ユリウス日(J2)-太陽年日(T・1900.1.1~)= 誤差が1.4日を越えた。
  2893 1 1  R    ? J2 2777708 T 2777706.47  1.5   2893 1 1 THU
 ユリウス日(J2)-太陽年日(T・1900.1.1~)= 誤差が1.4日を越えた。
  2897 1 1  R    ? J2 2779169 T 2779167.44  1.6   2897 1 1 TUE
 ユリウス日(J2)-太陽年日(T・1900.1.1~)= 誤差が1.4日を越えた。
  2900 1 1  R    ? J2 2780264 T 2780263.17  0.8   2900 1 1 FRI
  3000 1 1  R    ? J2 2816788 T 2816787.38  0.6   3000 1 1 WED
  3100 1 1  R    ? J2 2853312 T 2853311.59  0.4   3100 1 1 MON
  3200 1 1  R    ? J2 2889836 T 2889835.81  0.2   3200 1 1 SAT
  3261 1 1  R    ? J2 2912117 T 2912115.58  1.4   3261 1 1 SAT
 ユリウス日(J2)-太陽年日(T・1900.1.1~)= 誤差が1.4日を越えた。


2400年を越えると、太陽年日との誤差過大が、頻繁です。(要:閏年の調整)

理科年表は、1582.10.5~10.14 の失われた10日間が、表の構造上、1600年まで
補正できず、1582.10.5〜1599.12.31 は、+10日間 多めの数値。(ユリウス暦 相応)

  1582 10 5  R 2299161 J2    ? T     ?        ? ? ? ?
  1582 10 14  R 2299170 J2    ? T     ?        ? ? ? ?
  1582 10 15  R 2299171 J2 2299161 T     ?      1582 10 15 FRI

※前ページとも、メモ帳( フォント=FixedSys )などへ貼り付けると、
 桁位置(漢字のスペース・タブ)が正しくなり、見やすくなります。

     └天文関係では紀元0年を設定しているとは不明... 荒田浩二 2008/01/23 20:25:33   ツリーへ

Re: 続く  返事を書く  ノートメニュー
荒田浩二 <knrztrhoel> 2008/01/23 20:25:33
天文関係では紀元0年を設定しているとは不明にして存じておりませんでした。失礼いたしました。
太陽年をベースに暦を計算する方法ならば、春分点や秋分点の算出も可能なのではないでしょうか。
たとえば「1493年の春分の日が知りたい」といった要望にもこたえられるでしょうか?
ユリウス日から春分の日を算出する方法もあるらしいのですが、私には無理でした。
SECONDさん、お願いします。

      └私も、初めてお聞きする事で、できれば・・... SECOND 2008/01/24 05:50:01  (修正1回)  ツリーへ

Re: 天文関係では紀元0年を設定しているとは不明...  返事を書く  ノートメニュー
SECOND <jjqdmekgpt> 2008/01/24 05:50:01 ** この記事は1回修正されてます
私も、初めてお聞きする事で、できれば・・・お暇ないですね!
太陽年日は、1年単位の、物理的な、日数時間で、
年単位の閏年、閏秒などの調整管理に使われているようです。
今後、季節合せの為に
10日間も日が消えたりしないようにでしょうか(^^)


 インデックスへ  EXIT
新規発言を反映させるにはブラウザの更新ボタンを押してください。