筆算プログラム割り算にも対応しました。

　　筆算プログラム割り算にも対応しました。 哲 2004/01/28 21:25:20 
　　├続きです。 哲 2004/01/28 21:27:57 
　　└tetusann もりの 2004/01/28 22:54:48 
　　　└害虫駆除しましたのでこちらを使ってくださ... 哲 2004/01/29 14:57:24 
　　　　└つづき１ 哲 2004/01/29 14:58:39 
　　　　　└つづき２ 哲 2004/01/29 14:59:34 
　　　　　　└１箇所修正してください。 哲 2004/01/29 16:56:39 
　　　　　　　└哲さん もりの 2004/01/29 19:23:27 
　　　　　　　　└IEのバージョンが古かったので新しいもので... 哲 2004/01/29 19:56:53 
　　　　　　　　　└続き１ 哲 2004/01/29 19:59:21 
　　　　　　　　　　└続き２ 哲 2004/01/29 20:00:23 
　　　　　　　　　　　├どうも全角に変換すると化けるようなので、... 哲 2004/01/29 20:42:11 
　　　　　　　　　　　│└ここで書けなくなちゃいました。 哲 2004/01/29 21:07:18 
　　　　　　　　　　　│　└メルアドは もりの 2004/01/29 21:17:55 
　　　　　　　　　　　│　　└筆算ソフトっていっぱいあってよく解りませ... 哲 2004/01/29 22:05:41 
　　　　　　　　　　　│　　　└私もＮ８８の本はくさるほど もりの 2004/01/29 23:59:03 
　　　　　　　　　　　│　　　　└私はN88BASICは使ったことがありません。 哲 2004/01/30 08:39:18 
　　　　　　　　　　　└＊文字化けの対策＊ 哲 2004/01/31 00:34:38 
　　　　　　　　　　　　├自動採点の赤丸 もりの 2004/01/31 09:08:26 
　　　　　　　　　　　　└＊表示色の変更＊ 哲 2004/02/02 14:04:56

　　筆算プログラム割り算にも対応しました。 哲 2004/01/28 21:25:20  ツリーへ

筆算プログラム割り算にも対応しました。 返事を書く

哲 2004/01/28 21:25:20

中途半端なので、何とか割り算にも対応しました。
入力エラーチェックは十分でないかも知れませんが、
こんなもんで良かったら、修正するなり改造するなりして勝手に使ってください。
!　[筆算プログラム　for　十進ＢＡＳＩＣ]
!
!数値と＋－*/＝またはEnterを入れて行けば計算確認できます。
!問題入力中は、どこでも不適切なキーを押すことで初期状態に戻ります。
!前処理の　txtsize=　で大きさを自由に変えてください。
!
!　cval:数値保存用配列　cal$:演算子　
!　ichr$:入力文字　hchr$,jchr$:一時保存文字　comp$:比較文字列
!
!　　***前処理***
DECLARE　EXTERNAL　FUNCTION　prob$
DECLARE　EXTERNAL　SUB　ans$
SET　ECHO　"OFF"
LET　txtsize=32　　　　!!!　文字の大きさを変える
LET　width=(txtsize+5)*15
LET　height=(txtsize+5)*15
SET　BITMAP　SIZE　width,　height
SET　WINDOW　10,　-3,　10,　-3　!座標系と桁、行を一致させる
SET　AREA　COLOR　0
SET　LINE　WIDTH　2
DIM　cval(8)
!
!　***メイン処理***
10　CLEAR
　MAT　cval=ZER
　LET　lin=1
　LET　comp$=""
　LET　lprb=0
　LET　cal$=""
　LET　cal0$="+-*/?="　&　chr$(13)
　SET　TEXT　FONT　"ＭＳ　ゴシック",INT(txtsize/4*3)
　PLOT　TEXT　,AT　9,-1.5　:　"5ケタまでのけいさん(＋－＊/＝)"
　SET　TEXT　FONT　"ＭＳ　ゴシック",txtsize
　LET　cval$=prob$(1,lprb,cal$)　　　!問題１行目
　LET　lprb=LEN(cval$)-1
　LET　cal$=RIGHT$(cval$,1)
　IF　lprb<1　OR　POS(cal0$,cal$)>4　THEN　10
　LET　cvl1$=LEFT$(cval$,lprb)
　LET　cval(1)=Val(cvl1$)
　PLOT　TEXT　,AT　lprb,2　:　cal$
　LET　lin=2
　IF　cal$="/"　THEN
　　SET　TEXT　COLOR　0
　　PLOT　TEXT　,AT　lprb,2　:　cal$
　　SET　TEXT　COLOR　1
　　PLOT　TEXT　,AT　lprb,1　:")"
　　PLOT　LINES:lprb,0;　-1,0
　　LET　lin=1
　END　IF
　LET　cval$=prob$(lin,lprb,cal$)　　　!問題２行目
　IF　POS(cal0$,RIGHT$(cval$,1))<6　THEN　10　!"="の確認
　LET　cval$=LEFT$(cval$,LEN(cval$)-1)
　LET　cval(2)=Val(cval$)
　!
　IF　cal$<>"/"　THEN　PLOT　LINES:lprb,2;　-1,2　!答え
　LET　c=0
　IF　cal$="+"　THEN
　　LET　cval(3)=cval(1)+cval(2)
　　LET　d=lin-1
　ELSEIF　cal$="-"　THEN
　　LET　cval(3)=cval(1)-cval(2)
　　LET　d=lin-1
　ELSEIF　cal$="*"　THEN　　　　　!掛け算
　　LET　lc=LEN(cval$)
　　LET　cval(lc)=0
　　FOR　c=0　TO　lc-1
　　　LET　cval(3+c)=cval(1)*VAL(MID$(cval$,lc-c,1))
　　　LET　cval(lc+3)=cval(lc+3)+cval(3+c)*10^c
　　　LET　a$=LTRIM$(STR$(cval(3+c)))
　　　CALL　ans$(a$,c+3,c)
　　NEXT　c
　　LET　cval(3)=cval(lc+3)
　　LET　d=lin+lc+1
　ELSE
　　LET　lin=1
　　FOR　c=1　to　lprb　　　　　!割り算
　　　LET　d=lprb-c
　　　IF　cval(5)=0　THEN　LET　cval(3)=cval(3)*10+VAL(MID$(cvl1$,c,1))
　　　PRINT　cval(3)
　　　LET　jchr=INT(cval(3)/cval(2))
　　　LET　jchr$=LTRIM$(STR$(jchr))
　　　LET　hchr$=""
　　　PLOT　TEXT　,AT　d+0.3,0:　"□"

　　├続きです。 哲 2004/01/28 21:27:57  ツリーへ

Re: 筆算プログラム割り算にも対応しました。 返事を書く

哲 2004/01/28 21:27:57

