SmileBASIC

プログラムリスト

SYS/EX5BIORHYTHM

スクリーンショット

トップメニュー「SmileBASICでプログラムを作る」から、LOAD"SYS/EX5BIORHYTHM"でプログラムが読み込まれます。キーボードの「EDIT」キーを押すと、このプログラムが自由に編集できます。


'
' EXAMPLE5 
' バイオリズム   
'
XSCREEN 0
DISPLAY 0
VISIBLE 1,1,1,1
GCLS
CLS

'--- 
DIM MDAY[12]
DATA 31,28,31,30,31,30
DATA 31,31,30,31,30,31
FOR I=0 TO 11
 READ MDAY[I]
NEXT I
'--- 
SPC = 8
BGT = 4
LINEH = 72
LINEC = BGT + SPC + LINEH
DAYW = 12
DRAWD = 30
BGL = 16
BGR = BGL + DAYW * (DRAWD - 1) + SPC * 2
BGB = BGT + (SPC + LINEH) * 2 + SPC
DIM DDAY[DRAWD]
COLOR 15
'--- 
@START
CLS
GCLS
FOR I = 0 TO DRAWD - 1
 DDAY[I] = FALSE
NEXT
PRINT""
PRINT"バイオリズム"
PRINT""
'--- 
@INPUTDAY
INPUT ":たんじょうび は(YYYYMMDD)"; DT$
IF LEN(DT$) != 8 THEN @ERROR
BYEAR = VAL(MID$(DT$, 0, 4))
BMON = VAL(MID$(DT$, 4, 2))
BDAY = VAL(MID$(DT$, 6, 2))
IF BYEAR < 1900 THEN @ERROR
IF BMON < 1 OR BMON > 12 THEN @ERROR
IF BDAY < 1 THEN @ERROR
DTREAD(DATE$) out NYEAR, NMON, NDAY
IF BYEAR > NYEAR THEN @ERROR
YEAR = NYEAR
MON = NMON
DAY = NDAY
GOSUB @CALCDAY
TOTAL = CDAY
YEAR = BYEAR
MON = BMON
DAY = BDAY
GOSUB @CALCDAY
LEAP = 0
IF MON == 2 THEN GOSUB @CHKLEAP
IF DAY > MDAY[MON - 1] + LEAP THEN @ERROR
TOTAL = TOTAL + YEARDAY - CDAY
IF BYEAR == NYEAR THEN @DRAW
FOR YEAR = BYEAR TO NYEAR - 1
 TOTAL = TOTAL + 365
 GOSUB @CHKLEAP
 TOTAL = TOTAL + LEAP
NEXT
'--- 
@DRAW
CLS
GCLS RGB(0,0,255)
GFILL BGL, BGT, BGR, BGB, RGB(255,255,255)
GCOLOR RGB(128,128,128)
GBOX BGL, BGT, BGR, BGB
X = BGL + SPC
GLINE X, LINEC, BGR - SPC, LINEC
Y = BGT + SPC
X2 = X + DAYW * (DRAWD - 1)
GLINE X, Y, X2, Y
Y2 = Y + LINEH * 2
FOR I = 1 TO DRAWD
 GLINE X, Y, X, Y2
 X = X + DAYW
NEXT
GLINE BGL + SPC, Y2, X2, Y2
X = BGL + SPC
Y1 = Y2 + 1
Y2 = Y1 + 1
DAY = NDAY
STEPD = 10

GCOLOR RGB(255,0,0)
COLOR 1
FOR I = 1 TO DRAWD STEP STEPD
 GLINE X, Y1, X - 1, Y2
 GLINE X, Y1, X + 1, Y2
 GPSET X, Y2

 TX = (X/8)
 TY = (Y2/8)+1
 LOCATE TX, TY
 PRINT DAY

 X = X + STEPD * DAYW
 DAY = DAY + STEPD
 IF DAY > MDAY[NMONTH] THEN DAY = DAY - MDAY[NMONTH]
NEXT

GCOLOR RGB(128,128,128)
TX = 2
TY = 24
X1 = TX * 8 - 4
Y1 = TY * 8 - 4
X2 = 400 - X1
Y2 = Y1 + 16
GFILL X1, Y1, X2, Y2, RGB(255,255,255)
GBOX X1, Y1, X2, Y2
'---
LOCATE TX, TY
PRINT "しんたい    かんじょう    ちせい      ちゅういび"
Y = TY * 8 + 4
X = (TX+5) * 8
GLINE X, Y, X + 8, Y, RGB(0,255,0)
X = (TX+14) * 8
GLINE X, Y, X + 8, Y, RGB(255,0,0)
X = (TX+21) * 8
GLINE X, Y, X + 8, Y, RGB(0,0,255)

X1 = (TX + 32) * 8
Y1 = TY * 8
GBOX X1, Y1, X1 + 8, Y1 + 8, RGB(255,0,0)

GCOLOR RGB(0,255,0)
BDAY = 23
GOSUB @DRAWLINE

GCOLOR RGB(255,0,0)
BDAY = 28
GOSUB @DRAWLINE

GCOLOR RGB(0,0,255)
BDAY = 33
GOSUB @DRAWLINE
GCOLOR 14
X = BGL + SPC - DAYW / 2
Y1 = LINEC - DAYW / 2
Y2 = Y1 + DAYW

FOR I = O TO DRAWD - 1
 IF DDAY[I] THEN GBOX X, Y1, X + DAYW, Y2, RGB(255,0,0)
 X = X + DAYW
NEXT
'---
COLOR 15
LOCATE 1,27
PRINT "Aボタン=もういちど";
WHILE (BUTTON()!=16)
 VSYNC 1
WEND

WHILE (BUTTON()!=0)
 VSYNC 1
WEND

GOTO @START

'--- 
@CALCDAY
CDAY = DAY
IF MON == 1 THEN @JAN
FOR I = 1 TO MON - 1
 CDAY = CDAY + MDAY[I - 1]
NEXT
'--- 
@JAN
LEAP = 0
IF MON > 2 THEN GOSUB @CHKLEAP
CDAY = CDAY + LEAP
RETURN
'--- 
@CHKLEAP
LEAP = 0
IF ((YEAR MOD 4) == 0) THEN LEAP = 1
IF (YEAR MOD 400) == 0 THEN RETURN
IF (YEAR MOD 100) == 0 THEN LEAP = 0
RETURN
'--- 
@DRAWLINE
DAY = TOTAL
YEAR = NYEAR
MON = NMON
X2 = BGL + SPC
LEAP = 0
GOSUB @CALCBIO
FOR I = 0 TO DRAWD - 2
 X1 = X2
 Y1 = Y2
 DAY = DAY + 1
 X2 = X2 + DAYW
 GOSUB @CALCBIO
 GLINE X1, Y1, X2, Y2
 GOSUB @CHKDDAY
NEXT
Y1 = Y2
DAY = DAY + 1
GOSUB @CALCBIO
I = DRAWD - 1
GOSUB @CHKDDAY
RETURN
'--- 
@CALCBIO
Y2 = LINEC - SIN(DAY * 2 * 3.141 / BDAY) * LINEH
RETURN
'--- 
@CHKDDAY
IF Y1 <= LINEC AND LINEC < Y2 THEN DDAY[I] = TRUE
IF Y1 >= LINEC AND LINEC > Y2 THEN DDAY[I] = TRUE
RETURN
'--- 
@ERROR
BEEP
PRINT "エラー!"
GOTO @INPUTDAY

ページトップへ