home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
FreeWare Collection 2
/
FreeSoftwareCollection2pd199x-jp.img
/
fbasic
/
prelude
/
pds0a
/
calender
/
calender.bas
Wrap
BASIC Source File
|
1990-06-14
|
5KB
|
153 lines
100 ' F-BASIC386 SAMPLE PROGRAM % COPYRIGHT FUJITSU LIMITED 19900502
110 ' PUBLIC DOMAIN SOFTWARE by PRELUDE FMC(Fujitsuマイコンクラブ)
120 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
130 ' ★ ソフト名:万年カレンダー V3 ★
140 ' ★ 登録名 :CALENDER.BAS ★
150 ' ★ 登録者 :PRELUDE(Yuuichi Sasaki) ★
160 ' ★ 動作確認:FM-TOWNS 2 F-BASIC386 V1.1L20 ★
170 ' ★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★★
180 '
190 *環境 ' *** 環境設定 ***
200 WIDTH 80,20:CONSOLE 0,19,1:GCOL=1:P=3.14159!/180:T=0:A=0:B=A+2
210 COLOR 5,1,0,4:CLS:SCREEN@ 1:PASTEL:PSW=1
220 WINDOW (0,0)-(319,239):VIEW (0,0)-(319,239)
230 ON ERROR GOTO *異常
240 INTERVAL 1:ON INTERVAL GOSUB *時計:INTERVAL ON
250 ON KEY(1) GOSUB *PF1:KEY(1) ON
260 ON KEY(2) GOSUB *PF2:KEY(2) ON
270 ON KEY(3) GOSUB *PF3:KEY(3) ON
280 ON KEY(4) GOSUB *PF4:KEY(4) ON
290 ON KEY(5) GOSUB *PF5:KEY(5) ON
300 ON KEY(6) GOSUB *PF6:KEY(6) ON
310 KEY 1," 終了":KEY 2," 年"
320 KEY 3," 保存":KEY 4," -"
330 KEY 5," +":KEY 6," SWON"
340 KEY 7," PF7":KEY 8," PF8"
350 KEY 9," PF9":KEY 10," PF10"
360 MOUSE 0
370 ON MOUSE(2) GOSUB *左押す:MOUSE(2) ON
380 ON MOUSE(4) GOSUB *右押す:MOUSE(4) ON
390 MOUSE 1,319,239,0
400 GOTO *初期値
410 '
420 *時計 ' *** 時計割込み処理 ***
430 INTERVAL OFF
440 GCOL=GCOL+1:IF GCOL>7 THEN GCOL=1:IF PSW=1 THEN GOSUB *PF5
450 DT$=DATE$:TM$=TIME$:XX=POS(0):YY=CSRLIN
460 LOCATE 9,0:PRINT DT$;"†";TM$;"†"
470 LOCATE XX,YY:INTERVAL ON:RETURN
480 '
490 *初期値 ' *** 万年カレンダー初期値 ***
500 DIM A(12),B(12),C$(6):RESTORE 530:SW=1
510 FOR X=1 TO 12:READ A(X),B(X):NEXT X
520 FOR X=0 TO 6:READ C$(X):NEXT X
530 DATA 0,31,3,28,3,31,6,30,1,31,4,30,6,31
540 DATA 2,31,5,30,0,31,3,30,5,31
550 DATA 日, 月, 火, 水, 木, 金, 土
560 '
570 *入力 ' *** 今日 ***
580 Y=VAL("19"+KLEFT$(DATE$,2))
590 M=VAL(KMID$(DATE$,4,2))
600 '
610 *演算 ' *** 暦計算 ***
620 Y1=Y-INT(Y/100)*100
630 G=INT(Y/100)
640 G=G-INT(G/4)*4
650 E=(3-G)*2+INT(Y1/4)+Y1
660 F=0
670 IF ((Y MOD 4)=0 AND (Y MOD 100)<>0) OR (Y MOD 400)=0 THEN F=1
680 IF M<3 THEN E=E-F
690 IF M=2 THEN B(2)=B(2)+F
700 E=E+A(M)+1
710 E=E-INT(E/7)*7
720 '
730 *見出し ' *** 暦見出し ***
740 CLS:WINDOW (0,0)-(319,239)
750 FOR Y1=0 TO 9:PRINT " ":NEXT Y1
760 LINE(0,0)-(130,120),PSET,1,BF
770 LINE(0,0)-(130,120),PASTEL,7,BF
780 LINE(0,0)-(130,120),PSET,2,B
790 LOCATE 3,1:PRINT "***(暦)CALENDER(暦)***"
800 LOCATE 13,2:PRINT Y;"年 ";M;"月"
810 LOCATE 3,3:FOR X=0 TO 6:PRINT C$(X);" ";:NEXT X
820 '
830 *表示 ' *** 日表示 ***
840 K=4:D=1
850 '
860 *繰返し
870 FOR X=E TO 6
880 LOCATE X*4+2,K
890 IF D<10 THEN PRINT " ";
900 PRINT D;
910 IF D>=B(M) GOTO *確認
920 D=D+1
930 NEXT X
940 E=0:K=K+1:GOTO *繰返し
950 '
960 *確認 ' *** 変更確認 ***
970 LOCATE 3,11
980 PRINT " *** 作成年月選択 ***"
990 PRINT " マウス左:先月"
1000 PRINT " マウス右:来月"
1010 IF Y>1988 THEN PRINT " 平成";Y-1988;"+1988 は西暦です。"
1020 IF 1988=>Y AND Y>1925 THEN PRINT " 昭和";Y-1925;"+1925 は西暦です。"
1030 IF 1925>=Y AND Y>1911 THEN PRINT " 大正";Y-1911;"+1911 は西暦です。"
1040 IF 1911>=Y AND Y>1867 THEN PRINT " 明治";Y-1867;"+1867 は西暦です。"
1050 '
1060 *待ち
1070 WINDOW (-2.8!,-1.2!)-(1.2!,1.3!):PSET(0,0),0
1080 ZX=SIN(P*T*A):ZY=COS(P*T*B):T=T+1
1090 LINE(0,0)-(ZX,ZY),PASTEL,GCOL,B
1100 GOTO 1080
1110 '
1120 *右押す ' *** マウス割込(来月) ***
1130 MOUSE(2) OFF:MOUSE(4) OFF:INTERVAL OFF
1140 M=M+1:IF M>12 THEN M=1:Y=Y+1:IF Y>9999 GOTO *PF2
1150 MOUSE(2) ON:MOUSE(4) ON:INTERVAL ON:RETURN *演算
1160 '
1170 *左押す ' *** マウス割込(先月) ***
1180 MOUSE(2) OFF:MOUSE(4) OFF:INTERVAL OFF
1190 M=M-1:IF M<1 THEN M=12:Y=Y-1:IF Y<1 GOTO *PF2
1200 MOUSE(2) ON:MOUSE(4) ON:INTERVAL ON:RETURN *演算
1210 '
1220 *PF1 ' *** 終了処理 ***
1230 INTERVAL OFF:MOUSE 5:WIDTH 80,25:CONSOLE 0,25,0:END
1240 '
1250 *PF2 ' *** 年を変更 ***
1260 LOCATE 0,17:INPUT" xxxx年を入力して下さい。";Y
1270 LOCATE 0,17:PRINT" 西暦 ";Y;" 年 "
1280 BEEP:IF Y>0 AND Y<10000 THEN RETURN *演算
1290 LOCATE 0,16:COLOR 2
1300 PRINT" 入力に誤りが有ります。 ":COLOR 5
1310 GOTO *PF2
1320 '
1330 *PF3 ' *** CALENDER.DOCで保存 ***
1340 OPEN"A",#1,"\FILE\CALENDER.DOC"
1350 FOR Y1=0 TO 9:D$="'"
1360 FOR X1=0 TO 31:DB$=CHR$(SCREEN (X1,Y1))
1370 D$=D$+DB$:NEXT X1
1380 PRINT#1,Y1+Y2;D$
1390 NEXT Y1
1400 CLOSE#1:Y2=Y2+10
1410 RETURN
1420 '
1430 *PF4 ' *** パターン変更 ***
1440 VIEW (140,0)-(319,239)
1450 T=0:A=A-1:B=A+2:LINE(-2.8!,-1.2!)-(1.2!,1.3!),PSET,0,BF
1460 VIEW (0,0)-(319,239):PSET(0,0),1:RETURN
1470 '
1480 *PF5 ' *** パターン変更 ***
1490 VIEW (140,0)-(319,239)
1500 T=0:A=A+1:B=A+2:LINE(-2.8!,-1.2!)-(1.2!,1.3!),PSET,0,BF
1510 VIEW (0,0)-(319,239):PSET(0,0),1:RETURN
1520 '
1530 *PF6 ' *** パターン自動変更 ***
1540 IF PSW=0 THEN PSW=1:KEY 6," SWON" ELSE PSW=0:KEY 6," SWOF"
1550 RETURN
1560 '
1570 *異常 ' 異常処理。
1580 OPEN"A",#1,"\FILE\ERROR.BAS"
1590 PRINT#1,ERL,"Error number=";ERR,"Error line=";ERL
1600 CLOSE#1
1610 RESUME NEXT