続きです。
15　　CHARACTER　INPUT　CLEAR:ichr$
　　　SET　TEXT　COLOR　0
　　　PLOT　TEXT　,AT　d+0.3,0:　"□"　　!上書消去
　　　PLOT　TEXT,AT　d,0:hchr$
　　　PLOT　TEXT,AT　d,0:"X"
　　　SET　TEXT　COLOR　1
　　　PLOT　TEXT,AT　d,0:ichr$
　　　IF　ichr$<>jchr$　THEN
　　　SET　TEXT　COLOR　4
　　　PLOT　TEXT,AT　d,0:"X"
　　　SET　TEXT　COLOR　1
　　　LET　hchr$=ichr$
　　　GOTO　15
　　　END　IF
　　　LET　cval(5)=cval(5)*10+jchr
　　　IF　cval(5)=0　THEN
　　　SET　TEXT　COLOR　0
　　　PLOT　TEXT,AT　d,0:"0"
　　　SET　TEXT　COLOR　1
　　　END　IF
　　　IF　cval(5)=0　THEN　18
　　　LET　cval(4)=cval(2)*jchr
　　　LET　a$=LTRIM$(STR$(cval(4)))　!答え積
　　　LET　cval(3)=cval(3)-cval(4)
　　　CALL　ans$(a$,lin+1,d)
　　　IF　c+1>lprb　THEN
　　　LET　lin=lin+1
　　　LET　d=2
　　　EXIT　FOR
　　　END　IF
　　　LET　cval(3)=cval(3)*10+VAL(MID$(cvl1$,c+1,1))
　　　LET　a$=LTRIM$(STR$(cval(3)))　!次の桁
　　　PLOT　LINES:　d+2,lin+1;d-2,lin+1
　　　CALL　ans$(a$,lin+2,d-1)
　　　LET　lin=lin+2
18　NEXT　c
　END　IF
　!
　LET　lin=c+3
　PLOT　LINES:　d,lin-1;　-1,lin-1
　LET　a$=LTRIM$(STR$(cval(3)))
　CALL　ans$(a$,lin,0)
　SET　TEXT　COLOR　4
　PLOT　TEXT　,AT　7,9.5:"良くできました！"
　SET　TEXT　COLOR　1
　CHARACTER　INPUT　CLEAR:ichr$　
19　GOTO　10
　END
　!
　!
　EXTERNAL　FUNCTION　prob$(i,lprb,cal$)　!***問題***　i:行
　LET　num$="0123456789"
　LET　cal0$="+-*/="　&　chr$(13)
　LET　sif=0
　IF　cal$="/"　THEN　LET　sif=lprb+1
　FOR　c=1　to　6
　　CHARACTER　INPUT　CLEAR:ichr$
　　LET　nord=ORD(ichr$)
　　LET　n=POS(num$,ichr$)-1
　　LET　lcomp=LEN(comp$)
　　IF　n>-1　AND　lcomp<5　THEN
　　　LET　comp$=comp$　&　ichr$
　　　LET　hchr$=""
　　　FOR　d=1　TO　c
　　　SET　TEXT　COLOR　0
　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$　!上書消去
　　　SET　TEXT　COLOR　1
　　　LET　hchr$=MID$(comp$,d,1)
　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$
　　　NEXT　d
　　　IF　cal$<>"/"　THEN　PLOT　TEXT　,AT　lprb,2　:　cal$
　　ELSEIF　POS(cal0$,ichr$)>0　THEN
　　　LET　comp$=comp$　&　ichr$
　　　EXIT　FOR
　　ELSE
　　　LET　comp$="?"
　　　EXIT　FOR
　　END　IF
　NEXT　c
　LET　prob$=comp$
　END　FUNCTION
　!
　EXTERNAL　SUB　ans$(a$,lin,d)　!***答え***
　LET　ld=LEN(a$)
　FOR　c=1　to　ld
　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□"
20　CHARACTER　INPUT　CLEAR:ichr$
　　SET　TEXT　COLOR　0
　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□"　!上書消去
　　PLOT　TEXT　,AT　c+d-1,lin　:hchr$
　　PLOT　TEXT　,AT　c+d-1,lin　:"X"
　　SET　TEXT　COLOR　1
　　PLOT　TEXT　,AT　c+d-1,lin　:ichr$
　　IF　ichr$=MID$(a$,ld-c+1,1)　THEN　29
　　LET　hchr$=ichr$
　　SET　TEXT　COLOR　4
　　PLOT　TEXT　,AT　c+d-1,lin　:"X"
　　SET　TEXT　COLOR　1
　　GOTO　20
29　NEXT　c
　END　SUB　

　　└tetusann もりの 2004/01/28 22:54:48  ツリーへ

Re: 筆算プログラム割り算にも対応しました。 返事を書く

もりの 2004/01/28 22:54:48

tetusann

arigatou

sannnennseino
kyouzaideha
amariga
deru warizannwo

siteimasu

　　　└害虫駆除しましたのでこちらを使ってくださ... 哲 2004/01/29 14:57:24  ツリーへ

Re: tetusann 返事を書く

哲 2004/01/29 14:57:24

害虫駆除しましたのでこちらを使ってください。

!　　[筆算プログラム　for　十進ＢＡＳＩＣ]　040129
!
!数値と＋－*/＝またはEnterを入れて行けば計算確認できます。
!問題入力中は、どこでも不適切なキーを押すことで初期状態に戻ります。
!前処理の　txtsize=　で大きさを自由に変えてください。
!
!　cval:数値保存用配列　cal$:演算子　
!　ichr$:入力文字　hchr$,jchr$:一時保存文字　comp$:比較文字列
!
!　　　***前処理***
DECLARE　EXTERNAL　FUNCTION　prob$
DECLARE　EXTERNAL　SUB　ans$
SET　ECHO　"OFF"
LET　txtsize=32　　　　　　　　!!!　文字の大きさを変える
LET　width=(txtsize+5)*15
LET　height=(txtsize+5)*15
SET　BITMAP　SIZE　width,　height
SET　WINDOW　10,　-3,　10,　-3　　!座標系と桁、行を一致させる
SET　AREA　COLOR　0
SET　LINE　WIDTH　2
DIM　cval(8)
!
!　***メイン処理***
10　CLEAR
　　MAT　cval=ZER
　　LET　lin=1
　　LET　comp$=""
　　LET　lprb=0
　　LET　cal$=""
　　LET　cal0$="+-*/?="　&　chr$(13)
　　SET　TEXT　FONT　"ＭＳ　ゴシック",INT(txtsize/4*3)
　　PLOT　TEXT　,AT　9,-1.5　:　"5ケタまでのけいさん(＋－＊/＝)"
　　SET　TEXT　FONT　"ＭＳ　ゴシック",txtsize
　　LET　cval$=prob$(1,lprb,cal$)　　　　　　!問題１行目
　　LET　lprb=LEN(cval$)-1
　　LET　cal$=RIGHT$(cval$,1)
　　IF　lprb<1　OR　POS(cal0$,cal$)>4　THEN　10
　　LET　cvl1$=LEFT$(cval$,lprb)
　　LET　cval(1)=Val(cvl1$)
　　PLOT　TEXT　,AT　lprb,2　:　cal$
　　LET　lin=2
　　IF　cal$="/"　THEN
　　　SET　TEXT　COLOR　0
　　　PLOT　TEXT　,AT　lprb,2　:　cal$
　　　SET　TEXT　COLOR　1
　　　PLOT　TEXT　,AT　lprb,1　:")"
　　　PLOT　LINES:lprb,0;　-1,0
　　　LET　lin=1
　　END　IF
　　LET　cval$=prob$(lin,lprb,cal$)　　　　　!問題２行目
　　IF　POS(cal0$,RIGHT$(cval$,1))<6　THEN　10　!"="の確認
　　LET　cval$=LEFT$(cval$,LEN(cval$)-1)
　　LET　cval(2)=Val(cval$)

　　　　└つづき１ 哲 2004/01/29 14:58:39  ツリーへ

Re: 害虫駆除しましたのでこちらを使ってくださ... 返事を書く

哲 2004/01/29 14:58:39

つづき１
　　!
　　IF　cal$<>"/"　THEN　PLOT　LINES:lprb,2;　-1,2　　!答え
　　LET　c=0
　　IF　cal$="+"　THEN
　　　LET　cval(3)=cval(1)+cval(2)
　　　LET　d=MAX(lin-1,LEN(cval$))
　　ELSEIF　cal$="-"　THEN
　　　LET　cval(3)=cval(1)-cval(2)
　　　LET　d=MAX(lin-1,LEN(cval$))
　　ELSEIF　cal$="*"　THEN　　　　　　　　　!掛け算
　　　LET　lc=LEN(cval$)
　　　LET　cval(lc)=0
　　　FOR　c=0　TO　lc-1
　　　　　LET　cval(3+c)=cval(1)*VAL(MID$(cval$,lc-c,1))
　　　　　LET　cval(lc+3)=cval(lc+3)+cval(3+c)*10^c
　　　　　LET　a$=LTRIM$(STR$(cval(3+c)))
　　　　　CALL　ans$(a$,c+3,c)
　　　NEXT　c
　　　LET　cval(3)=cval(lc+3)
　　　LET　d=lprb+c-1
　　ELSE
　　　LET　lin=1
　　　FOR　c=1　to　lprb　　　　　　　　　!割り算
　　　　　LET　d=lprb-c
　　　　　IF　cval(5)=0　THEN　LET　cval(3)=cval(3)*10+VAL(MID$(cvl1$,c,1))
　　　　　LET　jchr=INT(cval(3)/cval(2))
　　　　　LET　jchr$=LTRIM$(STR$(jchr))
　　　　　LET　hchr$=""
　　　　　PLOT　TEXT　,AT　d+0.3,0:　"□"
15　　　　CHARACTER　INPUT　CLEAR:ichr$
　　　　　SET　TEXT　COLOR　0
　　　　　PLOT　TEXT　,AT　d+0.3,0:　"□"　　　!上書消去
　　　　　PLOT　TEXT,AT　d,0:hchr$
　　　　　PLOT　TEXT,AT　d,0:"X"
　　　　　SET　TEXT　COLOR　1
　　　　　PLOT　TEXT,AT　d,0:ichr$
　　　　　IF　ichr$<>jchr$　THEN
　　　　　　SET　TEXT　COLOR　4
　　　　　　PLOT　TEXT,AT　d,0:"X"
　　　　　　SET　TEXT　COLOR　1
　　　　　　LET　hchr$=ichr$
　　　　　　GOTO　15
　　　　　END　IF
　　　　　LET　cval(5)=cval(5)*10+jchr
　　　　　IF　cval(5)=0　THEN
　　　　　　SET　TEXT　COLOR　0
　　　　　　PLOT　TEXT,AT　d,0:"0"
　　　　　　SET　TEXT　COLOR　1
　　　　　END　IF
　　　　　IF　cval(5)=0　THEN　18
　　　　　LET　cval(4)=cval(2)*jchr
　　　　　LET　a$=LTRIM$(STR$(cval(4)))　　!答え積
　　　　　LET　cval(3)=cval(3)-cval(4)
　　　　　LET　lin=lin+1
　　　　　CALL　ans$(a$,lin,d)
　　　　　IF　c+1>lprb　THEN
　　　　　　LET　d=2
　　　　　　LET　lin=lin-2
　　　　　　EXIT　FOR
　　　　　END　IF
　　　　　LET　cval(3)=cval(3)*10+VAL(MID$(cvl1$,c+1,1))
　　　　　LET　a$=LTRIM$(STR$(cval(3)))　　!次の桁
　　　　　PLOT　LINES:　d+2,lin;d-2,lin
　　　　　LET　lin=lin+1
　　　　　CALL　ans$(a$,lin,d-1)
18　　NEXT　c
　　　LET　lin=lin+2
　　END　IF
　　!
　　IF　cal$="*"　THEN　LET　lin=lin+c
　　PLOT　LINES:　d,lin;　-1,lin
　　LET　a$=LTRIM$(STR$(cval(3)))
　　CALL　ans$(a$,lin+1,0)
　　SET　TEXT　COLOR　4
　　PLOT　TEXT　,AT　7,9.5:"良くできました！"
　　SET　TEXT　COLOR　1
　　CHARACTER　INPUT　CLEAR:ichr$　　
19　GOTO　10
　　END

