home *** CD-ROM | disk | FTP | other *** search
/ FreeWare Collection 2 / FreeSoftwareCollection2pd199x-jp.img / fbasic / prelude / pds0a / calender / calender.bas
Encoding:
BASIC Source File  |  1990-06-14  |  5.0 KB  |  153 lines
  1. 100 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19900502
  2. 110 ' PUBLIC DOMAIN SOFTWARE by PRELUDE FMC(Fujitsuﾏｲｺﾝｸﾗﾌﾞ)
  3. 120 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  4. 130 ' ★　ソフト名：万年ｶﾚﾝﾀﾞｰ V3                                   ★
  5. 140 ' ★　登録名　：CALENDER.BAS                                    ★
  6. 150 ' ★　登録者　：PRELUDE(Yuuichi Sasaki)         　　　　　      ★
  7. 160 ' ★  動作確認：FM-TOWNS 2 F-BASIC386 V1.1L20           　　　  ★
  8. 170 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
  9. 180 '
  10. 190 *環境 ' *** 環境設定 ***
  11. 200 WIDTH 80,20:CONSOLE 0,19,1:GCOL=1:P=3.14159!/180:T=0:A=0:B=A+2
  12. 210 COLOR 5,1,0,4:CLS:SCREEN@ 1:PASTEL:PSW=1
  13. 220 WINDOW (0,0)-(319,239):VIEW (0,0)-(319,239)
  14. 230 ON ERROR GOTO *異常
  15. 240 INTERVAL 1:ON INTERVAL GOSUB *時計:INTERVAL ON
  16. 250 ON KEY(1) GOSUB *PF1:KEY(1) ON
  17. 260 ON KEY(2) GOSUB *PF2:KEY(2) ON
  18. 270 ON KEY(3) GOSUB *PF3:KEY(3) ON
  19. 280 ON KEY(4) GOSUB *PF4:KEY(4) ON
  20. 290 ON KEY(5) GOSUB *PF5:KEY(5) ON
  21. 300 ON KEY(6) GOSUB *PF6:KEY(6) ON
  22. 310 KEY 1," 終了":KEY 2," 年"
  23. 320 KEY 3," 保存":KEY 4,"  -"
  24. 330 KEY 5,"  +":KEY 6," SWON"
  25. 340 KEY 7," PF7":KEY 8," PF8"
  26. 350 KEY 9," PF9":KEY 10," PF10"
  27. 360 MOUSE 0
  28. 370 ON MOUSE(2) GOSUB *左押す:MOUSE(2) ON
  29. 380 ON MOUSE(4) GOSUB *右押す:MOUSE(4) ON
  30. 390 MOUSE 1,319,239,0
  31. 400 GOTO *初期値
  32. 410 '
  33. 420 *時計 ' *** 時計割込み処理 ***
  34. 430 INTERVAL OFF
  35. 440 GCOL=GCOL+1:IF GCOL>7 THEN GCOL=1:IF PSW=1 THEN GOSUB *PF5
  36. 450 DT$=DATE$:TM$=TIME$:XX=POS(0):YY=CSRLIN
  37. 460 LOCATE 9,0:PRINT DT$;"†";TM$;"†"
  38. 470 LOCATE XX,YY:INTERVAL ON:RETURN
  39. 480 '
  40. 490 *初期値 ' *** 万年ｶﾚﾝﾀﾞｰ初期値 ***
  41. 500 DIM A(12),B(12),C$(6):RESTORE 530:SW=1
  42. 510 FOR X=1 TO 12:READ A(X),B(X):NEXT X
  43. 520 FOR X=0 TO  6:READ C$(X):NEXT X
  44. 530 DATA 0,31,3,28,3,31,6,30,1,31,4,30,6,31
  45. 540 DATA 2,31,5,30,0,31,3,30,5,31
  46. 550 DATA  日, 月, 火, 水, 木, 金, 土
  47. 560 '
  48. 570 *入力 ' *** 今日 ***
  49. 580 Y=VAL("19"+KLEFT$(DATE$,2))
  50. 590 M=VAL(KMID$(DATE$,4,2))
  51. 600 '
  52. 610 *演算 ' *** 暦計算 ***
  53. 620 Y1=Y-INT(Y/100)*100
  54. 630 G=INT(Y/100)
  55. 640 G=G-INT(G/4)*4
  56. 650 E=(3-G)*2+INT(Y1/4)+Y1
  57. 660 F=0
  58. 670 IF ((Y MOD 4)=0 AND (Y MOD 100)<>0) OR (Y MOD 400)=0 THEN F=1
  59. 680 IF M<3 THEN E=E-F
  60. 690 IF M=2 THEN B(2)=B(2)+F
  61. 700 E=E+A(M)+1
  62. 710 E=E-INT(E/7)*7
  63. 720 '
  64. 730 *見出し ' *** 暦見出し ***
  65. 740 CLS:WINDOW (0,0)-(319,239)
  66. 750 FOR Y1=0 TO 9:PRINT "                                ":NEXT Y1
  67. 760 LINE(0,0)-(130,120),PSET,1,BF
  68. 770 LINE(0,0)-(130,120),PASTEL,7,BF
  69. 780 LINE(0,0)-(130,120),PSET,2,B
  70. 790 LOCATE 3,1:PRINT "***（暦）CALENDER（暦）***"
  71. 800 LOCATE 13,2:PRINT Y;"年  ";M;"月"
  72. 810 LOCATE 3,3:FOR X=0 TO 6:PRINT C$(X);"  ";:NEXT X
  73. 820 '
  74. 830 *表示 ' *** 日表示 ***
  75. 840 K=4:D=1
  76. 850 '
  77. 860 *繰返し
  78. 870 FOR X=E TO 6
  79. 880 LOCATE X*4+2,K
  80. 890 IF D<10 THEN PRINT " ";
  81. 900 PRINT D;
  82. 910 IF D>=B(M) GOTO *確認
  83. 920 D=D+1
  84. 930 NEXT X
  85. 940 E=0:K=K+1:GOTO *繰返し
  86. 950 '
  87. 960 *確認 ' *** 変更確認 ***
  88. 970 LOCATE 3,11
  89. 980 PRINT "  *** 作成年月選択 ***"
  90. 990 PRINT "   ﾏｳｽ左：先月"
  91. 1000 PRINT "   ﾏｳｽ右：来月"
  92. 1010 IF Y>1988 THEN PRINT "   平成";Y-1988;"+1988 は西暦です｡"
  93. 1020 IF 1988=>Y AND Y>1925 THEN PRINT "   昭和";Y-1925;"+1925 は西暦です｡"
  94. 1030 IF 1925>=Y AND Y>1911 THEN PRINT "   大正";Y-1911;"+1911 は西暦です｡"
  95. 1040 IF 1911>=Y AND Y>1867 THEN PRINT "   明治";Y-1867;"+1867 は西暦です｡"
  96. 1050 '
  97. 1060 *待ち
  98. 1070 WINDOW (-2.8!,-1.2!)-(1.2!,1.3!):PSET(0,0),0
  99. 1080 ZX=SIN(P*T*A):ZY=COS(P*T*B):T=T+1
  100. 1090 LINE(0,0)-(ZX,ZY),PASTEL,GCOL,B
  101. 1100 GOTO 1080
  102. 1110 '
  103. 1120 *右押す ' *** ﾏｳｽ割込(来月) ***
  104. 1130 MOUSE(2) OFF:MOUSE(4) OFF:INTERVAL OFF
  105. 1140 M=M+1:IF M>12 THEN M=1:Y=Y+1:IF Y>9999 GOTO *PF2
  106. 1150 MOUSE(2) ON:MOUSE(4) ON:INTERVAL ON:RETURN *演算
  107. 1160 '
  108. 1170 *左押す ' *** ﾏｳｽ割込(先月) ***
  109. 1180 MOUSE(2) OFF:MOUSE(4) OFF:INTERVAL OFF
  110. 1190 M=M-1:IF M<1 THEN M=12:Y=Y-1:IF Y<1 GOTO *PF2
  111. 1200 MOUSE(2) ON:MOUSE(4) ON:INTERVAL ON:RETURN *演算
  112. 1210 '
  113. 1220 *PF1 ' *** 終了処理 ***
  114. 1230 INTERVAL OFF:MOUSE 5:WIDTH 80,25:CONSOLE 0,25,0:END
  115. 1240 '
  116. 1250 *PF2 ' *** 年を変更 ***
  117. 1260 LOCATE 0,17:INPUT"  xxxx年を入力して下さい。";Y
  118. 1270 LOCATE 0,17:PRINT"　西暦 ";Y;" 年        　 　"
  119. 1280 BEEP:IF Y>0 AND Y<10000 THEN RETURN *演算
  120. 1290 LOCATE 0,16:COLOR 2
  121. 1300 PRINT"  入力に誤りが有ります。    ":COLOR 5
  122. 1310 GOTO *PF2
  123. 1320 '
  124. 1330 *PF3 ' *** CALENDER.DOCで保存 ***
  125. 1340 OPEN"A",#1,"\FILE\CALENDER.DOC"
  126. 1350 FOR Y1=0 TO 9:D$="'"
  127. 1360 FOR X1=0 TO 31:DB$=CHR$(SCREEN (X1,Y1))
  128. 1370 D$=D$+DB$:NEXT X1
  129. 1380 PRINT#1,Y1+Y2;D$
  130. 1390 NEXT Y1
  131. 1400 CLOSE#1:Y2=Y2+10
  132. 1410 RETURN
  133. 1420 '
  134. 1430 *PF4 ' *** ﾊﾟﾀｰﾝ変更 ***
  135. 1440 VIEW (140,0)-(319,239)
  136. 1450 T=0:A=A-1:B=A+2:LINE(-2.8!,-1.2!)-(1.2!,1.3!),PSET,0,BF
  137. 1460 VIEW (0,0)-(319,239):PSET(0,0),1:RETURN
  138. 1470 '
  139. 1480 *PF5 ' *** ﾊﾟﾀｰﾝ変更 ***
  140. 1490 VIEW (140,0)-(319,239)
  141. 1500 T=0:A=A+1:B=A+2:LINE(-2.8!,-1.2!)-(1.2!,1.3!),PSET,0,BF
  142. 1510 VIEW (0,0)-(319,239):PSET(0,0),1:RETURN
  143. 1520 '
  144. 1530 *PF6 ' *** ﾊﾟﾀｰﾝ自動変更 ***
  145. 1540 IF PSW=0 THEN PSW=1:KEY 6," SWON" ELSE PSW=0:KEY 6," SWOF"
  146. 1550 RETURN
  147. 1560 '
  148. 1570 *異常 ' 異常処理。
  149. 1580 OPEN"A",#1,"\FILE\ERROR.BAS"
  150. 1590 PRINT#1,ERL,"Error number=";ERR,"Error line=";ERL
  151. 1600 CLOSE#1
  152. 1610 RESUME NEXT
  153.