干支(えと)の計算

　　干支(えと)  の計算 SECOND 2008/01/12 02:18:50  (修正1回)
　　├!干支(えと)の計算４※こちらの「空打ち」は... 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 
　　　└紀元０年については、理科年表の「ユリウス... 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

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

Re: 干支(えと) の計算 返事を書くノートメニュー

SECOND <jjqdmekgpt> 2008/01/12 15:43:11 ** この記事は4回修正されてます

!干支(えと) の計算４　※こちらの「空打ち」は、翌年となります。

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

!還暦は、干支(えと) と、十二支のＬＣＭ( 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

!--------------テストＤａｔｅ
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

ユリウス日とは、何か。

紀元前４７１３年（－４７１２天文年）１月１日（月曜日）０起点の通し日数です。
　×：B.C.4713　　○：4713B.C.（ Before Christ ）

紀元前４７１３年　－４７１２天文年　１月　１日　ユリウス日＝　　　　　　０（月）
紀元前４７１３年　－４７１２天文年　１月　２日　ユリウス日＝　　　　　　１（火）
紀元前４７１３年　－４７１２天文年　１月　３日　ユリウス日＝　　　　　　２（水）
　　　　　　：　　　　　　：　　　　　　　：　　　　　　　　　　　　　　：
紀元前　　　３年　　　　－２天文年　１月　１日　ユリウス日＝１７２０３２８（火）
紀元前　　　２年　　　　－１天文年　１月　１日　ユリウス日＝１７２０６９３（水）
紀元前　　　元年　　　　　０天文年　１月　１日　ユリウス日＝１７２１０５８（木）
紀元　　　　元年　　　　　１天文年　１月　１日　ユリウス日＝１７２１４２４（土）
紀元　　　　２年　　　　　２天文年　１月　１日　ユリウス日＝１７２１７８９（日）
紀元　　　　３年　　　　　３天文年　１月　１日　ユリウス日＝１７２２１５４（月）
　　　　　　：　　　　　　：　　　　　　　：　　　　　　　　　　　　　　：
紀元　１５８２年　　１５８２天文年１０月　４日　ユリウス日＝２２９９１６０（木）
紀元　１５８２年　　１５８２天文年１０月１５日　ユリウス日＝２２９９１６１（金）
　　　　　　：　　　　　　：　　　　　　　：　　　　　　　　　　　　　　：
紀元　２００８年　　２００８天文年　１月　１日　ユリウス日＝２４５４４６７（火）

西暦紀元２００８年
　○：A.D.2008　　○：2008A.D.（ Anno Domini ）

西暦紀元１５８２年１０月　４日　ユリウス日＝２２９９１６０（木）
　　　　　　　　　　　　（
　　　　　この区間の日は、ありません。４日の翌日は、１５日。
　　　　　　　　　　　　　　）
西暦紀元１５８２年１０月１５日　ユリウス日＝２２９９１６１（金）

　　└グレゴリオ暦とユリウス暦の両方を表示でき... 荒田浩二 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年ギリシャ

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

Re: グレゴリオ暦とユリウス暦の両方を表示でき... 返事を書くノートメニュー

SECOND <jjqdmekgpt> 2008/01/20 15:50:59 ** この記事は6回修正されてます

紀元０年については、理科年表の「ユリウス日」に依っています。
天文学で、使われていて、便利でした。
数値の信頼性についても、理科年表を、使用しています。
( -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: 紀元０年については、理科年表の「ユリウス... 返事を書くノートメニュー

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日を越えた。

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

理科年表は、1582.10.5~10.14 の失われた１０日間が、表の構造上、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回修正されてます

私も、初めてお聞きする事で、できれば・・・お暇ないですね！
太陽年日は、１年単位の、物理的な、日数時間で、
年単位の閏年、閏秒などの調整管理に使われているようです。
今後、季節合せの為に
１０日間も日が消えたりしないようにでしょうか（^^)

インデックスへ

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

干支(えと) の計算	返事を書くノートメニュー
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

Re: 干支(えと) の計算	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/01/12 15:43:11 ** この記事は4回修正されてます
!干支(えと) の計算４　※こちらの「空打ち」は、翌年となります。 !ダブル・クリックのように「ダブル空打ち」すると終了。 !翌年を見る時、(Enter) は、たたく様に「空打ち」して下さい。 !長く押すと、オートリピートで、同様に、終了します。 !還暦は、干支(えと) と、十二支のＬＣＭ( 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

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

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

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

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 !続く

Re: !続く	返事を書くノートメニュー
SECOND <jjqdmekgpt> 2008/01/14 06:45:15
ユリウス日とは、何か。紀元前４７１３年（－４７１２天文年）１月１日（月曜日）０起点の通し日数です。　×：B.C.4713　　○：4713B.C.（ Before Christ ）紀元前４７１３年　－４７１２天文年　１月　１日　ユリウス日＝　　　　　　０（月）紀元前４７１３年　－４７１２天文年　１月　２日　ユリウス日＝　　　　　　１（火）紀元前４７１３年　－４７１２天文年　１月　３日　ユリウス日＝　　　　　　２（水）　　　　　　：　　　　　　：　　　　　　　：　　　　　　　　　　　　　　：紀元前　　　３年　　　　－２天文年　１月　１日　ユリウス日＝１７２０３２８（火）紀元前　　　２年　　　　－１天文年　１月　１日　ユリウス日＝１７２０６９３（水）紀元前　　　元年　　　　　０天文年　１月　１日　ユリウス日＝１７２１０５８（木）紀元　　　　元年　　　　　１天文年　１月　１日　ユリウス日＝１７２１４２４（土）紀元　　　　２年　　　　　２天文年　１月　１日　ユリウス日＝１７２１７８９（日）紀元　　　　３年　　　　　３天文年　１月　１日　ユリウス日＝１７２２１５４（月）　　　　　　：　　　　　　：　　　　　　　：　　　　　　　　　　　　　　：紀元　１５８２年　　１５８２天文年１０月　４日　ユリウス日＝２２９９１６０（木）紀元　１５８２年　　１５８２天文年１０月１５日　ユリウス日＝２２９９１６１（金）　　　　　　：　　　　　　：　　　　　　　：　　　　　　　　　　　　　　：紀元　２００８年　　２００８天文年　１月　１日　ユリウス日＝２４５４４６７（火）西暦紀元２００８年　○：A.D.2008　　○：2008A.D.（ Anno Domini ）西暦紀元１５８２年１０月　４日　ユリウス日＝２２９９１６０（木）　　　　　　　　　　　　（　　　　　この区間の日は、ありません。４日の翌日は、１５日。　　　　　　　　　　　　　　）西暦紀元１５８２年１０月１５日　ユリウス日＝２２９９１６１（金）

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(74-1),juweekcirc(73-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 !<続く>

Re: グレゴリオ暦とユリウス暦の両方を表示でき...	返事を書くノートメニュー
荒田浩二 <knrztrhoel> 2008/01/20 11:44:36
!<続き> CASE -45 TO -8 ! 初期ユリウス暦 LET y1w=juweekcirc(MOD(y+45,73)) 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.25y)+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.25y+jda)+INT(30.59*(m-2))+jdd-678914 END FUNCTION ![続く]

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

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.25ty)+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.25gjdy)+INT(gjdy/400)-INT(gjdy/100)-678912))/30.59+2) LET gjdd=pMJD-(INT(365.25gjdy)+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,74)) PRINT "　C) ユリウス暦";sy$;"年";sm$;"月";sd$;"日(";w$(weekcode(d));")をグレゴリオ暦で表示" PRINT USING " -########年##月##日(##)":gjdy,gjdm,gjdd,w$(weekcode(d)); PRINT " === 現行のカレンダーでの位置" PRINT END SUB !"続く"

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.25jjdy+jda)+678914)/30.59+2 IF jjdy<1 THEN LET jjdm=jjdm-12+adjust2 LET jjdm=INT(jjdm) LET jjdd=pMJD-(INT(365.25jjdy+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年ギリシャ

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

Re: 紀元０年については、理科年表の「ユリウス...	返事を書くノートメニュー
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日を越えた。２４００年を越えると、太陽年日との誤差過大が、頻繁です。(要：閏年の調整) 理科年表は、1582.10.5~10.14 の失われた１０日間が、表の構造上、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 )などへ貼り付けると、　桁位置（漢字のスペース・タブ）が正しくなり、見やすくなります。

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

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