　　　　　└つづき２ 哲 2004/01/29 14:59:34  ツリーへ

Re: つづき１ 返事を書く

哲 2004/01/29 14:59:34

つづき２
　　!
　　!
　　EXTERNAL　FUNCTION　prob$(i,lprb,cal$)　　!***問題***　i:行
　　LET　num$="0123456789"
　　LET　cal0$="+-*/="　&　chr$(13)
　　LET　sif=0
　　IF　cal$="/"　THEN　LET　sif=lprb+1
　　FOR　c=1　to　6
　　　CHARACTER　INPUT　CLEAR:ichr$
　　　LET　nord=ORD(ichr$)
　　　LET　n=POS(num$,ichr$)-1
　　　LET　lcomp=LEN(comp$)
　　　IF　n>-1　AND　lcomp<5　THEN
　　　　　LET　comp$=comp$　&　ichr$
　　　　　LET　hchr$=""
　　　　　FOR　d=1　TO　c
　　　　　　SET　TEXT　COLOR　0
　　　　　　IF　cal$<>"/"　AND　d=1　THEN　PLOT　TEXT,AT　lprb,2:cal$
　　　　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$　　!上書消去
　　　　　　SET　TEXT　COLOR　1
　　　　　　LET　hchr$=MID$(comp$,d,1)
　　　　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$
　　　　　NEXT　d
　　　　　IF　c>lprb　THEN　LET　lprb=c
　　　　　IF　cal$<>"/"　THEN　PLOT　TEXT,AT　lprb,2:cal$
　　　ELSEIF　POS(cal0$,ichr$)>0　THEN
　　　　　LET　comp$=comp$　&　ichr$
　　　　　EXIT　FOR
　　　ELSE
　　　　　LET　comp$="?"
　　　　　EXIT　FOR
　　　END　IF
　　NEXT　c
　　LET　prob$=comp$
　　END　FUNCTION
　　!
　　EXTERNAL　SUB　ans$(a$,lin,d)　　!***答え***
　　LET　ld=LEN(a$)
　　FOR　c=1　to　ld
　　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□"
20　　CHARACTER　INPUT　CLEAR:ichr$
　　　SET　TEXT　COLOR　0
　　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□"　!上書消去
　　　PLOT　TEXT　,AT　c+d-1,lin　:hchr$
　　　PLOT　TEXT　,AT　c+d-1,lin　:"X"
　　　SET　TEXT　COLOR　1
　　　PLOT　TEXT　,AT　c+d-1,lin　:ichr$
　　　IF　ichr$=MID$(a$,ld-c+1,1)　THEN　29
　　　LET　hchr$=ichr$
　　　SET　TEXT　COLOR　4
　　　PLOT　TEXT　,AT　c+d-1,lin　:"X"
　　　SET　TEXT　COLOR　1
　　　GOTO　20
29　NEXT　c
　　END　SUB

　　　　　　└１箇所修正してください。 哲 2004/01/29 16:56:39  ツリーへ

Re: つづき２ 返事を書く

哲 2004/01/29 16:56:39

１箇所修正してください。

ELSEIF cal$="*" THEN !掛け算
LET lc=LEN(cval$)
FOR c=0 TO lc-1
LET cval(3+c)=cval(1)*VAL(MID$(cval$,lc-c,1))
LET cval(lc+3)=cval(lc+3)+cval(3+c)*10^c
IF lc=1 THEN EXIT FOR　　　　　　　　　＊＊＊この１行を追加＊＊＊
LET a$=LTRIM$(STR$(cval(3+c)))
CALL ans$(a$,c+3,c)
NEXT c
LET cval(3)=cval(lc+3)
LET d=lprb+c-1

修正しないと、掛ける数が１桁のとき問題が発生します。

　　　　　　　└哲さん もりの 2004/01/29 19:23:27  ツリーへ

Re: １箇所修正してください。 返事を書く

もりの 2004/01/29 19:23:27

哲さん
最終的にしあがったプログラム全体をここに
アップしていただけますか？
まだいちども動いていないんです。
せっかく作ってくれたので
つかいたいんですが

　　　　　　　　└IEのバージョンが古かったので新しいもので... 哲 2004/01/29 19:56:53  ツリーへ

Re: 哲さん 返事を書く

哲 2004/01/29 19:56:53

IEのバージョンが古かったので新しいもので書き込んでみます。
!　　[筆算プログラム　for　十進ＢＡＳＩＣ]　040129
!
!数値と＋－*/＝またはEnterを入れて行けば計算確認できます。
!問題入力中は、どこでも不適切なキーを押すことで初期状態に戻ります。
!前処理の　txtsize=　で大きさを自由に変えてください。
!
!　cval:数値保存用配列　cal$:演算子　
!　ichr$:入力文字　hchr$,jchr$:一時保存文字　comp$:比較文字列
!
!　　　***前処理***
DECLARE　EXTERNAL　FUNCTION　prob$
DECLARE　EXTERNAL　SUB　ans$
SET　ECHO　"OFF"
LET　txtsize=32　　　　　　　　!!!　文字の大きさを変える
LET　width=(txtsize+5)*15
LET　height=(txtsize+5)*15
SET　BITMAP　SIZE　width,　height
SET　WINDOW　10,　-3,　10,　-3　　!座標系と桁、行を一致させる
SET　AREA　COLOR　0
SET　LINE　WIDTH　2
DIM　cval(8)
!
!　***メイン処理***
10　CLEAR
　　MAT　cval=ZER
　　LET　lin=1
　　LET　comp$=""
　　LET　lprb=0
　　LET　cal$=""
　　LET　cal0$="+-*/?="　&　chr$(13)
　　SET　TEXT　FONT　"ＭＳ　ゴシック",INT(txtsize/4*3)
　　PLOT　TEXT　,AT　9,-1.5　:　"5ケタまでのけいさん(＋－＊/＝)"
　　SET　TEXT　FONT　"ＭＳ　ゴシック",txtsize
　　LET　cval$=prob$(1,lprb,cal$)　　　　　　!問題１行目
　　LET　lprb=LEN(cval$)-1
　　LET　cal$=RIGHT$(cval$,1)
　　IF　lprb<1　OR　POS(cal0$,cal$)>4　THEN　10
　　LET　cvl1$=LEFT$(cval$,lprb)
　　LET　cval(1)=Val(cvl1$)
　　PLOT　TEXT　,AT　lprb,2　:　cal$
　　LET　lin=2
　　IF　cal$="/"　THEN
　　　SET　TEXT　COLOR　0
　　　PLOT　TEXT　,AT　lprb,2　:　cal$
　　　SET　TEXT　COLOR　1
　　　PLOT　TEXT　,AT　lprb,1　:")"
　　　PLOT　LINES:lprb,0;　-1,0
　　　LET　lin=1
　　END　IF
　　LET　cval$=prob$(lin,lprb,cal$)　　　　　!問題２行目
　　IF　POS(cal0$,RIGHT$(cval$,1))<6　THEN　10　!"="の確認
　　LET　cval$=LEFT$(cval$,LEN(cval$)-1)
　　LET　cval(2)=Val(cval$)

　　　　　　　　　└続き１ 哲 2004/01/29 19:59:21  ツリーへ

Re: IEのバージョンが古かったので新しいもので... 返事を書く

哲 2004/01/29 19:59:21

続き１
　　!
　　IF　cal$<>"/"　THEN　PLOT　LINES:lprb,2;　-1,2　　!答え
　　LET　c=0
　　IF　cal$="+"　THEN
　　　LET　cval(3)=cval(1)+cval(2)
　　　LET　d=MAX(lin-1,LEN(cval$))
　　ELSEIF　cal$="-"　THEN
　　　LET　cval(3)=cval(1)-cval(2)
　　　LET　d=MAX(lin-1,LEN(cval$))
　　ELSEIF　cal$="*"　THEN　　　　　　　　　!掛け算
　　　LET　lc=LEN(cval$)
　　　FOR　c=0　TO　lc-1
　　　　　LET　cval(3+c)=cval(1)*VAL(MID$(cval$,lc-c,1))
　　　　　LET　cval(lc+3)=cval(lc+3)+cval(3+c)*10^c
　　　　　IF　lc=1　THEN　EXIT　FOR
　　　　　LET　a$=LTRIM$(STR$(cval(3+c)))
　　　　　CALL　ans$(a$,c+3,c)
　　　NEXT　c
　　　LET　cval(3)=cval(lc+3)
　　　LET　d=lprb+c-1
　　ELSE
　　　LET　lin=1
　　　FOR　c=1　to　lprb　　　　　　　　　!割り算
　　　　　LET　d=lprb-c
　　　　　IF　cval(5)=0　THEN　LET　cval(3)=cval(3)*10+VAL(MID$(cvl1$,c,1))
　　　　　LET　jchr=INT(cval(3)/cval(2))
　　　　　LET　jchr$=LTRIM$(STR$(jchr))
　　　　　LET　hchr$=""
　　　　　PLOT　TEXT　,AT　d+0.3,0:　"□"
15　　　　CHARACTER　INPUT　CLEAR:ichr$
　　　　　SET　TEXT　COLOR　0
　　　　　PLOT　TEXT　,AT　d+0.3,0:　"□"　　　!上書消去
　　　　　PLOT　TEXT,AT　d,0:hchr$
　　　　　PLOT　TEXT,AT　d,0:"X"
　　　　　SET　TEXT　COLOR　1
　　　　　PLOT　TEXT,AT　d,0:ichr$
　　　　　IF　ichr$<>jchr$　THEN
　　　　　　SET　TEXT　COLOR　4
　　　　　　PLOT　TEXT,AT　d,0:"X"
　　　　　　SET　TEXT　COLOR　1
　　　　　　LET　hchr$=ichr$
　　　　　　GOTO　15
　　　　　END　IF
　　　　　LET　cval(5)=cval(5)*10+jchr
　　　　　IF　cval(5)=0　THEN
　　　　　　SET　TEXT　COLOR　0
　　　　　　PLOT　TEXT,AT　d,0:"0"
　　　　　　SET　TEXT　COLOR　1
　　　　　END　IF
　　　　　IF　cval(5)=0　THEN　18
　　　　　LET　cval(4)=cval(2)*jchr
　　　　　LET　a$=LTRIM$(STR$(cval(4)))　　!答え積
　　　　　LET　cval(3)=cval(3)-cval(4)
　　　　　LET　lin=lin+1
　　　　　CALL　ans$(a$,lin,d)
　　　　　IF　c+1>lprb　THEN
　　　　　　LET　d=2
　　　　　　LET　lin=lin-2
　　　　　　EXIT　FOR
　　　　　END　IF
　　　　　LET　cval(3)=cval(3)*10+VAL(MID$(cvl1$,c+1,1))
　　　　　LET　a$=LTRIM$(STR$(cval(3)))　　!次の桁
　　　　　PLOT　LINES:　d+2,lin;d-2,lin
　　　　　LET　lin=lin+1
　　　　　CALL　ans$(a$,lin,d-1)
18　　NEXT　c
　　　LET　lin=lin+2
　　END　IF
　　!
　　IF　cal$="*"　THEN　LET　lin=lin+c
　　PLOT　LINES:　d,lin;　-1,lin
　　LET　a$=LTRIM$(STR$(cval(3)))
　　CALL　ans$(a$,lin+1,0)
　　SET　TEXT　COLOR　4
　　PLOT　TEXT　,AT　7,9.5:"良くできました！"
　　SET　TEXT　COLOR　1
　　CHARACTER　INPUT　CLEAR:ichr$　　
19　GOTO　10
　　END
　　!

　　　　　　　　　　└続き２ 哲 2004/01/29 20:00:23  ツリーへ

Re: 続き１ 返事を書く

哲 2004/01/29 20:00:23

続き２

　　EXTERNAL　FUNCTION　prob$(i,lprb,cal$)　　!***問題***　i:行
　　LET　num$="0123456789"
　　LET　cal0$="+-*/="　&　chr$(13)
　　LET　sif=0
　　IF　cal$="/"　THEN　LET　sif=lprb+1
　　FOR　c=1　to　6
　　　CHARACTER　INPUT　CLEAR:ichr$
　　　LET　nord=ORD(ichr$)
　　　LET　n=POS(num$,ichr$)-1
　　　LET　lcomp=LEN(comp$)
　　　IF　n>-1　AND　lcomp<5　THEN
　　　　　LET　comp$=comp$　&　ichr$
　　　　　LET　hchr$=""
　　　　　FOR　d=1　TO　c
　　　　　　SET　TEXT　COLOR　0
　　　　　　IF　cal$<>"/"　AND　d=1　THEN　PLOT　TEXT,AT　lprb,2:cal$
　　　　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$　　!上書消去
　　　　　　SET　TEXT　COLOR　1
　　　　　　LET　hchr$=MID$(comp$,d,1)
　　　　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$
　　　　　NEXT　d
　　　　　IF　c>lprb　THEN　LET　lprb=c
　　　　　IF　cal$<>"/"　THEN　PLOT　TEXT,AT　lprb,2:cal$
　　　ELSEIF　POS(cal0$,ichr$)>0　THEN
　　　　　LET　comp$=comp$　&　ichr$
　　　　　EXIT　FOR
　　　ELSE
　　　　　LET　comp$="?"
　　　　　EXIT　FOR
　　　END　IF
　　NEXT　c
　　LET　prob$=comp$
　　END　FUNCTION
　　!
　　EXTERNAL　SUB　ans$(a$,lin,d)　　!***答え***
　　LET　ld=LEN(a$)
　　FOR　c=1　to　ld
　　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□"
20　　CHARACTER　INPUT　CLEAR:ichr$
　　　SET　TEXT　COLOR　0
　　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□"　!上書消去
　　　PLOT　TEXT　,AT　c+d-1,lin　:hchr$
　　　PLOT　TEXT　,AT　c+d-1,lin　:"X"
　　　SET　TEXT　COLOR　1
　　　PLOT　TEXT　,AT　c+d-1,lin　:ichr$
　　　IF　ichr$=MID$(a$,ld-c+1,1)　THEN　29
　　　LET　hchr$=ichr$
　　　SET　TEXT　COLOR　4
　　　PLOT　TEXT　,AT　c+d-1,lin　:"X"
　　　SET　TEXT　COLOR　1
　　　GOTO　20
29　NEXT　c
　　END　SUB

　　　　　　　　　　　├どうも全角に変換すると化けるようなので、... 哲 2004/01/29 20:42:11  ツリーへ

Re: 続き２ 返事を書く

哲 2004/01/29 20:42:11

どうも全角に変換すると化けるようなので、そのままUPして見ます。

　　　　　　　　　　　│└ここで書けなくなちゃいました。 哲 2004/01/29 21:07:18  ツリーへ

Re: どうも全角に変換すると化けるようなので、... 返事を書く

哲 2004/01/29 21:07:18

ここで書けなくなちゃいました。
メールアドレスを教えてくださるならメールで送ります。

　　　　　　　　　　　│　└メルアドは もりの 2004/01/29 21:17:55  ツリーへ

Re: ここで書けなくなちゃいました。 返事を書く

もりの 2004/01/29 21:17:55

メルアドは

stdoor24_12@hotmail.com

です
よろしく

さっき動きましたが
最初のタイトルが文字化けしている事
カケルはやはり　×　でないとだけですね
あと正解したあと
赤丸が表示されません

間違いの数字には赤いレテンが必要です

ｙａｈｏｏのコンピュータの
コンテンツの中のフリーの
筆算ソフトを今つかっています
参考までに今みてください

算数・英語の
ところにあります

　　　　　　　　　　　│　　└筆算ソフトっていっぱいあってよく解りませ... 哲 2004/01/29 22:05:41  ツリーへ

Re: メルアドは 返事を書く

哲 2004/01/29 22:05:41

筆算ソフトっていっぱいあってよく解りません。
カケルを　×　にするって全角になりますからそう簡単にはできません。
やはり現場の人が改善しながら自分で少しづつ作り上げて行かないと、本当に良いものはできないと思います。
もともと十進BASICでも、ここまでできますと言うことを知ってもらいたかったのですから、論文にまで含めるのであれば自分で改良を加えてください。

　　　　　　　　　　　│　　　└私もＮ８８の本はくさるほど もりの 2004/01/29 23:59:03  ツリーへ

Re: 筆算ソフトっていっぱいあってよく解りませ... 返事を書く

もりの 2004/01/29 23:59:03

私もＮ８８の本はくさるほど
もっていますが
十進ＢＡＳＩＣでどこまで
できるか
知りたかったんですよ
でこまでできるか
挑戦してみて
ほしいな＾＾

　　　　　　　　　　　│　　　　└私はN88BASICは使ったことがありません。 哲 2004/01/30 08:39:18  ツリーへ

Re: 私もＮ８８の本はくさるほど 返事を書く

哲 2004/01/30 08:39:18

私はN88BASICは使ったことがありません。
十進BASICはインタープリタですから、このプログラムを完成品のソフトとして使うには不適当です。
その場でいろいろ条件を変えて実行するには非常に便利ですが、
間違ってエディターにフォーカスが移ってキー入力してしまうと、すぐに動かなくなります。
ただ現場で使うだけの目的ならコンパイラで実行ファイルで使えるようにする必要があるでしょう。

　　　　　　　　　　　└＊文字化けの対策＊ 哲 2004/01/31 00:34:38  ツリーへ

Re: 続き２ 返事を書く

哲 2004/01/31 00:34:38

＊　文字化けの対策　＊
この掲示板からコピーして実行すると、全角スペースを半角スペースに変換してくれますが、このとき問題が起きます。
MS ゴシック　の間が半角スペース１個になるように書き換えて実行してください。

　　　　　　　　　　　　├自動採点の赤丸 もりの 2004/01/31 09:08:26  ツリーへ

Re: ＊文字化けの対策＊ 返事を書く

もりの 2004/01/31 09:08:26

自動採点の赤丸
ありがとう

　　　　　　　　　　　　└＊表示色の変更＊ 哲 2004/02/02 14:04:56  ツリーへ

Re: ＊文字化けの対策＊ 返事を書く

哲 2004/02/02 14:04:56

＊表示色の変更＊
目にやさしい色に改善するために前処理の部分を書き換えて見ました。
!　　　***前処理***
DECLARE EXTERNAL FUNCTION prob$
DECLARE EXTERNAL SUB ans$
SET ECHO "OFF"
LET txtsize=34　　　　　　　　!!! 文字の大きさを変える
LET width=(txtsize+5)*15
LET height=(txtsize+5)*15
SET BITMAP SIZE width, height
SET WINDOW 10, -3, 10, -3　　!座標系と桁、行を一致させる
SET COLOR MIX(0)0,0.4,0　　!背景色緑
SET COLOR MIX(1)1,1,1　　　!文字色白
SET AREA COLOR 0
DIM cval(8)

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

筆算プログラム割り算にも対応しました。	返事を書く
哲 2004/01/28 21:25:20
中途半端なので、何とか割り算にも対応しました。入力エラーチェックは十分でないかも知れませんが、こんなもんで良かったら、修正するなり改造するなりして勝手に使ってください。 !　[筆算プログラム　for　十進ＢＡＳＩＣ] ! !数値と＋－/＝またはEnterを入れて行けば計算確認できます。 !問題入力中は、どこでも不適切なキーを押すことで初期状態に戻ります。 !前処理の　txtsize=　で大きさを自由に変えてください。 ! !　cval:数値保存用配列　cal$:演算子　 !　ichr$:入力文字　hchr$,jchr$:一時保存文字　comp$:比較文字列 ! !　　前処理* DECLARE　EXTERNAL　FUNCTION　prob$ DECLARE　EXTERNAL　SUB　ans$ SET　ECHO　"OFF" LET　txtsize=32　　　　!!!　文字の大きさを変える LET　width=(txtsize+5)15 LET　height=(txtsize+5)15 SET　BITMAP　SIZE　width,　height SET　WINDOW　10,　-3,　10,　-3　!座標系と桁、行を一致させる SET　AREA　COLOR　0 SET　LINE　WIDTH　2 DIM　cval(8) ! !　*メイン処理* 10　CLEAR 　MAT　cval=ZER 　LET　lin=1 　LET　comp$="" 　LET　lprb=0 　LET　cal$="" 　LET　cal0$="+-/?="　&　chr$(13) 　SET　TEXT　FONT　"ＭＳ　ゴシック",INT(txtsize/43) 　PLOT　TEXT　,AT　9,-1.5　:　"5ケタまでのけいさん(＋－＊/＝)" 　SET　TEXT　FONT　"ＭＳ　ゴシック",txtsize 　LET　cval$=prob$(1,lprb,cal$)　　　!問題１行目　LET　lprb=LEN(cval$)-1 　LET　cal$=RIGHT$(cval$,1) 　IF　lprb<1　OR　POS(cal0$,cal$)>4　THEN　10 　LET　cvl1$=LEFT$(cval$,lprb) 　LET　cval(1)=Val(cvl1$) 　PLOT　TEXT　,AT　lprb,2　:　cal$ 　LET　lin=2 　IF　cal$="/"　THEN 　　SET　TEXT　COLOR　0 　　PLOT　TEXT　,AT　lprb,2　:　cal$ 　　SET　TEXT　COLOR　1 　　PLOT　TEXT　,AT　lprb,1　:")" 　　PLOT　LINES:lprb,0;　-1,0 　　LET　lin=1 　END　IF 　LET　cval$=prob$(lin,lprb,cal$)　　　!問題２行目　IF　POS(cal0$,RIGHT$(cval$,1))<6　THEN　10　!"="の確認　LET　cval$=LEFT$(cval$,LEN(cval$)-1) 　LET　cval(2)=Val(cval$) 　! 　IF　cal$<>"/"　THEN　PLOT　LINES:lprb,2;　-1,2　!答え　LET　c=0 　IF　cal$="+"　THEN 　　LET　cval(3)=cval(1)+cval(2) 　　LET　d=lin-1 　ELSEIF　cal$="-"　THEN 　　LET　cval(3)=cval(1)-cval(2) 　　LET　d=lin-1 　ELSEIF　cal$=""　THEN　　　　　!掛け算　　LET　lc=LEN(cval$) 　　LET　cval(lc)=0 　　FOR　c=0　TO　lc-1 　　　LET　cval(3+c)=cval(1)VAL(MID$(cval$,lc-c,1)) 　　　LET　cval(lc+3)=cval(lc+3)+cval(3+c)10^c 　　　LET　a$=LTRIM$(STR$(cval(3+c))) 　　　CALL　ans$(a$,c+3,c) 　　NEXT　c 　　LET　cval(3)=cval(lc+3) 　　LET　d=lin+lc+1 　ELSE 　　LET　lin=1 　　FOR　c=1　to　lprb　　　　　!割り算　　　LET　d=lprb-c 　　　IF　cval(5)=0　THEN　LET　cval(3)=cval(3)10+VAL(MID$(cvl1$,c,1)) 　　　PRINT　cval(3) 　　　LET　jchr=INT(cval(3)/cval(2)) 　　　LET　jchr$=LTRIM$(STR$(jchr)) 　　　LET　hchr$="" 　　　PLOT　TEXT　,AT　d+0.3,0:　"□"

Re: 筆算プログラム割り算にも対応しました。	返事を書く
哲 2004/01/28 21:27:57
続きです。 15　　CHARACTER　INPUT　CLEAR:ichr$ 　　　SET　TEXT　COLOR　0 　　　PLOT　TEXT　,AT　d+0.3,0:　"□"　　!上書消去　　　PLOT　TEXT,AT　d,0:hchr$ 　　　PLOT　TEXT,AT　d,0:"X" 　　　SET　TEXT　COLOR　1 　　　PLOT　TEXT,AT　d,0:ichr$ 　　　IF　ichr$<>jchr$　THEN 　　　SET　TEXT　COLOR　4 　　　PLOT　TEXT,AT　d,0:"X" 　　　SET　TEXT　COLOR　1 　　　LET　hchr$=ichr$ 　　　GOTO　15 　　　END　IF 　　　LET　cval(5)=cval(5)10+jchr 　　　IF　cval(5)=0　THEN 　　　SET　TEXT　COLOR　0 　　　PLOT　TEXT,AT　d,0:"0" 　　　SET　TEXT　COLOR　1 　　　END　IF 　　　IF　cval(5)=0　THEN　18 　　　LET　cval(4)=cval(2)jchr 　　　LET　a$=LTRIM$(STR$(cval(4)))　!答え積　　　LET　cval(3)=cval(3)-cval(4) 　　　CALL　ans$(a$,lin+1,d) 　　　IF　c+1>lprb　THEN 　　　LET　lin=lin+1 　　　LET　d=2 　　　EXIT　FOR 　　　END　IF 　　　LET　cval(3)=cval(3)10+VAL(MID$(cvl1$,c+1,1)) 　　　LET　a$=LTRIM$(STR$(cval(3)))　!次の桁　　　PLOT　LINES:　d+2,lin+1;d-2,lin+1 　　　CALL　ans$(a$,lin+2,d-1) 　　　LET　lin=lin+2 18　NEXT　c 　END　IF 　! 　LET　lin=c+3 　PLOT　LINES:　d,lin-1;　-1,lin-1 　LET　a$=LTRIM$(STR$(cval(3))) 　CALL　ans$(a$,lin,0) 　SET　TEXT　COLOR　4 　PLOT　TEXT　,AT　7,9.5:"良くできました！" 　SET　TEXT　COLOR　1 　CHARACTER　INPUT　CLEAR:ichr$　 19　GOTO　10 　END 　! 　! 　EXTERNAL　FUNCTION　prob$(i,lprb,cal$)　!問題*　i:行　LET　num$="0123456789" 　LET　cal0$="+-/="　&　chr$(13) 　LET　sif=0 　IF　cal$="/"　THEN　LET　sif=lprb+1 　FOR　c=1　to　6 　　CHARACTER　INPUT　CLEAR:ichr$ 　　LET　nord=ORD(ichr$) 　　LET　n=POS(num$,ichr$)-1 　　LET　lcomp=LEN(comp$) 　　IF　n>-1　AND　lcomp<5　THEN 　　　LET　comp$=comp$　&　ichr$ 　　　LET　hchr$="" 　　　FOR　d=1　TO　c 　　　SET　TEXT　COLOR　0 　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$　!上書消去　　　SET　TEXT　COLOR　1 　　　LET　hchr$=MID$(comp$,d,1) 　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$ 　　　NEXT　d 　　　IF　cal$<>"/"　THEN　PLOT　TEXT　,AT　lprb,2　:　cal$ 　　ELSEIF　POS(cal0$,ichr$)>0　THEN 　　　LET　comp$=comp$　&　ichr$ 　　　EXIT　FOR 　　ELSE 　　　LET　comp$="?" 　　　EXIT　FOR 　　END　IF 　NEXT　c 　LET　prob$=comp$ 　END　FUNCTION 　! 　EXTERNAL　SUB　ans$(a$,lin,d)　!答え* 　LET　ld=LEN(a$) 　FOR　c=1　to　ld 　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□" 20　CHARACTER　INPUT　CLEAR:ichr$ 　　SET　TEXT　COLOR　0 　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□"　!上書消去　　PLOT　TEXT　,AT　c+d-1,lin　:hchr$ 　　PLOT　TEXT　,AT　c+d-1,lin　:"X" 　　SET　TEXT　COLOR　1 　　PLOT　TEXT　,AT　c+d-1,lin　:ichr$ 　　IF　ichr$=MID$(a$,ld-c+1,1)　THEN　29 　　LET　hchr$=ichr$ 　　SET　TEXT　COLOR　4 　　PLOT　TEXT　,AT　c+d-1,lin　:"X" 　　SET　TEXT　COLOR　1 　　GOTO　20 29　NEXT　c 　END　SUB

Re: 筆算プログラム割り算にも対応しました。	返事を書く
もりの 2004/01/28 22:54:48
tetusann arigatou sannnennseino kyouzaideha amariga deru warizannwo siteimasu

Re: tetusann	返事を書く
哲 2004/01/29 14:57:24
害虫駆除しましたのでこちらを使ってください。 !　　[筆算プログラム　for　十進ＢＡＳＩＣ]　040129 ! !数値と＋－/＝またはEnterを入れて行けば計算確認できます。 !問題入力中は、どこでも不適切なキーを押すことで初期状態に戻ります。 !前処理の　txtsize=　で大きさを自由に変えてください。 ! !　cval:数値保存用配列　cal$:演算子　 !　ichr$:入力文字　hchr$,jchr$:一時保存文字　comp$:比較文字列 ! !　　　前処理* DECLARE　EXTERNAL　FUNCTION　prob$ DECLARE　EXTERNAL　SUB　ans$ SET　ECHO　"OFF" LET　txtsize=32　　　　　　　　!!!　文字の大きさを変える LET　width=(txtsize+5)15 LET　height=(txtsize+5)15 SET　BITMAP　SIZE　width,　height SET　WINDOW　10,　-3,　10,　-3　　!座標系と桁、行を一致させる SET　AREA　COLOR　0 SET　LINE　WIDTH　2 DIM　cval(8) ! !　*メイン処理* 10　CLEAR 　　MAT　cval=ZER 　　LET　lin=1 　　LET　comp$="" 　　LET　lprb=0 　　LET　cal$="" 　　LET　cal0$="+-/?="　&　chr$(13) 　　SET　TEXT　FONT　"ＭＳ　ゴシック",INT(txtsize/43) 　　PLOT　TEXT　,AT　9,-1.5　:　"5ケタまでのけいさん(＋－＊/＝)" 　　SET　TEXT　FONT　"ＭＳ　ゴシック",txtsize 　　LET　cval$=prob$(1,lprb,cal$)　　　　　　!問題１行目　　LET　lprb=LEN(cval$)-1 　　LET　cal$=RIGHT$(cval$,1) 　　IF　lprb<1　OR　POS(cal0$,cal$)>4　THEN　10 　　LET　cvl1$=LEFT$(cval$,lprb) 　　LET　cval(1)=Val(cvl1$) 　　PLOT　TEXT　,AT　lprb,2　:　cal$ 　　LET　lin=2 　　IF　cal$="/"　THEN 　　　SET　TEXT　COLOR　0 　　　PLOT　TEXT　,AT　lprb,2　:　cal$ 　　　SET　TEXT　COLOR　1 　　　PLOT　TEXT　,AT　lprb,1　:")" 　　　PLOT　LINES:lprb,0;　-1,0 　　　LET　lin=1 　　END　IF 　　LET　cval$=prob$(lin,lprb,cal$)　　　　　!問題２行目　　IF　POS(cal0$,RIGHT$(cval$,1))<6　THEN　10　!"="の確認　　LET　cval$=LEFT$(cval$,LEN(cval$)-1) 　　LET　cval(2)=Val(cval$)

Re: 害虫駆除しましたのでこちらを使ってくださ...	返事を書く
哲 2004/01/29 14:58:39
つづき１　　! 　　IF　cal$<>"/"　THEN　PLOT　LINES:lprb,2;　-1,2　　!答え　　LET　c=0 　　IF　cal$="+"　THEN 　　　LET　cval(3)=cval(1)+cval(2) 　　　LET　d=MAX(lin-1,LEN(cval$)) 　　ELSEIF　cal$="-"　THEN 　　　LET　cval(3)=cval(1)-cval(2) 　　　LET　d=MAX(lin-1,LEN(cval$)) 　　ELSEIF　cal$=""　THEN　　　　　　　　　!掛け算　　　LET　lc=LEN(cval$) 　　　LET　cval(lc)=0 　　　FOR　c=0　TO　lc-1 　　　　　LET　cval(3+c)=cval(1)VAL(MID$(cval$,lc-c,1)) 　　　　　LET　cval(lc+3)=cval(lc+3)+cval(3+c)10^c 　　　　　LET　a$=LTRIM$(STR$(cval(3+c))) 　　　　　CALL　ans$(a$,c+3,c) 　　　NEXT　c 　　　LET　cval(3)=cval(lc+3) 　　　LET　d=lprb+c-1 　　ELSE 　　　LET　lin=1 　　　FOR　c=1　to　lprb　　　　　　　　　!割り算　　　　　LET　d=lprb-c 　　　　　IF　cval(5)=0　THEN　LET　cval(3)=cval(3)10+VAL(MID$(cvl1$,c,1)) 　　　　　LET　jchr=INT(cval(3)/cval(2)) 　　　　　LET　jchr$=LTRIM$(STR$(jchr)) 　　　　　LET　hchr$="" 　　　　　PLOT　TEXT　,AT　d+0.3,0:　"□" 15　　　　CHARACTER　INPUT　CLEAR:ichr$ 　　　　　SET　TEXT　COLOR　0 　　　　　PLOT　TEXT　,AT　d+0.3,0:　"□"　　　!上書消去　　　　　PLOT　TEXT,AT　d,0:hchr$ 　　　　　PLOT　TEXT,AT　d,0:"X" 　　　　　SET　TEXT　COLOR　1 　　　　　PLOT　TEXT,AT　d,0:ichr$ 　　　　　IF　ichr$<>jchr$　THEN 　　　　　　SET　TEXT　COLOR　4 　　　　　　PLOT　TEXT,AT　d,0:"X" 　　　　　　SET　TEXT　COLOR　1 　　　　　　LET　hchr$=ichr$ 　　　　　　GOTO　15 　　　　　END　IF 　　　　　LET　cval(5)=cval(5)10+jchr 　　　　　IF　cval(5)=0　THEN 　　　　　　SET　TEXT　COLOR　0 　　　　　　PLOT　TEXT,AT　d,0:"0" 　　　　　　SET　TEXT　COLOR　1 　　　　　END　IF 　　　　　IF　cval(5)=0　THEN　18 　　　　　LET　cval(4)=cval(2)jchr 　　　　　LET　a$=LTRIM$(STR$(cval(4)))　　!答え積　　　　　LET　cval(3)=cval(3)-cval(4) 　　　　　LET　lin=lin+1 　　　　　CALL　ans$(a$,lin,d) 　　　　　IF　c+1>lprb　THEN 　　　　　　LET　d=2 　　　　　　LET　lin=lin-2 　　　　　　EXIT　FOR 　　　　　END　IF 　　　　　LET　cval(3)=cval(3)10+VAL(MID$(cvl1$,c+1,1)) 　　　　　LET　a$=LTRIM$(STR$(cval(3)))　　!次の桁　　　　　PLOT　LINES:　d+2,lin;d-2,lin 　　　　　LET　lin=lin+1 　　　　　CALL　ans$(a$,lin,d-1) 18　　NEXT　c 　　　LET　lin=lin+2 　　END　IF 　　! 　　IF　cal$=""　THEN　LET　lin=lin+c 　　PLOT　LINES:　d,lin;　-1,lin 　　LET　a$=LTRIM$(STR$(cval(3))) 　　CALL　ans$(a$,lin+1,0) 　　SET　TEXT　COLOR　4 　　PLOT　TEXT　,AT　7,9.5:"良くできました！" 　　SET　TEXT　COLOR　1 　　CHARACTER　INPUT　CLEAR:ichr$　　 19　GOTO　10 　　END

Re: つづき１	返事を書く
哲 2004/01/29 14:59:34
つづき２　　! 　　! 　　EXTERNAL　FUNCTION　prob$(i,lprb,cal$)　　!*問題*　i:行　　LET　num$="0123456789" 　　LET　cal0$="+-/="　&　chr$(13) 　　LET　sif=0 　　IF　cal$="/"　THEN　LET　sif=lprb+1 　　FOR　c=1　to　6 　　　CHARACTER　INPUT　CLEAR:ichr$ 　　　LET　nord=ORD(ichr$) 　　　LET　n=POS(num$,ichr$)-1 　　　LET　lcomp=LEN(comp$) 　　　IF　n>-1　AND　lcomp<5　THEN 　　　　　LET　comp$=comp$　&　ichr$ 　　　　　LET　hchr$="" 　　　　　FOR　d=1　TO　c 　　　　　　SET　TEXT　COLOR　0 　　　　　　IF　cal$<>"/"　AND　d=1　THEN　PLOT　TEXT,AT　lprb,2:cal$ 　　　　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$　　!上書消去　　　　　　SET　TEXT　COLOR　1 　　　　　　LET　hchr$=MID$(comp$,d,1) 　　　　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$ 　　　　　NEXT　d 　　　　　IF　c>lprb　THEN　LET　lprb=c 　　　　　IF　cal$<>"/"　THEN　PLOT　TEXT,AT　lprb,2:cal$ 　　　ELSEIF　POS(cal0$,ichr$)>0　THEN 　　　　　LET　comp$=comp$　&　ichr$ 　　　　　EXIT　FOR 　　　ELSE 　　　　　LET　comp$="?" 　　　　　EXIT　FOR 　　　END　IF 　　NEXT　c 　　LET　prob$=comp$ 　　END　FUNCTION 　　! 　　EXTERNAL　SUB　ans$(a$,lin,d)　　!答え* 　　LET　ld=LEN(a$) 　　FOR　c=1　to　ld 　　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□" 20　　CHARACTER　INPUT　CLEAR:ichr$ 　　　SET　TEXT　COLOR　0 　　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□"　!上書消去　　　PLOT　TEXT　,AT　c+d-1,lin　:hchr$ 　　　PLOT　TEXT　,AT　c+d-1,lin　:"X" 　　　SET　TEXT　COLOR　1 　　　PLOT　TEXT　,AT　c+d-1,lin　:ichr$ 　　　IF　ichr$=MID$(a$,ld-c+1,1)　THEN　29 　　　LET　hchr$=ichr$ 　　　SET　TEXT　COLOR　4 　　　PLOT　TEXT　,AT　c+d-1,lin　:"X" 　　　SET　TEXT　COLOR　1 　　　GOTO　20 29　NEXT　c 　　END　SUB

Re: つづき２	返事を書く
哲 2004/01/29 16:56:39
１箇所修正してください。 ELSEIF cal$="" THEN !掛け算 LET lc=LEN(cval$) FOR c=0 TO lc-1 LET cval(3+c)=cval(1)VAL(MID$(cval$,lc-c,1)) LET cval(lc+3)=cval(lc+3)+cval(3+c)*10^c IF lc=1 THEN EXIT FOR　　　　　　　　　＊＊＊この１行を追加＊＊＊ LET a$=LTRIM$(STR$(cval(3+c))) CALL ans$(a$,c+3,c) NEXT c LET cval(3)=cval(lc+3) LET d=lprb+c-1 修正しないと、掛ける数が１桁のとき問題が発生します。

Re: １箇所修正してください。	返事を書く
もりの 2004/01/29 19:23:27
哲さん最終的にしあがったプログラム全体をここにアップしていただけますか？まだいちども動いていないんです。せっかく作ってくれたのでつかいたいんですが

Re: 哲さん	返事を書く
哲 2004/01/29 19:56:53
IEのバージョンが古かったので新しいもので書き込んでみます。 !　　[筆算プログラム　for　十進ＢＡＳＩＣ]　040129 ! !数値と＋－/＝またはEnterを入れて行けば計算確認できます。 !問題入力中は、どこでも不適切なキーを押すことで初期状態に戻ります。 !前処理の　txtsize=　で大きさを自由に変えてください。 ! !　cval:数値保存用配列　cal$:演算子　 !　ichr$:入力文字　hchr$,jchr$:一時保存文字　comp$:比較文字列 ! !　　　前処理* DECLARE　EXTERNAL　FUNCTION　prob$ DECLARE　EXTERNAL　SUB　ans$ SET　ECHO　"OFF" LET　txtsize=32　　　　　　　　!!!　文字の大きさを変える LET　width=(txtsize+5)15 LET　height=(txtsize+5)15 SET　BITMAP　SIZE　width,　height SET　WINDOW　10,　-3,　10,　-3　　!座標系と桁、行を一致させる SET　AREA　COLOR　0 SET　LINE　WIDTH　2 DIM　cval(8) ! !　*メイン処理* 10　CLEAR 　　MAT　cval=ZER 　　LET　lin=1 　　LET　comp$="" 　　LET　lprb=0 　　LET　cal$="" 　　LET　cal0$="+-/?="　&　chr$(13) 　　SET　TEXT　FONT　"ＭＳ　ゴシック",INT(txtsize/43) 　　PLOT　TEXT　,AT　9,-1.5　:　"5ケタまでのけいさん(＋－＊/＝)" 　　SET　TEXT　FONT　"ＭＳ　ゴシック",txtsize 　　LET　cval$=prob$(1,lprb,cal$)　　　　　　!問題１行目　　LET　lprb=LEN(cval$)-1 　　LET　cal$=RIGHT$(cval$,1) 　　IF　lprb<1　OR　POS(cal0$,cal$)>4　THEN　10 　　LET　cvl1$=LEFT$(cval$,lprb) 　　LET　cval(1)=Val(cvl1$) 　　PLOT　TEXT　,AT　lprb,2　:　cal$ 　　LET　lin=2 　　IF　cal$="/"　THEN 　　　SET　TEXT　COLOR　0 　　　PLOT　TEXT　,AT　lprb,2　:　cal$ 　　　SET　TEXT　COLOR　1 　　　PLOT　TEXT　,AT　lprb,1　:")" 　　　PLOT　LINES:lprb,0;　-1,0 　　　LET　lin=1 　　END　IF 　　LET　cval$=prob$(lin,lprb,cal$)　　　　　!問題２行目　　IF　POS(cal0$,RIGHT$(cval$,1))<6　THEN　10　!"="の確認　　LET　cval$=LEFT$(cval$,LEN(cval$)-1) 　　LET　cval(2)=Val(cval$)

Re: IEのバージョンが古かったので新しいもので...	返事を書く
哲 2004/01/29 19:59:21
続き１　　! 　　IF　cal$<>"/"　THEN　PLOT　LINES:lprb,2;　-1,2　　!答え　　LET　c=0 　　IF　cal$="+"　THEN 　　　LET　cval(3)=cval(1)+cval(2) 　　　LET　d=MAX(lin-1,LEN(cval$)) 　　ELSEIF　cal$="-"　THEN 　　　LET　cval(3)=cval(1)-cval(2) 　　　LET　d=MAX(lin-1,LEN(cval$)) 　　ELSEIF　cal$=""　THEN　　　　　　　　　!掛け算　　　LET　lc=LEN(cval$) 　　　FOR　c=0　TO　lc-1 　　　　　LET　cval(3+c)=cval(1)VAL(MID$(cval$,lc-c,1)) 　　　　　LET　cval(lc+3)=cval(lc+3)+cval(3+c)10^c 　　　　　IF　lc=1　THEN　EXIT　FOR 　　　　　LET　a$=LTRIM$(STR$(cval(3+c))) 　　　　　CALL　ans$(a$,c+3,c) 　　　NEXT　c 　　　LET　cval(3)=cval(lc+3) 　　　LET　d=lprb+c-1 　　ELSE 　　　LET　lin=1 　　　FOR　c=1　to　lprb　　　　　　　　　!割り算　　　　　LET　d=lprb-c 　　　　　IF　cval(5)=0　THEN　LET　cval(3)=cval(3)10+VAL(MID$(cvl1$,c,1)) 　　　　　LET　jchr=INT(cval(3)/cval(2)) 　　　　　LET　jchr$=LTRIM$(STR$(jchr)) 　　　　　LET　hchr$="" 　　　　　PLOT　TEXT　,AT　d+0.3,0:　"□" 15　　　　CHARACTER　INPUT　CLEAR:ichr$ 　　　　　SET　TEXT　COLOR　0 　　　　　PLOT　TEXT　,AT　d+0.3,0:　"□"　　　!上書消去　　　　　PLOT　TEXT,AT　d,0:hchr$ 　　　　　PLOT　TEXT,AT　d,0:"X" 　　　　　SET　TEXT　COLOR　1 　　　　　PLOT　TEXT,AT　d,0:ichr$ 　　　　　IF　ichr$<>jchr$　THEN 　　　　　　SET　TEXT　COLOR　4 　　　　　　PLOT　TEXT,AT　d,0:"X" 　　　　　　SET　TEXT　COLOR　1 　　　　　　LET　hchr$=ichr$ 　　　　　　GOTO　15 　　　　　END　IF 　　　　　LET　cval(5)=cval(5)10+jchr 　　　　　IF　cval(5)=0　THEN 　　　　　　SET　TEXT　COLOR　0 　　　　　　PLOT　TEXT,AT　d,0:"0" 　　　　　　SET　TEXT　COLOR　1 　　　　　END　IF 　　　　　IF　cval(5)=0　THEN　18 　　　　　LET　cval(4)=cval(2)jchr 　　　　　LET　a$=LTRIM$(STR$(cval(4)))　　!答え積　　　　　LET　cval(3)=cval(3)-cval(4) 　　　　　LET　lin=lin+1 　　　　　CALL　ans$(a$,lin,d) 　　　　　IF　c+1>lprb　THEN 　　　　　　LET　d=2 　　　　　　LET　lin=lin-2 　　　　　　EXIT　FOR 　　　　　END　IF 　　　　　LET　cval(3)=cval(3)10+VAL(MID$(cvl1$,c+1,1)) 　　　　　LET　a$=LTRIM$(STR$(cval(3)))　　!次の桁　　　　　PLOT　LINES:　d+2,lin;d-2,lin 　　　　　LET　lin=lin+1 　　　　　CALL　ans$(a$,lin,d-1) 18　　NEXT　c 　　　LET　lin=lin+2 　　END　IF 　　! 　　IF　cal$=""　THEN　LET　lin=lin+c 　　PLOT　LINES:　d,lin;　-1,lin 　　LET　a$=LTRIM$(STR$(cval(3))) 　　CALL　ans$(a$,lin+1,0) 　　SET　TEXT　COLOR　4 　　PLOT　TEXT　,AT　7,9.5:"良くできました！" 　　SET　TEXT　COLOR　1 　　CHARACTER　INPUT　CLEAR:ichr$　　 19　GOTO　10 　　END 　　!

Re: 続き１	返事を書く
哲 2004/01/29 20:00:23
続き２　　EXTERNAL　FUNCTION　prob$(i,lprb,cal$)　　!*問題*　i:行　　LET　num$="0123456789" 　　LET　cal0$="+-/="　&　chr$(13) 　　LET　sif=0 　　IF　cal$="/"　THEN　LET　sif=lprb+1 　　FOR　c=1　to　6 　　　CHARACTER　INPUT　CLEAR:ichr$ 　　　LET　nord=ORD(ichr$) 　　　LET　n=POS(num$,ichr$)-1 　　　LET　lcomp=LEN(comp$) 　　　IF　n>-1　AND　lcomp<5　THEN 　　　　　LET　comp$=comp$　&　ichr$ 　　　　　LET　hchr$="" 　　　　　FOR　d=1　TO　c 　　　　　　SET　TEXT　COLOR　0 　　　　　　IF　cal$<>"/"　AND　d=1　THEN　PLOT　TEXT,AT　lprb,2:cal$ 　　　　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$　　!上書消去　　　　　　SET　TEXT　COLOR　1 　　　　　　LET　hchr$=MID$(comp$,d,1) 　　　　　　PLOT　TEXT,AT　c-d+sif,i　:hchr$ 　　　　　NEXT　d 　　　　　IF　c>lprb　THEN　LET　lprb=c 　　　　　IF　cal$<>"/"　THEN　PLOT　TEXT,AT　lprb,2:cal$ 　　　ELSEIF　POS(cal0$,ichr$)>0　THEN 　　　　　LET　comp$=comp$　&　ichr$ 　　　　　EXIT　FOR 　　　ELSE 　　　　　LET　comp$="?" 　　　　　EXIT　FOR 　　　END　IF 　　NEXT　c 　　LET　prob$=comp$ 　　END　FUNCTION 　　! 　　EXTERNAL　SUB　ans$(a$,lin,d)　　!答え* 　　LET　ld=LEN(a$) 　　FOR　c=1　to　ld 　　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□" 20　　CHARACTER　INPUT　CLEAR:ichr$ 　　　SET　TEXT　COLOR　0 　　　PLOT　TEXT　,AT　c+d-0.7,lin　:　"□"　!上書消去　　　PLOT　TEXT　,AT　c+d-1,lin　:hchr$ 　　　PLOT　TEXT　,AT　c+d-1,lin　:"X" 　　　SET　TEXT　COLOR　1 　　　PLOT　TEXT　,AT　c+d-1,lin　:ichr$ 　　　IF　ichr$=MID$(a$,ld-c+1,1)　THEN　29 　　　LET　hchr$=ichr$ 　　　SET　TEXT　COLOR　4 　　　PLOT　TEXT　,AT　c+d-1,lin　:"X" 　　　SET　TEXT　COLOR　1 　　　GOTO　20 29　NEXT　c 　　END　SUB

Re: 続き２	返事を書く
哲 2004/01/29 20:42:11
どうも全角に変換すると化けるようなので、そのままUPして見ます。

Re: どうも全角に変換すると化けるようなので、...	返事を書く
哲 2004/01/29 21:07:18
ここで書けなくなちゃいました。メールアドレスを教えてくださるならメールで送ります。

Re: ここで書けなくなちゃいました。	返事を書く
もりの 2004/01/29 21:17:55
メルアドは stdoor24_12@hotmail.com ですよろしくさっき動きましたが最初のタイトルが文字化けしている事カケルはやはり　×　でないとだけですねあと正解したあと赤丸が表示されません間違いの数字には赤いレテンが必要ですｙａｈｏｏのコンピュータのコンテンツの中のフリーの筆算ソフトを今つかっています参考までに今みてください算数・英語のところにあります

Re: メルアドは	返事を書く
哲 2004/01/29 22:05:41
筆算ソフトっていっぱいあってよく解りません。カケルを　×　にするって全角になりますからそう簡単にはできません。やはり現場の人が改善しながら自分で少しづつ作り上げて行かないと、本当に良いものはできないと思います。もともと十進BASICでも、ここまでできますと言うことを知ってもらいたかったのですから、論文にまで含めるのであれば自分で改良を加えてください。

Re: 筆算ソフトっていっぱいあってよく解りませ...	返事を書く
もりの 2004/01/29 23:59:03
私もＮ８８の本はくさるほどもっていますが十進ＢＡＳＩＣでどこまでできるか知りたかったんですよでこまでできるか挑戦してみてほしいな＾＾

Re: 私もＮ８８の本はくさるほど	返事を書く
哲 2004/01/30 08:39:18
私はN88BASICは使ったことがありません。十進BASICはインタープリタですから、このプログラムを完成品のソフトとして使うには不適当です。その場でいろいろ条件を変えて実行するには非常に便利ですが、間違ってエディターにフォーカスが移ってキー入力してしまうと、すぐに動かなくなります。ただ現場で使うだけの目的ならコンパイラで実行ファイルで使えるようにする必要があるでしょう。

Re: 続き２	返事を書く
哲 2004/01/31 00:34:38
＊　文字化けの対策　＊この掲示板からコピーして実行すると、全角スペースを半角スペースに変換してくれますが、このとき問題が起きます。 MS ゴシック　の間が半角スペース１個になるように書き換えて実行してください。

Re: ＊文字化けの対策＊	返事を書く
もりの 2004/01/31 09:08:26
自動採点の赤丸ありがとう

Re: ＊文字化けの対策＊	返事を書く
哲 2004/02/02 14:04:56
＊表示色の変更＊目にやさしい色に改善するために前処理の部分を書き換えて見ました。 !　　　*前処理* DECLARE EXTERNAL FUNCTION prob$ DECLARE EXTERNAL SUB ans$ SET ECHO "OFF" LET txtsize=34　　　　　　　　!!! 文字の大きさを変える LET width=(txtsize+5)15 LET height=(txtsize+5)15 SET BITMAP SIZE width, height SET WINDOW 10, -3, 10, -3　　!座標系と桁、行を一致させる SET COLOR MIX(0)0,0.4,0　　!背景色緑 SET COLOR MIX(1)1,1,1　　　!文字色白 SET AREA COLOR 0 DIM cval(8)