電話帳プログラム作成プロセスと、プログラムの例

 投稿者：RCカー  投稿日：2021年 8月10日(火)20時32分19秒
  　フォームによる、データ入力、削除、更新、検索
　データは、ID番号、氏名、電話番号。
　個人用なので可能だと思う。一覧表示機能。
　ファイルへの、データ保存。
　氏名からの電話番号検索
　電話番号からの氏名検索
　 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：nagram  投稿日：2021年 8月11日(水)18時28分29秒
  > No.4933[元記事へ]

RCカーさんへのお返事です。

> 　フォームによる、データ入力、削除、更新、検索
> 　データは、ID番号、氏名、電話番号。
> 　個人用なので可能だと思う。一覧表示機能。
> 　ファイルへの、データ保存。
> 　氏名からの電話番号検索
> 　電話番号からの氏名検索
>

作ってみました。
まず実行前に、データの上限を指定する変数MXの値を決定してください。
その他、変更可の変数の値も必要であれば変更してください。
実行するとまず、データファイルを新規作成するか、既存のファイルを読み込むかの選択をします。
データの入力は、ID番号・氏名・電話番号の順です（追加で入力できます）。
電話番号は"09012345678","090-1234-5678","090(1234)5678"いずれの形式でもかまいません。
苗字と名前の間など、入力データに空白があってもかまいませんが、半角カンマ","は使えません。
入力または読み込みが終わるとメインメニューになります。
  1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了
から選択です。
[入力][削除][更新]があった場合は、プログラム終了までに必ず[保存]してください。
保存しないデータはプログラム終了で失われます。
保存したファイルはカンマ区切りのCSV形式なのでExcelなどで読み込むことが出来ます。
検索は、苗字だけとか電話番号の一部だけといった部分一致検索に対応してます。

質問や不具合があれば、この掲示板にお願いします。

DECLARE EXTERNAL SUB sort
DECLARE NUMERIC MX,IDmin,IDmax,lenID,lenname,lentel,dmx,f,n,id,li,sa,sr,i,j,j2,wd
DECLARE STRING idrange$,u$,s$,name$,tel$,d$,c$,sa$,t$
OPTION CHARACTER KANJI
LET MX=200      ! data数の上限(変更可)
LET IDmin=1001  ! ID番号の下限(変更可) IDmin>=1
LET IDmax=9999  ! ID番号の上限(変更可)
LET lenID=CEIL(LOG10(IDmax))+1
LET lenNAME=8   ! 氏名の最大文字数(変更可)
LET lenTEL=14   ! 電話番号の最大文字数(変更可)
DIM DT$(MX,3),DTid(MX),DTtel$(MX),sortID(MX)
LET idrange$=STR$(IDmin)&"～"&STR$(IDmax)
LET u$=REPEAT$("#",lenID)&" <"&REPEAT$("#",2*lenNAME-1)&" <"&REPEAT$("#",lenTEL)
LET wd=0.1
SET ECHO "OFF"
LET dmx=0
!
DO
   INPUT PROMPT "【ファイル】1.新規作成 2.読込み (終了は 0)":f
LOOP UNTIL f=INT(f) AND f>=0 AND f<=2
WAIT DELAY wd
IF f=1 THEN
   CALL main(1)
ELSEIF f=2 THEN
   FILE GETOPENNAME s$  ! 電話帳ファイルの読込み
   OPEN #1: NAME s$
   DO
      LET dmx=dmx+1
      INPUT #1, IF MISSING THEN EXIT DO: DT$(dmx,1),DT$(dmx,2),DT$(dmx,3)
      LET DTid(dmx)=VAL(DT$(dmx,1))
      CALL tel(DTtel$(dmx),DT$(dmx,3))
   LOOP
   LET dmx=dmx-1
ELSE
   STOP
END IF
!
DO   ! メインルーチン
   DO
      INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n
   LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
   WAIT DELAY wd
   CALL main(n)
LOOP UNTIL n=0
!
SUB main(n)
   SELECT CASE n
   CASE 1  ! [入力]
      DO
         IF dmx>=MX THEN
            WAIT DELAY "DATA数が上限 "&STR$(MX)&" に達していて、入力が出来ません"
            WAIT DELAY wd
            EXIT SUB
         END IF
         DO
            INPUT PROMPT " ID番号入力 "&idrange$&" (入力終了は 0)" :id
         LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
         WAIT DELAY wd
         IF id=0 THEN EXIT DO
         INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
         WAIT DELAY wd
         IF name$="0" THEN EXIT DO
         INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
         WAIT DELAY wd
         IF tel$="0" THEN EXIT DO
         LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
         LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
         IF CONFIRM$(c$)="YES" THEN
            LET dmx=dmx+1
            LET DT$(dmx,1)=STR$(id)
            LET DT$(dmx,2)=name$
            LET DT$(dmx,3)=tel$
            LET DTid(dmx)=id
            CALL tel(DTtel$(dmx),DT$(dmx,3))
         END IF
         WAIT DELAY wd
      LOOP
   CASE 2  ! [削除]
      DO
         INPUT PROMPT " 削除するDATAのID番号を入力 (キャンセルは 0)" :id
      LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
      WAIT DELAY wd
      IF id=0 THEN EXIT SUB
      FOR i=1 TO dmx
         IF DTid(i)=id THEN
            LET d$="下記のDATAを削除しますか？"&CHR$(10)&"ID："&DT$(i,1)
            LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
            IF CONFIRM$(d$)="YES" THEN
               PRINT "削除したDATA"
               PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
               FOR j=i+1 TO dmx
                  LET DT$(j-1,1)=DT$(j,1)
                  LET DT$(j-1,2)=DT$(j,2)
                  LET DT$(j-1,3)=DT$(j,3)
                  LET DTid(j-1)=VAL(DT$(j,1))
                  LET DTtel$(j-1)=DTtel$(j)
               NEXT j
               LET DT$(dmx,1),DT$(dmx,2),DT$(dmx,3),DTtel$(dmx)=""
               LET DTid(dmx)=0
               LET dmx=dmx-1
            END IF
            WAIT DELAY wd
            EXIT SUB
         END IF
      NEXT i
      WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
   CASE 3  ! [更新]
      DO
         INPUT PROMPT " 更新するDATAのID番号を入力 (キャンセルは 0)" :id
      LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
      WAIT DELAY wd
      IF id=0 THEN EXIT SUB
      FOR i=1 TO dmx
         IF DTid(i)=id THEN
            LET d$="下記のDATAを書き換えますか？"&CHR$(10)&"ID："&DT$(i,1)
            LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
            IF CONFIRM$(d$)="NO" THEN EXIT SUB
            PRINT "更新前のDATA"
            PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
            DO
               INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
               WAIT DELAY wd
               IF name$="0" THEN EXIT SUB
               INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
               WAIT DELAY wd
               IF tel$="0" THEN EXIT SUB
               LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
               LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
               IF CONFIRM$(c$)="YES" THEN
                  LET DT$(i,2)=name$
                  LET DT$(i,3)=tel$
                  CALL tel(DTtel$(i),DT$(i,3))
                  EXIT DO
               END IF
            LOOP
            WAIT DELAY wd
            EXIT SUB
         END IF
      NEXT i
      WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
   CASE 4  ! [検索]
      DO
         INPUT PROMPT " 検索項目  1.氏名  2.電話番号  (キャンセルは 0)": sa
      LOOP UNTIL sa=INT(sa) AND sa>=0 AND sa<=2
      WAIT DELAY wd
      IF sa=0 THEN EXIT SUB
      INPUT PROMPT " 検索文字列 (一部分でも可, キャンセルは 0)": sa$
      WAIT DELAY wd
      IF sa$="0" THEN EXIT SUB
      IF sa=1 THEN LET t$="氏名" ELSE LET t$="電話番号"
      PRINT "検索結果 [";t$;",""";sa$;"""]"
      LET sr=0
      IF sa=1 THEN
         FOR i=1 TO dmx
            IF POS(DT$(i,2),sa$)>0 THEN
               PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
               LET sr=sr+1
            END IF
         NEXT i
      ELSE  ! sa=2
         FOR j=LEN(sa$) TO 1 STEP -1
            IF sa$(j:j)<"0" OR sa$(j:j)>"9" THEN LET sa$(j:j)=""
         NEXT j
         FOR i=1 TO dmx
            IF POS(DTtel$(i),sa$)>0 THEN
               PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
               LET sr=sr+1
            END IF
         NEXT i
      END IF
      IF sr=0 THEN PRINT "該当するDATAはありませんでした"
   CASE 5  ! [一覧]
      DO
         INPUT PROMPT " 1.DATA順  2.ID番号順  (キャンセルは 0)" : li
      LOOP UNTIL li=INT(li) AND li>=0 AND li<=2
      IF li=1 THEN
         PRINT "DATA一覧"
         FOR i=1 TO dmx
            PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
         NEXT i
      ELSEIF li=2 THEN
         MAT sortID=ZER
         CALL sort(DTid,sortID,dmx)
         PRINT "DATA一覧 (ID番号順)"
         FOR i=1 TO dmx
            PRINT USING u$: DT$(sortID(i),1),DT$(sortID(i),2),DT$(sortID(i),3)
         NEXT i
      END IF
   CASE 6  ! [保存]
      CALL save
   CASE 0  ! [終了]
      IF CONFIRM$("プログラムを終了しますか？")="NO" THEN EXIT SUB
      IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
      CLOSE #1
   END SELECT
   WAIT DELAY wd
END SUB
!
SUB save
   IF f=1 THEN
      FILE GETSAVENAME s$
      OPEN #1: NAME s$
      LET f=f+10
   END IF
   ERASE #1
   FOR i=1 TO dmx
      IF DTid(i)<>0 THEN PRINT#1: DT$(i,1)&","&DT$(i,2)&","&DT$(i,3)
   NEXT i
END SUB
!
SUB tel(t$,d$)
   LET t$=""
   FOR j2=1 TO LEN(d$)
      IF d$(j2:j2)>="0" AND d$(j2:j2)<="9" THEN LET t$=t$&d$(j2:j2)
   NEXT j2
END SUB
!
END
! 十進BASICライブラリ"\Decimal BASIC\BASICw32\Library\SORT2.LIB"
! ixにはmと下限，上限を一致させた空の配列を指定する。
! mは参照されるのみ。
! ixにmの添字を大きさの順に並べて返す。
! つまり，m(ix(1))≦m(ix(2))≦m(ix(3))≦･･･となる。
EXTERNAL SUB sort(m(),ix(),n)  ! ソート
DECLARE EXTERNAL SUB q_sort
DECLARE NUMERIC i
FOR i=1 TO n
   LET ix(i)=i
NEXT i
CALL q_sort(m,ix,1,n)
END SUB
!
EXTERNAL SUB q_sort(m(),a(),l,r)
DECLARE NUMERIC i,j,pv,t
IF r<=l THEN
   EXIT SUB
ELSE
   LET i=l-1
   LET j=r
   LET pv=m(a(r))
   DO
      DO
         LET i=i+1
      LOOP UNTIL pv<=m(a(i))
      DO
         LET j=j-1
      LOOP UNTIL j<=i OR m(a(j))<=pv
      IF j<=i THEN EXIT DO
      LET t=a(i)
      LET a(i)=a(j)
      LET a(j)=t
   LOOP
   LET t=a(i)
   LET a(i)=a(r)
   LET a(r)=t
   CALL q_sort(m,a,l,i-1)
   CALL q_sort(m,a,i+1,r)
END IF
END SUB 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：RCカー  投稿日：2021年 8月11日(水)19時25分41秒
  > No.4940[元記事へ]

nagramさんへのお返事です。

RCカーより、ありがとうございました。

> RCカーさんへのお返事です。
>
> > 　フォームによる、データ入力、削除、更新、検索
> > 　データは、ID番号、氏名、電話番号。
> > 　個人用なので可能だと思う。一覧表示機能。
> > 　ファイルへの、データ保存。
> > 　氏名からの電話番号検索
> > 　電話番号からの氏名検索
> >
>
> 作ってみました。
> まず実行前に、データの上限を指定する変数MXの値を決定してください。
> その他、変更可の変数の値も必要であれば変更してください。
> 実行するとまず、データファイルを新規作成するか、既存のファイルを読み込むかの選択をします。
> データの入力は、ID番号・氏名・電話番号の順です（追加で入力できます）。
> 電話番号は"09012345678","090-1234-5678","090(1234)5678"いずれの形式でもかまいません。
> 苗字と名前の間など、入力データに空白があってもかまいませんが、半角カンマ","は使えません。
> 入力または読み込みが終わるとメインメニューになります。
>   1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了
> から選択です。
> [入力][削除][更新]があった場合は、プログラム終了までに必ず[保存]してください。
> 保存しないデータはプログラム終了で失われます。
> 保存したファイルはカンマ区切りのCSV形式なのでExcelなどで読み込むことが出来ます。
> 検索は、苗字だけとか電話番号の一部だけといった部分一致検索に対応してます。
>
> 質問や不具合があれば、この掲示板にお願いします。
>
> DECLARE EXTERNAL SUB sort
> DECLARE NUMERIC MX,IDmin,IDmax,lenID,lenname,lentel,dmx,f,n,id,li,sa,sr,i,j,j2,wd
> DECLARE STRING idrange$,u$,s$,name$,tel$,d$,c$,sa$,t$
> OPTION CHARACTER KANJI
> LET MX=200      ! data数の上限(変更可)
> LET IDmin=1001  ! ID番号の下限(変更可) IDmin>=1
> LET IDmax=9999  ! ID番号の上限(変更可)
> LET lenID=CEIL(LOG10(IDmax))+1
> LET lenNAME=8   ! 氏名の最大文字数(変更可)
> LET lenTEL=14   ! 電話番号の最大文字数(変更可)
> DIM DT$(MX,3),DTid(MX),DTtel$(MX),sortID(MX)
> LET idrange$=STR$(IDmin)&"～"&STR$(IDmax)
> LET u$=REPEAT$("#",lenID)&" <"&REPEAT$("#",2*lenNAME-1)&" <"&REPEAT$("#",lenTEL)
> LET wd=0.1
> SET ECHO "OFF"
> LET dmx=0
> !
> DO
>    INPUT PROMPT "【ファイル】1.新規作成 2.読込み (終了は 0)":f
> LOOP UNTIL f=INT(f) AND f>=0 AND f<=2
> WAIT DELAY wd
> IF f=1 THEN
>    CALL main(1)
> ELSEIF f=2 THEN
>    FILE GETOPENNAME s$  ! 電話帳ファイルの読込み
>    OPEN #1: NAME s$
>    DO
>       LET dmx=dmx+1
>       INPUT #1, IF MISSING THEN EXIT DO: DT$(dmx,1),DT$(dmx,2),DT$(dmx,3)
>       LET DTid(dmx)=VAL(DT$(dmx,1))
>       CALL tel(DTtel$(dmx),DT$(dmx,3))
>    LOOP
>    LET dmx=dmx-1
> ELSE
>    STOP
> END IF
> !
> DO   ! メインルーチン
>    DO
>       INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n
>    LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
>    WAIT DELAY wd
>    CALL main(n)
> LOOP UNTIL n=0
> !
> SUB main(n)
>    SELECT CASE n
>    CASE 1  ! [入力]
>       DO
>          IF dmx>=MX THEN
>             WAIT DELAY "DATA数が上限 "&STR$(MX)&" に達していて、入力が出来ません"
>             WAIT DELAY wd
>             EXIT SUB
>          END IF
>          DO
>             INPUT PROMPT " ID番号入力 "&idrange$&" (入力終了は 0)" :id
>          LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
>          WAIT DELAY wd
>          IF id=0 THEN EXIT DO
>          INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
>          WAIT DELAY wd
>          IF name$="0" THEN EXIT DO
>          INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
>          WAIT DELAY wd
>          IF tel$="0" THEN EXIT DO
>          LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
>          LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
>          IF CONFIRM$(c$)="YES" THEN
>             LET dmx=dmx+1
>             LET DT$(dmx,1)=STR$(id)
>             LET DT$(dmx,2)=name$
>             LET DT$(dmx,3)=tel$
>             LET DTid(dmx)=id
>             CALL tel(DTtel$(dmx),DT$(dmx,3))
>          END IF
>          WAIT DELAY wd
>       LOOP
>    CASE 2  ! [削除]
>       DO
>          INPUT PROMPT " 削除するDATAのID番号を入力 (キャンセルは 0)" :id
>       LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
>       WAIT DELAY wd
>       IF id=0 THEN EXIT SUB
>       FOR i=1 TO dmx
>          IF DTid(i)=id THEN
>             LET d$="下記のDATAを削除しますか？"&CHR$(10)&"ID："&DT$(i,1)
>             LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
>             IF CONFIRM$(d$)="YES" THEN
>                PRINT "削除したDATA"
>                PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
>                FOR j=i+1 TO dmx
>                   LET DT$(j-1,1)=DT$(j,1)
>                   LET DT$(j-1,2)=DT$(j,2)
>                   LET DT$(j-1,3)=DT$(j,3)
>                   LET DTid(j-1)=VAL(DT$(j,1))
>                   LET DTtel$(j-1)=DTtel$(j)
>                NEXT j
>                LET DT$(dmx,1),DT$(dmx,2),DT$(dmx,3),DTtel$(dmx)=""
>                LET DTid(dmx)=0
>                LET dmx=dmx-1
>             END IF
>             WAIT DELAY wd
>             EXIT SUB
>          END IF
>       NEXT i
>       WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
>    CASE 3  ! [更新]
>       DO
>          INPUT PROMPT " 更新するDATAのID番号を入力 (キャンセルは 0)" :id
>       LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
>       WAIT DELAY wd
>       IF id=0 THEN EXIT SUB
>       FOR i=1 TO dmx
>          IF DTid(i)=id THEN
>             LET d$="下記のDATAを書き換えますか？"&CHR$(10)&"ID："&DT$(i,1)
>             LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
>             IF CONFIRM$(d$)="NO" THEN EXIT SUB
>             PRINT "更新前のDATA"
>             PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
>             DO
>                INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
>                WAIT DELAY wd
>                IF name$="0" THEN EXIT SUB
>                INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
>                WAIT DELAY wd
>                IF tel$="0" THEN EXIT SUB
>                LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
>                LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
>                IF CONFIRM$(c$)="YES" THEN
>                   LET DT$(i,2)=name$
>                   LET DT$(i,3)=tel$
>                   CALL tel(DTtel$(i),DT$(i,3))
>                   EXIT DO
>                END IF
>             LOOP
>             WAIT DELAY wd
>             EXIT SUB
>          END IF
>       NEXT i
>       WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
>    CASE 4  ! [検索]
>       DO
>          INPUT PROMPT " 検索項目  1.氏名  2.電話番号  (キャンセルは 0)": sa
>       LOOP UNTIL sa=INT(sa) AND sa>=0 AND sa<=2
>       WAIT DELAY wd
>       IF sa=0 THEN EXIT SUB
>       INPUT PROMPT " 検索文字列 (一部分でも可, キャンセルは 0)": sa$
>       WAIT DELAY wd
>       IF sa$="0" THEN EXIT SUB
>       IF sa=1 THEN LET t$="氏名" ELSE LET t$="電話番号"
>       PRINT "検索結果 [";t$;",""";sa$;"""]"
>       LET sr=0
>       IF sa=1 THEN
>          FOR i=1 TO dmx
>             IF POS(DT$(i,2),sa$)>0 THEN
>                PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
>                LET sr=sr+1
>             END IF
>          NEXT i
>       ELSE  ! sa=2
>          FOR j=LEN(sa$) TO 1 STEP -1
>             IF sa$(j:j)<"0" OR sa$(j:j)>"9" THEN LET sa$(j:j)=""
>          NEXT j
>          FOR i=1 TO dmx
>             IF POS(DTtel$(i),sa$)>0 THEN
>                PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
>                LET sr=sr+1
>             END IF
>          NEXT i
>       END IF
>       IF sr=0 THEN PRINT "該当するDATAはありませんでした"
>    CASE 5  ! [一覧]
>       DO
>          INPUT PROMPT " 1.DATA順  2.ID番号順  (キャンセルは 0)" : li
>       LOOP UNTIL li=INT(li) AND li>=0 AND li<=2
>       IF li=1 THEN
>          PRINT "DATA一覧"
>          FOR i=1 TO dmx
>             PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
>          NEXT i
>       ELSEIF li=2 THEN
>          MAT sortID=ZER
>          CALL sort(DTid,sortID,dmx)
>          PRINT "DATA一覧 (ID番号順)"
>          FOR i=1 TO dmx
>             PRINT USING u$: DT$(sortID(i),1),DT$(sortID(i),2),DT$(sortID(i),3)
>          NEXT i
>       END IF
>    CASE 6  ! [保存]
>       CALL save
>    CASE 0  ! [終了]
>       IF CONFIRM$("プログラムを終了しますか？")="NO" THEN EXIT SUB
>       IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
>       CLOSE #1
>    END SELECT
>    WAIT DELAY wd
> END SUB
> !
> SUB save
>    IF f=1 THEN
>       FILE GETSAVENAME s$
>       OPEN #1: NAME s$
>       LET f=f+10
>    END IF
>    ERASE #1
>    FOR i=1 TO dmx
>       IF DTid(i)<>0 THEN PRINT#1: DT$(i,1)&","&DT$(i,2)&","&DT$(i,3)
>    NEXT i
> END SUB
> !
> SUB tel(t$,d$)
>    LET t$=""
>    FOR j2=1 TO LEN(d$)
>       IF d$(j2:j2)>="0" AND d$(j2:j2)<="9" THEN LET t$=t$&d$(j2:j2)
>    NEXT j2
> END SUB
> !
> END
> ! 十進BASICライブラリ"\Decimal BASIC\BASICw32\Library\SORT2.LIB"
> ! ixにはmと下限，上限を一致させた空の配列を指定する。
> ! mは参照されるのみ。
> ! ixにmの添字を大きさの順に並べて返す。
> ! つまり，m(ix(1))≦m(ix(2))≦m(ix(3))≦･･･となる。
> EXTERNAL SUB sort(m(),ix(),n)  ! ソート
> DECLARE EXTERNAL SUB q_sort
> DECLARE NUMERIC i
> FOR i=1 TO n
>    LET ix(i)=i
> NEXT i
> CALL q_sort(m,ix,1,n)
> END SUB
> !
> EXTERNAL SUB q_sort(m(),a(),l,r)
> DECLARE NUMERIC i,j,pv,t
> IF r<=l THEN
>    EXIT SUB
> ELSE
>    LET i=l-1
>    LET j=r
>    LET pv=m(a(r))
>    DO
>       DO
>          LET i=i+1
>       LOOP UNTIL pv<=m(a(i))
>       DO
>          LET j=j-1
>       LOOP UNTIL j<=i OR m(a(j))<=pv
>       IF j<=i THEN EXIT DO
>       LET t=a(i)
>       LET a(i)=a(j)
>       LET a(j)=t
>    LOOP
>    LET t=a(i)
>    LET a(i)=a(r)
>    LET a(r)=t
>    CALL q_sort(m,a,l,i-1)
>    CALL q_sort(m,a,i+1,r)
> END IF
> END SUB 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：RCカー  投稿日：2021年 8月12日(木)09時50分10秒
  > No.4940[元記事へ]

nagramさんへのお返事です。

　　nagramさんへ
　早速実行してみました。
　一人分のデータを入力して、入力、検索、一覧表示、保存、試しました。
　エラーなしで実行できました。
　ID番号を、1からではなく、1001からにしたのは、何か理由がありますか？？
　有難う御座いました。

> RCカーさんへのお返事です。
>
> > 　フォームによる、データ入力、削除、更新、検索
> > 　データは、ID番号、氏名、電話番号。
> > 　個人用なので可能だと思う。一覧表示機能。
> > 　ファイルへの、データ保存。
> > 　氏名からの電話番号検索
> > 　電話番号からの氏名検索
> >
>
> 作ってみました。
> まず実行前に、データの上限を指定する変数MXの値を決定してください。
> その他、変更可の変数の値も必要であれば変更してください。
> 実行するとまず、データファイルを新規作成するか、既存のファイルを読み込むかの選択をします。
> データの入力は、ID番号・氏名・電話番号の順です（追加で入力できます）。
> 電話番号は"09012345678","090-1234-5678","090(1234)5678"いずれの形式でもかまいません。
> 苗字と名前の間など、入力データに空白があってもかまいませんが、半角カンマ","は使えません。
> 入力または読み込みが終わるとメインメニューになります。
>   1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了
> から選択です。
> [入力][削除][更新]があった場合は、プログラム終了までに必ず[保存]してください。
> 保存しないデータはプログラム終了で失われます。
> 保存したファイルはカンマ区切りのCSV形式なのでExcelなどで読み込むことが出来ます。
> 検索は、苗字だけとか電話番号の一部だけといった部分一致検索に対応してます。
>
> 質問や不具合があれば、この掲示板にお願いします。
>
> DECLARE EXTERNAL SUB sort
> DECLARE NUMERIC MX,IDmin,IDmax,lenID,lenname,lentel,dmx,f,n,id,li,sa,sr,i,j,j2,wd
> DECLARE STRING idrange$,u$,s$,name$,tel$,d$,c$,sa$,t$
> OPTION CHARACTER KANJI
> LET MX=200      ! data数の上限(変更可)
> LET IDmin=1001  ! ID番号の下限(変更可) IDmin>=1
> LET IDmax=9999  ! ID番号の上限(変更可)
> LET lenID=CEIL(LOG10(IDmax))+1
> LET lenNAME=8   ! 氏名の最大文字数(変更可)
> LET lenTEL=14   ! 電話番号の最大文字数(変更可)
> DIM DT$(MX,3),DTid(MX),DTtel$(MX),sortID(MX)
> LET idrange$=STR$(IDmin)&"～"&STR$(IDmax)
> LET u$=REPEAT$("#",lenID)&" <"&REPEAT$("#",2*lenNAME-1)&" <"&REPEAT$("#",lenTEL)
> LET wd=0.1
> SET ECHO "OFF"
> LET dmx=0
> !
> DO
>    INPUT PROMPT "【ファイル】1.新規作成 2.読込み (終了は 0)":f
> LOOP UNTIL f=INT(f) AND f>=0 AND f<=2
> WAIT DELAY wd
> IF f=1 THEN
>    CALL main(1)
> ELSEIF f=2 THEN
>    FILE GETOPENNAME s$  ! 電話帳ファイルの読込み
>    OPEN #1: NAME s$
>    DO
>       LET dmx=dmx+1
>       INPUT #1, IF MISSING THEN EXIT DO: DT$(dmx,1),DT$(dmx,2),DT$(dmx,3)
>       LET DTid(dmx)=VAL(DT$(dmx,1))
>       CALL tel(DTtel$(dmx),DT$(dmx,3))
>    LOOP
>    LET dmx=dmx-1
> ELSE
>    STOP
> END IF
> !
> DO   ! メインルーチン
>    DO
>       INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n
>    LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
>    WAIT DELAY wd
>    CALL main(n)
> LOOP UNTIL n=0
> !
> SUB main(n)
>    SELECT CASE n
>    CASE 1  ! [入力]
>       DO
>          IF dmx>=MX THEN
>             WAIT DELAY "DATA数が上限 "&STR$(MX)&" に達していて、入力が出来ません"
>             WAIT DELAY wd
>             EXIT SUB
>          END IF
>          DO
>             INPUT PROMPT " ID番号入力 "&idrange$&" (入力終了は 0)" :id
>          LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
>          WAIT DELAY wd
>          IF id=0 THEN EXIT DO
>          INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
>          WAIT DELAY wd
>          IF name$="0" THEN EXIT DO
>          INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
>          WAIT DELAY wd
>          IF tel$="0" THEN EXIT DO
>          LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
>          LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
>          IF CONFIRM$(c$)="YES" THEN
>             LET dmx=dmx+1
>             LET DT$(dmx,1)=STR$(id)
>             LET DT$(dmx,2)=name$
>             LET DT$(dmx,3)=tel$
>             LET DTid(dmx)=id
>             CALL tel(DTtel$(dmx),DT$(dmx,3))
>          END IF
>          WAIT DELAY wd
>       LOOP
>    CASE 2  ! [削除]
>       DO
>          INPUT PROMPT " 削除するDATAのID番号を入力 (キャンセルは 0)" :id
>       LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
>       WAIT DELAY wd
>       IF id=0 THEN EXIT SUB
>       FOR i=1 TO dmx
>          IF DTid(i)=id THEN
>             LET d$="下記のDATAを削除しますか？"&CHR$(10)&"ID："&DT$(i,1)
>             LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
>             IF CONFIRM$(d$)="YES" THEN
>                PRINT "削除したDATA"
>                PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
>                FOR j=i+1 TO dmx
>                   LET DT$(j-1,1)=DT$(j,1)
>                   LET DT$(j-1,2)=DT$(j,2)
>                   LET DT$(j-1,3)=DT$(j,3)
>                   LET DTid(j-1)=VAL(DT$(j,1))
>                   LET DTtel$(j-1)=DTtel$(j)
>                NEXT j
>                LET DT$(dmx,1),DT$(dmx,2),DT$(dmx,3),DTtel$(dmx)=""
>                LET DTid(dmx)=0
>                LET dmx=dmx-1
>             END IF
>             WAIT DELAY wd
>             EXIT SUB
>          END IF
>       NEXT i
>       WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
>    CASE 3  ! [更新]
>       DO
>          INPUT PROMPT " 更新するDATAのID番号を入力 (キャンセルは 0)" :id
>       LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
>       WAIT DELAY wd
>       IF id=0 THEN EXIT SUB
>       FOR i=1 TO dmx
>          IF DTid(i)=id THEN
>             LET d$="下記のDATAを書き換えますか？"&CHR$(10)&"ID："&DT$(i,1)
>             LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
>             IF CONFIRM$(d$)="NO" THEN EXIT SUB
>             PRINT "更新前のDATA"
>             PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
>             DO
>                INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
>                WAIT DELAY wd
>                IF name$="0" THEN EXIT SUB
>                INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
>                WAIT DELAY wd
>                IF tel$="0" THEN EXIT SUB
>                LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
>                LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
>                IF CONFIRM$(c$)="YES" THEN
>                   LET DT$(i,2)=name$
>                   LET DT$(i,3)=tel$
>                   CALL tel(DTtel$(i),DT$(i,3))
>                   EXIT DO
>                END IF
>             LOOP
>             WAIT DELAY wd
>             EXIT SUB
>          END IF
>       NEXT i
>       WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
>    CASE 4  ! [検索]
>       DO
>          INPUT PROMPT " 検索項目  1.氏名  2.電話番号  (キャンセルは 0)": sa
>       LOOP UNTIL sa=INT(sa) AND sa>=0 AND sa<=2
>       WAIT DELAY wd
>       IF sa=0 THEN EXIT SUB
>       INPUT PROMPT " 検索文字列 (一部分でも可, キャンセルは 0)": sa$
>       WAIT DELAY wd
>       IF sa$="0" THEN EXIT SUB
>       IF sa=1 THEN LET t$="氏名" ELSE LET t$="電話番号"
>       PRINT "検索結果 [";t$;",""";sa$;"""]"
>       LET sr=0
>       IF sa=1 THEN
>          FOR i=1 TO dmx
>             IF POS(DT$(i,2),sa$)>0 THEN
>                PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
>                LET sr=sr+1
>             END IF
>          NEXT i
>       ELSE  ! sa=2
>          FOR j=LEN(sa$) TO 1 STEP -1
>             IF sa$(j:j)<"0" OR sa$(j:j)>"9" THEN LET sa$(j:j)=""
>          NEXT j
>          FOR i=1 TO dmx
>             IF POS(DTtel$(i),sa$)>0 THEN
>                PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
>                LET sr=sr+1
>             END IF
>          NEXT i
>       END IF
>       IF sr=0 THEN PRINT "該当するDATAはありませんでした"
>    CASE 5  ! [一覧]
>       DO
>          INPUT PROMPT " 1.DATA順  2.ID番号順  (キャンセルは 0)" : li
>       LOOP UNTIL li=INT(li) AND li>=0 AND li<=2
>       IF li=1 THEN
>          PRINT "DATA一覧"
>          FOR i=1 TO dmx
>             PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
>          NEXT i
>       ELSEIF li=2 THEN
>          MAT sortID=ZER
>          CALL sort(DTid,sortID,dmx)
>          PRINT "DATA一覧 (ID番号順)"
>          FOR i=1 TO dmx
>             PRINT USING u$: DT$(sortID(i),1),DT$(sortID(i),2),DT$(sortID(i),3)
>          NEXT i
>       END IF
>    CASE 6  ! [保存]
>       CALL save
>    CASE 0  ! [終了]
>       IF CONFIRM$("プログラムを終了しますか？")="NO" THEN EXIT SUB
>       IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
>       CLOSE #1
>    END SELECT
>    WAIT DELAY wd
> END SUB
> !
> SUB save
>    IF f=1 THEN
>       FILE GETSAVENAME s$
>       OPEN #1: NAME s$
>       LET f=f+10
>    END IF
>    ERASE #1
>    FOR i=1 TO dmx
>       IF DTid(i)<>0 THEN PRINT#1: DT$(i,1)&","&DT$(i,2)&","&DT$(i,3)
>    NEXT i
> END SUB
> !
> SUB tel(t$,d$)
>    LET t$=""
>    FOR j2=1 TO LEN(d$)
>       IF d$(j2:j2)>="0" AND d$(j2:j2)<="9" THEN LET t$=t$&d$(j2:j2)
>    NEXT j2
> END SUB
> !
> END
> ! 十進BASICライブラリ"\Decimal BASIC\BASICw32\Library\SORT2.LIB"
> ! ixにはmと下限，上限を一致させた空の配列を指定する。
> ! mは参照されるのみ。
> ! ixにmの添字を大きさの順に並べて返す。
> ! つまり，m(ix(1))≦m(ix(2))≦m(ix(3))≦･･･となる。
> EXTERNAL SUB sort(m(),ix(),n)  ! ソート
> DECLARE EXTERNAL SUB q_sort
> DECLARE NUMERIC i
> FOR i=1 TO n
>    LET ix(i)=i
> NEXT i
> CALL q_sort(m,ix,1,n)
> END SUB
> !
> EXTERNAL SUB q_sort(m(),a(),l,r)
> DECLARE NUMERIC i,j,pv,t
> IF r<=l THEN
>    EXIT SUB
> ELSE
>    LET i=l-1
>    LET j=r
>    LET pv=m(a(r))
>    DO
>       DO
>          LET i=i+1
>       LOOP UNTIL pv<=m(a(i))
>       DO
>          LET j=j-1
>       LOOP UNTIL j<=i OR m(a(j))<=pv
>       IF j<=i THEN EXIT DO
>       LET t=a(i)
>       LET a(i)=a(j)
>       LET a(j)=t
>    LOOP
>    LET t=a(i)
>    LET a(i)=a(r)
>    LET a(r)=t
>    CALL q_sort(m,a,l,i-1)
>    CALL q_sort(m,a,i+1,r)
> END IF
> END SUB 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：RCカー  投稿日：2021年 8月12日(木)11時52分19秒
  RCカーさんへのお返事です。
　データ入力ダイアログで、数字を、入れずに、OKを、クリックしたとき、シンタックスエラーが出ます。input文に、イレギュラーな、場合にどうするかを、しょりほうほうを、プログラムで、決めないと、駄目なのかな？、教えて下さい。
待ってます。

> nagramさんへのお返事です。
>
> 　　nagramさんへ
> 　早速実行してみました。
> 　一人分のデータを入力して、入力、検索、一覧表示、保存、試しました。
> 　エラーなしで実行できました。
> 　ID番号を、1からではなく、1001からにしたのは、何か理由がありますか？？
> 　有難う御座いました。
>
> > RCカーさんへのお返事です。
> >
> > > 　フォームによる、データ入力、削除、更新、検索
> > > 　データは、ID番号、氏名、電話番号。
> > > 　個人用なので可能だと思う。一覧表示機能。
> > > 　ファイルへの、データ保存。
> > > 　氏名からの電話番号検索
> > > 　電話番号からの氏名検索
> > >
> >
> > 作ってみました。
> > まず実行前に、データの上限を指定する変数MXの値を決定してください。
> > その他、変更可の変数の値も必要であれば変更してください。
> > 実行するとまず、データファイルを新規作成するか、既存のファイルを読み込むかの選択をします。
> > データの入力は、ID番号・氏名・電話番号の順です（追加で入力できます）。
> > 電話番号は"09012345678","090-1234-5678","090(1234)5678"いずれの形式でもかまいません。
> > 苗字と名前の間など、入力データに空白があってもかまいませんが、半角カンマ","は使えません。
> > 入力または読み込みが終わるとメインメニューになります。
> >   1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了
> > から選択です。
> > [入力][削除][更新]があった場合は、プログラム終了までに必ず[保存]してください。
> > 保存しないデータはプログラム終了で失われます。
> > 保存したファイルはカンマ区切りのCSV形式なのでExcelなどで読み込むことが出来ます。
> > 検索は、苗字だけとか電話番号の一部だけといった部分一致検索に対応してます。
> >
> > 質問や不具合があれば、この掲示板にお願いします。
> >
> > DECLARE EXTERNAL SUB sort
> > DECLARE NUMERIC MX,IDmin,IDmax,lenID,lenname,lentel,dmx,f,n,id,li,sa,sr,i,j,j2,wd
> > DECLARE STRING idrange$,u$,s$,name$,tel$,d$,c$,sa$,t$
> > OPTION CHARACTER KANJI
> > LET MX=200      ! data数の上限(変更可)
> > LET IDmin=1001  ! ID番号の下限(変更可) IDmin>=1
> > LET IDmax=9999  ! ID番号の上限(変更可)
> > LET lenID=CEIL(LOG10(IDmax))+1
> > LET lenNAME=8   ! 氏名の最大文字数(変更可)
> > LET lenTEL=14   ! 電話番号の最大文字数(変更可)
> > DIM DT$(MX,3),DTid(MX),DTtel$(MX),sortID(MX)
> > LET idrange$=STR$(IDmin)&"～"&STR$(IDmax)
> > LET u$=REPEAT$("#",lenID)&" <"&REPEAT$("#",2*lenNAME-1)&" <"&REPEAT$("#",lenTEL)
> > LET wd=0.1
> > SET ECHO "OFF"
> > LET dmx=0
> > !
> > DO
> >    INPUT PROMPT "【ファイル】1.新規作成 2.読込み (終了は 0)":f
> > LOOP UNTIL f=INT(f) AND f>=0 AND f<=2
> > WAIT DELAY wd
> > IF f=1 THEN
> >    CALL main(1)
> > ELSEIF f=2 THEN
> >    FILE GETOPENNAME s$  ! 電話帳ファイルの読込み
> >    OPEN #1: NAME s$
> >    DO
> >       LET dmx=dmx+1
> >       INPUT #1, IF MISSING THEN EXIT DO: DT$(dmx,1),DT$(dmx,2),DT$(dmx,3)
> >       LET DTid(dmx)=VAL(DT$(dmx,1))
> >       CALL tel(DTtel$(dmx),DT$(dmx,3))
> >    LOOP
> >    LET dmx=dmx-1
> > ELSE
> >    STOP
> > END IF
> > !
> > DO   ! メインルーチン
> >    DO
> >       INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n
> >    LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
> >    WAIT DELAY wd
> >    CALL main(n)
> > LOOP UNTIL n=0
> > !
> > SUB main(n)
> >    SELECT CASE n
> >    CASE 1  ! [入力]
> >       DO
> >          IF dmx>=MX THEN
> >             WAIT DELAY "DATA数が上限 "&STR$(MX)&" に達していて、入力が出来ません"
> >             WAIT DELAY wd
> >             EXIT SUB
> >          END IF
> >          DO
> >             INPUT PROMPT " ID番号入力 "&idrange$&" (入力終了は 0)" :id
> >          LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
> >          WAIT DELAY wd
> >          IF id=0 THEN EXIT DO
> >          INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
> >          WAIT DELAY wd
> >          IF name$="0" THEN EXIT DO
> >          INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
> >          WAIT DELAY wd
> >          IF tel$="0" THEN EXIT DO
> >          LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
> >          LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
> >          IF CONFIRM$(c$)="YES" THEN
> >             LET dmx=dmx+1
> >             LET DT$(dmx,1)=STR$(id)
> >             LET DT$(dmx,2)=name$
> >             LET DT$(dmx,3)=tel$
> >             LET DTid(dmx)=id
> >             CALL tel(DTtel$(dmx),DT$(dmx,3))
> >          END IF
> >          WAIT DELAY wd
> >       LOOP
> >    CASE 2  ! [削除]
> >       DO
> >          INPUT PROMPT " 削除するDATAのID番号を入力 (キャンセルは 0)" :id
> >       LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
> >       WAIT DELAY wd
> >       IF id=0 THEN EXIT SUB
> >       FOR i=1 TO dmx
> >          IF DTid(i)=id THEN
> >             LET d$="下記のDATAを削除しますか？"&CHR$(10)&"ID："&DT$(i,1)
> >             LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
> >             IF CONFIRM$(d$)="YES" THEN
> >                PRINT "削除したDATA"
> >                PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
> >                FOR j=i+1 TO dmx
> >                   LET DT$(j-1,1)=DT$(j,1)
> >                   LET DT$(j-1,2)=DT$(j,2)
> >                   LET DT$(j-1,3)=DT$(j,3)
> >                   LET DTid(j-1)=VAL(DT$(j,1))
> >                   LET DTtel$(j-1)=DTtel$(j)
> >                NEXT j
> >                LET DT$(dmx,1),DT$(dmx,2),DT$(dmx,3),DTtel$(dmx)=""
> >                LET DTid(dmx)=0
> >                LET dmx=dmx-1
> >             END IF
> >             WAIT DELAY wd
> >             EXIT SUB
> >          END IF
> >       NEXT i
> >       WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
> >    CASE 3  ! [更新]
> >       DO
> >          INPUT PROMPT " 更新するDATAのID番号を入力 (キャンセルは 0)" :id
> >       LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
> >       WAIT DELAY wd
> >       IF id=0 THEN EXIT SUB
> >       FOR i=1 TO dmx
> >          IF DTid(i)=id THEN
> >             LET d$="下記のDATAを書き換えますか？"&CHR$(10)&"ID："&DT$(i,1)
> >             LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
> >             IF CONFIRM$(d$)="NO" THEN EXIT SUB
> >             PRINT "更新前のDATA"
> >             PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
> >             DO
> >                INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
> >                WAIT DELAY wd
> >                IF name$="0" THEN EXIT SUB
> >                INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
> >                WAIT DELAY wd
> >                IF tel$="0" THEN EXIT SUB
> >                LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
> >                LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
> >                IF CONFIRM$(c$)="YES" THEN
> >                   LET DT$(i,2)=name$
> >                   LET DT$(i,3)=tel$
> >                   CALL tel(DTtel$(i),DT$(i,3))
> >                   EXIT DO
> >                END IF
> >             LOOP
> >             WAIT DELAY wd
> >             EXIT SUB
> >          END IF
> >       NEXT i
> >       WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
> >    CASE 4  ! [検索]
> >       DO
> >          INPUT PROMPT " 検索項目  1.氏名  2.電話番号  (キャンセルは 0)": sa
> >       LOOP UNTIL sa=INT(sa) AND sa>=0 AND sa<=2
> >       WAIT DELAY wd
> >       IF sa=0 THEN EXIT SUB
> >       INPUT PROMPT " 検索文字列 (一部分でも可, キャンセルは 0)": sa$
> >       WAIT DELAY wd
> >       IF sa$="0" THEN EXIT SUB
> >       IF sa=1 THEN LET t$="氏名" ELSE LET t$="電話番号"
> >       PRINT "検索結果 [";t$;",""";sa$;"""]"
> >       LET sr=0
> >       IF sa=1 THEN
> >          FOR i=1 TO dmx
> >             IF POS(DT$(i,2),sa$)>0 THEN
> >                PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
> >                LET sr=sr+1
> >             END IF
> >          NEXT i
> >       ELSE  ! sa=2
> >          FOR j=LEN(sa$) TO 1 STEP -1
> >             IF sa$(j:j)<"0" OR sa$(j:j)>"9" THEN LET sa$(j:j)=""
> >          NEXT j
> >          FOR i=1 TO dmx
> >             IF POS(DTtel$(i),sa$)>0 THEN
> >                PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
> >                LET sr=sr+1
> >             END IF
> >          NEXT i
> >       END IF
> >       IF sr=0 THEN PRINT "該当するDATAはありませんでした"
> >    CASE 5  ! [一覧]
> >       DO
> >          INPUT PROMPT " 1.DATA順  2.ID番号順  (キャンセルは 0)" : li
> >       LOOP UNTIL li=INT(li) AND li>=0 AND li<=2
> >       IF li=1 THEN
> >          PRINT "DATA一覧"
> >          FOR i=1 TO dmx
> >             PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
> >          NEXT i
> >       ELSEIF li=2 THEN
> >          MAT sortID=ZER
> >          CALL sort(DTid,sortID,dmx)
> >          PRINT "DATA一覧 (ID番号順)"
> >          FOR i=1 TO dmx
> >             PRINT USING u$: DT$(sortID(i),1),DT$(sortID(i),2),DT$(sortID(i),3)
> >          NEXT i
> >       END IF
> >    CASE 6  ! [保存]
> >       CALL save
> >    CASE 0  ! [終了]
> >       IF CONFIRM$("プログラムを終了しますか？")="NO" THEN EXIT SUB
> >       IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
> >       CLOSE #1
> >    END SELECT
> >    WAIT DELAY wd
> > END SUB
> > !
> > SUB save
> >    IF f=1 THEN
> >       FILE GETSAVENAME s$
> >       OPEN #1: NAME s$
> >       LET f=f+10
> >    END IF
> >    ERASE #1
> >    FOR i=1 TO dmx
> >       IF DTid(i)<>0 THEN PRINT#1: DT$(i,1)&","&DT$(i,2)&","&DT$(i,3)
> >    NEXT i
> > END SUB
> > !
> > SUB tel(t$,d$)
> >    LET t$=""
> >    FOR j2=1 TO LEN(d$)
> >       IF d$(j2:j2)>="0" AND d$(j2:j2)<="9" THEN LET t$=t$&d$(j2:j2)
> >    NEXT j2
> > END SUB
> > !
> > END
> > ! 十進BASICライブラリ"\Decimal BASIC\BASICw32\Library\SORT2.LIB"
> > ! ixにはmと下限，上限を一致させた空の配列を指定する。
> > ! mは参照されるのみ。
> > ! ixにmの添字を大きさの順に並べて返す。
> > ! つまり，m(ix(1))≦m(ix(2))≦m(ix(3))≦･･･となる。
> > EXTERNAL SUB sort(m(),ix(),n)  ! ソート
> > DECLARE EXTERNAL SUB q_sort
> > DECLARE NUMERIC i
> > FOR i=1 TO n
> >    LET ix(i)=i
> > NEXT i
> > CALL q_sort(m,ix,1,n)
> > END SUB
> > !
> > EXTERNAL SUB q_sort(m(),a(),l,r)
> > DECLARE NUMERIC i,j,pv,t
> > IF r<=l THEN
> >    EXIT SUB
> > ELSE
> >    LET i=l-1
> >    LET j=r
> >    LET pv=m(a(r))
> >    DO
> >       DO
> >          LET i=i+1
> >       LOOP UNTIL pv<=m(a(i))
> >       DO
> >          LET j=j-1
> >       LOOP UNTIL j<=i OR m(a(j))<=pv
> >       IF j<=i THEN EXIT DO
> >       LET t=a(i)
> >       LET a(i)=a(j)
> >       LET a(j)=t
> >    LOOP
> >    LET t=a(i)
> >    LET a(i)=a(r)
> >    LET a(r)=t
> >    CALL q_sort(m,a,l,i-1)
> >    CALL q_sort(m,a,i+1,r)
> > END IF
> > END SUB 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：nagram  投稿日：2021年 8月12日(木)19時47分38秒
  > No.4943[元記事へ]

RCカーさんへのお返事です。

>ID番号を、1からではなく、1001からにしたのは、何か理由がありますか？？

→ 4桁に揃えただけで特に意味はありません。
ID番号の下限、上限は IDmin,IDmaxで設定できるので、目的に合った値に変更してください。
また、入力データのID番号は連番でなくともかまいません。
例えば IDmin=1,IDmax=100 に設定し、入力を 20,15,4,16,27,…といった順番で入力してもかまいません。
データ一覧の出力は、入力した順とID番号順の並びを選択できます。


>データ入力ダイアログで、数字を、入れずに、OKを、クリックしたとき、シンタックスエラーが出ます。input文に、イレギュラーな、場合にどうするかを、しょりほうほうを、プログラムで、決めないと、駄目なのかな？、教えて下さい。

→ input文で数値変数に入力するときに数値以外(空文字列も含む)を入力すると再入力を促すのは十進BASICの仕様なので、利用者はどうすることもできません。
ただし、文字列変数に入力するようにすれば空文字列の入力も認められるので、[OK]クリックで[0]を入力したのと同じ扱いにすることはできます。

-----------------------------------------------------------------------------
DO   ! メインルーチン
   DO
      INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n
   LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
   WAIT DELAY wd
   CALL main(n)
LOOP UNTIL n=0
-----------------------------------------------------------------------------
上記の部分を、次のようにすれば[OK]クリックや[Enter]キーで[0]と同じ扱い。
-----------------------------------------------------------------------------
WHEN EXCEPTION IN
   DO   ! メインルーチン
      DO
         INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n$  !文字列変数入力
         LET n=VAL(n$)   ! 文字列変数を数値に変換。空文字列や"abc"などは例外発生。
      LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
      WAIT DELAY wd
      CALL main(n)
   LOOP UNTIL n=0
USE  ! 例外発生時の処理
   LET n=0
   CONTINUE
END WHEN
-----------------------------------------------------------------------------


◎ 重要なバグを発見しました。
"プログラムを終了しますか？" というメッセージボックスで[いいえ]を選択しても終了してしまいます。
副プログラム SUB main(n) 内のselect区で、CASE 0 を次のように修正してください。
--------------------------------------------------------------------------
【誤】
  CASE 0  ! [終了]
      IF CONFIRM$("プログラムを終了しますか？")="NO" THEN EXIT SUB
      IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
      CLOSE #1
   END SELECT
--------------------------------------------------------------------------
【正】
  CASE 0  ! [終了]
      IF CONFIRM$("プログラムを終了しますか？")="NO" THEN  ! 訂正
         LET n=7   ! 訂正
         EXIT SUB  ! 訂正
      END IF       ! 訂正
      IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
      CLOSE #1
   END SELECT
-------------------------------------------------------------------------- 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：RCカー  投稿日：2021年 8月13日(金)09時21分51秒
  > No.4944[元記事へ]

nagramさんへのお返事です。

まだシンタックスエラーが出ます。 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：RCカー  投稿日：2021年 8月13日(金)11時47分9秒
  > No.4944[元記事へ]

nagramさんへのお返事です。

以下、変更点を、編集したプログラムです。間違っていたら教えて下さい。
DECLARE EXTERNAL SUB sort
DECLARE NUMERIC MX,IDmin,IDmax,lenID,lenname,lentel,dmx,f,n,id,li,sa,sr,i,j,j2,wd
DECLARE STRING idrange$,u$,s$,name$,tel$,d$,c$,sa$,t$
OPTION CHARACTER KANJI
LET MX=200      ! data数の上限(変更可)
LET IDmin=1001  ! ID番号の下限(変更可) IDmin>=1
LET IDmax=9999  ! ID番号の上限(変更可)
LET lenID=CEIL(LOG10(IDmax))+1
LET lenNAME=8   ! 氏名の最大文字数(変更可)
LET lenTEL=14   ! 電話番号の最大文字数(変更可)
DIM DT$(MX,3),DTid(MX),DTtel$(MX),sortID(MX)
LET idrange$=STR$(IDmin)&"～"&STR$(IDmax)
LET u$=REPEAT$("#",lenID)&" <"&REPEAT$("#",2*lenNAME-1)&" <"&REPEAT$("#",lenTEL)
LET wd=0.1
SET ECHO "OFF"
LET dmx=0
!
DO
   INPUT PROMPT "【ファイル】1.新規作成 2.読込み (終了は 0)":f
LOOP UNTIL f=INT(f) AND f>=0 AND f<=2
WAIT DELAY wd
IF f=1 THEN
   CALL main(1)
ELSEIF f=2 THEN
   FILE GETOPENNAME s$  ! 電話帳ファイルの読込み
   OPEN #1: NAME s$
   DO
      LET dmx=dmx+1
      INPUT #1, IF MISSING THEN EXIT DO: DT$(dmx,1),DT$(dmx,2),DT$(dmx,3)
      LET DTid(dmx)=VAL(DT$(dmx,1))
      CALL tel(DTtel$(dmx),DT$(dmx,3))
   LOOP
   LET dmx=dmx-1
ELSE
   STOP
END IF
!
WHEN EXCEPTION IN
   DO   ! メインルーチン
      DO
         INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n$  !文字列変数入力
         LET n=VAL(n$)   ! 文字列変数を数値に変換。空文字列や"abc"などは例外発生。
      LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
      WAIT DELAY wd
      CALL main(n)
   LOOP UNTIL n=0
USE  ! 例外発生時の処理
   LET n=0
   CONTINUE
END WHEN!
SUB main(n)
   SELECT CASE n
   CASE 1  ! [入力]
      DO
         IF dmx>=MX THEN
            WAIT DELAY "DATA数が上限 "&STR$(MX)&" に達していて、入力が出来ません"
            WAIT DELAY wd
            EXIT SUB
         END IF
         DO
            INPUT PROMPT " ID番号入力 "&idrange$&" (入力終了は 0)" :id
         LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
         WAIT DELAY wd
         IF id=0 THEN EXIT DO
         INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
         WAIT DELAY wd
         IF name$="0" THEN EXIT DO
         INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
         WAIT DELAY wd
         IF tel$="0" THEN EXIT DO
         LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
         LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
         IF CONFIRM$(c$)="YES" THEN
            LET dmx=dmx+1
            LET DT$(dmx,1)=STR$(id)
            LET DT$(dmx,2)=name$
            LET DT$(dmx,3)=tel$
            LET DTid(dmx)=id
            CALL tel(DTtel$(dmx),DT$(dmx,3))
         END IF
         WAIT DELAY wd
      LOOP
   CASE 2  ! [削除]
      DO
         INPUT PROMPT " 削除するDATAのID番号を入力 (キャンセルは 0)" :id
      LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
      WAIT DELAY wd
      IF id=0 THEN EXIT SUB
      FOR i=1 TO dmx
         IF DTid(i)=id THEN
            LET d$="下記のDATAを削除しますか？"&CHR$(10)&"ID："&DT$(i,1)
            LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
            IF CONFIRM$(d$)="YES" THEN
               PRINT "削除したDATA"
               PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
               FOR j=i+1 TO dmx
                  LET DT$(j-1,1)=DT$(j,1)
                  LET DT$(j-1,2)=DT$(j,2)
                  LET DT$(j-1,3)=DT$(j,3)
                  LET DTid(j-1)=VAL(DT$(j,1))
                  LET DTtel$(j-1)=DTtel$(j)
               NEXT j
               LET DT$(dmx,1),DT$(dmx,2),DT$(dmx,3),DTtel$(dmx)=""
               LET DTid(dmx)=0
               LET dmx=dmx-1
            END IF
            WAIT DELAY wd
            EXIT SUB
         END IF
      NEXT i
      WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
   CASE 3  ! [更新]
      DO
         INPUT PROMPT " 更新するDATAのID番号を入力 (キャンセルは 0)" :id
      LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
      WAIT DELAY wd
      IF id=0 THEN EXIT SUB
      FOR i=1 TO dmx
         IF DTid(i)=id THEN
            LET d$="下記のDATAを書き換えますか？"&CHR$(10)&"ID："&DT$(i,1)
            LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
            IF CONFIRM$(d$)="NO" THEN EXIT SUB
            PRINT "更新前のDATA"
            PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
            DO
               INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
               WAIT DELAY wd
               IF name$="0" THEN EXIT SUB
               INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
               WAIT DELAY wd
               IF tel$="0" THEN EXIT SUB
               LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
               LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
               IF CONFIRM$(c$)="YES" THEN
                  LET DT$(i,2)=name$
                  LET DT$(i,3)=tel$
                  CALL tel(DTtel$(i),DT$(i,3))
                  EXIT DO
               END IF
            LOOP
            WAIT DELAY wd
            EXIT SUB
         END IF
      NEXT i
      WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
   CASE 4  ! [検索]
      DO
         INPUT PROMPT " 検索項目  1.氏名  2.電話番号  (キャンセルは 0)": sa
      LOOP UNTIL sa=INT(sa) AND sa>=0 AND sa<=2
      WAIT DELAY wd
      IF sa=0 THEN EXIT SUB
      INPUT PROMPT " 検索文字列 (一部分でも可, キャンセルは 0)": sa$
      WAIT DELAY wd
      IF sa$="0" THEN EXIT SUB
      IF sa=1 THEN LET t$="氏名" ELSE LET t$="電話番号"
      PRINT "検索結果 [";t$;",""";sa$;"""]"
      LET sr=0
      IF sa=1 THEN
         FOR i=1 TO dmx
            IF POS(DT$(i,2),sa$)>0 THEN
               PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
               LET sr=sr+1
            END IF
         NEXT i
      ELSE  ! sa=2
         FOR j=LEN(sa$) TO 1 STEP -1
            IF sa$(j:j)<"0" OR sa$(j:j)>"9" THEN LET sa$(j:j)=""
         NEXT j
         FOR i=1 TO dmx
            IF POS(DTtel$(i),sa$)>0 THEN
               PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
               LET sr=sr+1
            END IF
         NEXT i
      END IF
      IF sr=0 THEN PRINT "該当するDATAはありませんでした"
   CASE 5  ! [一覧]
      DO
         INPUT PROMPT " 1.DATA順  2.ID番号順  (キャンセルは 0)" : li
      LOOP UNTIL li=INT(li) AND li>=0 AND li<=2
      IF li=1 THEN
         PRINT "DATA一覧"
         FOR i=1 TO dmx
            PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
         NEXT i
      ELSEIF li=2 THEN
         MAT sortID=ZER
         CALL sort(DTid,sortID,dmx)
         PRINT "DATA一覧 (ID番号順)"
         FOR i=1 TO dmx
            PRINT USING u$: DT$(sortID(i),1),DT$(sortID(i),2),DT$(sortID(i),3)
         NEXT i
      END IF
   CASE 6  ! [保存]
      CALL save
CASE 0  ! [終了]
      IF CONFIRM$("プログラムを終了しますか？")="NO" THEN  ! 訂正
         LET n=7   ! 訂正
         EXIT SUB  ! 訂正
      END IF       ! 訂正
      IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
      CLOSE #1
   END SELECT
   WAIT DELAY wd
END SUB
!
SUB save
   IF f=1 THEN
      FILE GETSAVENAME s$
      OPEN #1: NAME s$
      LET f=f+10
   END IF
   ERASE #1
   FOR i=1 TO dmx
      IF DTid(i)<>0 THEN PRINT#1: DT$(i,1)&","&DT$(i,2)&","&DT$(i,3)
   NEXT i
END SUB
!
SUB tel(t$,d$)
   LET t$=""
   FOR j2=1 TO LEN(d$)
      IF d$(j2:j2)>="0" AND d$(j2:j2)<="9" THEN LET t$=t$&d$(j2:j2)
   NEXT j2
END SUB
!
END
! 十進BASICライブラリ"\Decimal BASIC\BASICw32\Library\SORT2.LIB"
! ixにはmと下限，上限を一致させた空の配列を指定する。
! mは参照されるのみ。
! ixにmの添字を大きさの順に並べて返す。
! つまり，m(ix(1))≦m(ix(2))≦m(ix(3))≦･･･となる。
EXTERNAL SUB sort(m(),ix(),n)  ! ソート
DECLARE EXTERNAL SUB q_sort
DECLARE NUMERIC i
FOR i=1 TO n
   LET ix(i)=i
NEXT i
CALL q_sort(m,ix,1,n)
END SUB
!
EXTERNAL SUB q_sort(m(),a(),l,r)
DECLARE NUMERIC i,j,pv,t
IF r<=l THEN
   EXIT SUB
ELSE
   LET i=l-1
   LET j=r
   LET pv=m(a(r))
   DO
      DO
         LET i=i+1
      LOOP UNTIL pv<=m(a(i))
      DO
         LET j=j-1
      LOOP UNTIL j<=i OR m(a(j))<=pv
      IF j<=i THEN EXIT DO
      LET t=a(i)
      LET a(i)=a(j)
      LET a(j)=t
   LOOP
   LET t=a(i)
   LET a(i)=a(r)
   LET a(r)=t
   CALL q_sort(m,a,l,i-1)
   CALL q_sort(m,a,i+1,r)
END IF
END SUB
END


> RCカーさんへのお返事です。
>
> >ID番号を、1からではなく、1001からにしたのは、何か理由がありますか？？
>
> → 4桁に揃えただけで特に意味はありません。
> ID番号の下限、上限は IDmin,IDmaxで設定できるので、目的に合った値に変更してください。
> また、入力データのID番号は連番でなくともかまいません。
> 例えば IDmin=1,IDmax=100 に設定し、入力を 20,15,4,16,27,…といった順番で入力してもかまいません。
> データ一覧の出力は、入力した順とID番号順の並びを選択できます。
>
>
> >データ入力ダイアログで、数字を、入れずに、OKを、クリックしたとき、シンタックスエラーが出ます。input文に、イレギュラーな、場合にどうするかを、しょりほうほうを、プログラムで、決めないと、駄目なのかな？、教えて下さい。
>
> → input文で数値変数に入力するときに数値以外(空文字列も含む)を入力すると再入力を促すのは十進BASICの仕様なので、利用者はどうすることもできません。
> ただし、文字列変数に入力するようにすれば空文字列の入力も認められるので、[OK]クリックで[0]を入力したのと同じ扱いにすることはできます。
>
> -----------------------------------------------------------------------------
> DO   ! メインルーチン
>    DO
>       INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n
>    LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
>    WAIT DELAY wd
>    CALL main(n)
> LOOP UNTIL n=0
> -----------------------------------------------------------------------------
> 上記の部分を、次のようにすれば[OK]クリックや[Enter]キーで[0]と同じ扱い。
> -----------------------------------------------------------------------------
> WHEN EXCEPTION IN
>    DO   ! メインルーチン
>       DO
>          INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n$  !文字列変数入力
>          LET n=VAL(n$)   ! 文字列変数を数値に変換。空文字列や"abc"などは例外発生。
>       LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
>       WAIT DELAY wd
>       CALL main(n)
>    LOOP UNTIL n=0
> USE  ! 例外発生時の処理
>    LET n=0
>    CONTINUE
> END WHEN
> -----------------------------------------------------------------------------
>
>
> ◎ 重要なバグを発見しました。
> "プログラムを終了しますか？" というメッセージボックスで[いいえ]を選択しても終了してしまいます。
> 副プログラム SUB main(n) 内のselect区で、CASE 0 を次のように修正してください。
> --------------------------------------------------------------------------
> 【誤】
>   CASE 0  ! [終了]
>       IF CONFIRM$("プログラムを終了しますか？")="NO" THEN EXIT SUB
>       IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
>       CLOSE #1
>    END SELECT
> --------------------------------------------------------------------------
> 【正】
>   CASE 0  ! [終了]
>       IF CONFIRM$("プログラムを終了しますか？")="NO" THEN  ! 訂正
>          LET n=7   ! 訂正
>          EXIT SUB  ! 訂正
>       END IF       ! 訂正
>       IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
>       CLOSE #1
>    END SELECT
> -------------------------------------------------------------------------- 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：RCカー  投稿日：2021年 8月13日(金)11時49分56秒
  > No.4944[元記事へ]

nagramさんへのお返事です。

　　まだ、シンタックスエラーがでて、
　　また、終了しますか　　いいえ　　で、終了してしまいます。

> RCカーさんへのお返事です。
>
> >ID番号を、1からではなく、1001からにしたのは、何か理由がありますか？？
>
> → 4桁に揃えただけで特に意味はありません。
> ID番号の下限、上限は IDmin,IDmaxで設定できるので、目的に合った値に変更してください。
> また、入力データのID番号は連番でなくともかまいません。
> 例えば IDmin=1,IDmax=100 に設定し、入力を 20,15,4,16,27,…といった順番で入力してもかまいません。
> データ一覧の出力は、入力した順とID番号順の並びを選択できます。
>
>
> >データ入力ダイアログで、数字を、入れずに、OKを、クリックしたとき、シンタックスエラーが出ます。input文に、イレギュラーな、場合にどうするかを、しょりほうほうを、プログラムで、決めないと、駄目なのかな？、教えて下さい。
>
> → input文で数値変数に入力するときに数値以外(空文字列も含む)を入力すると再入力を促すのは十進BASICの仕様なので、利用者はどうすることもできません。
> ただし、文字列変数に入力するようにすれば空文字列の入力も認められるので、[OK]クリックで[0]を入力したのと同じ扱いにすることはできます。
>
> -----------------------------------------------------------------------------
> DO   ! メインルーチン
>    DO
>       INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n
>    LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
>    WAIT DELAY wd
>    CALL main(n)
> LOOP UNTIL n=0
> -----------------------------------------------------------------------------
> 上記の部分を、次のようにすれば[OK]クリックや[Enter]キーで[0]と同じ扱い。
> -----------------------------------------------------------------------------
> WHEN EXCEPTION IN
>    DO   ! メインルーチン
>       DO
>          INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n$  !文字列変数入力
>          LET n=VAL(n$)   ! 文字列変数を数値に変換。空文字列や"abc"などは例外発生。
>       LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
>       WAIT DELAY wd
>       CALL main(n)
>    LOOP UNTIL n=0
> USE  ! 例外発生時の処理
>    LET n=0
>    CONTINUE
> END WHEN
> -----------------------------------------------------------------------------
>
>
> ◎ 重要なバグを発見しました。
> "プログラムを終了しますか？" というメッセージボックスで[いいえ]を選択しても終了してしまいます。
> 副プログラム SUB main(n) 内のselect区で、CASE 0 を次のように修正してください。
> --------------------------------------------------------------------------
> 【誤】
>   CASE 0  ! [終了]
>       IF CONFIRM$("プログラムを終了しますか？")="NO" THEN EXIT SUB
>       IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
>       CLOSE #1
>    END SELECT
> --------------------------------------------------------------------------
> 【正】
>   CASE 0  ! [終了]
>       IF CONFIRM$("プログラムを終了しますか？")="NO" THEN  ! 訂正
>          LET n=7   ! 訂正
>          EXIT SUB  ! 訂正
>       END IF       ! 訂正
>       IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
>       CLOSE #1
>    END SELECT
> -------------------------------------------------------------------------- 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：nagram  投稿日：2021年 8月13日(金)19時31分45秒
  RCカーさんへのお返事です。

> 　　まだ、シンタックスエラーがでて、

→ 前回の投稿で改善したのはメインメニューの部分だけなので、他の部分での数値変数のinput文ではエラーになります。


> 　　また、終了しますか　　いいえ　　で、終了してしまいます。

→ マウスの左ボタンやEnterキーを長く押すと次の入力ボックスに制御が移り、そこで空文字列を入力したと認識されてしまうのが原因です。
それを回避するために WAIT DELAY wd (wdは0.1秒に設定) で一時休止しているのですが、0.1秒を超えて押すと次の制御に移ります。
対策の一つは、変数wdを0.5ぐらいに設定することです。ただし素早く操作したい利用者には不評でしょう。
もう一つは、GetKeyState関数を使いマウスボタンやEnterキーが解放されるのを待つということです。
ヘルプにはありませんが、GetKeyState(1)でマウスの左ボタン、GetKeyState(2)で右ボタンの状態を得ることが出来ます。
   DO
   LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
上記の2行をマウスやEnterキーの操作ごとに記述しました。
マウスの左ボタンとEnterキーの指を離すまで、次の行に移りません。


DECLARE EXTERNAL SUB sort
DECLARE NUMERIC MX,IDmin,IDmax,lenID,lenname,lentel,dmx,f,n,id,li,sa,sr,i,j,j2
DECLARE STRING idrange$,u$,s$,name$,tel$,d$,c$,sa$,t$,f$,n$,id$,sa2$,li$
OPTION CHARACTER KANJI
LET MX=200      ! data数の上限(変更可)
LET IDmin=1001  ! ID番号の下限(変更可) IDmin>=1
LET IDmax=9999  ! ID番号の上限(変更可)
LET lenID=CEIL(LOG10(IDmax))+1
LET lenNAME=8   ! 氏名の最大文字数(変更可)
LET lenTEL=14   ! 電話番号の最大文字数(変更可)
DIM DT$(MX,3),DTid(MX),DTtel$(MX),sortID(MX)
LET idrange$=STR$(IDmin)&"～"&STR$(IDmax)
LET u$=REPEAT$("#",lenID)&" <"&REPEAT$("#",2*lenNAME-1)&" <"&REPEAT$("#",lenTEL)
SET ECHO "OFF"
LET dmx=0
!
WHEN EXCEPTION IN
   DO
      INPUT PROMPT "【ファイル】1.新規作成 2.読込み (終了は 0)":f$
      LET f=VAL(f$)
   LOOP UNTIL f=INT(f) AND f>=0 AND f<=2
USE
   LET f=0
   CONTINUE
END WHEN
DO
LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
IF f=1 THEN
   CALL main(1)
ELSEIF f=2 THEN
   FILE GETOPENNAME s$  ! 電話帳ファイルの読込み
   OPEN #1: NAME s$
   DO
      LET dmx=dmx+1
      INPUT #1, IF MISSING THEN EXIT DO: DT$(dmx,1),DT$(dmx,2),DT$(dmx,3)
      LET DTid(dmx)=VAL(DT$(dmx,1))
      CALL tel(DTtel$(dmx),DT$(dmx,3))
   LOOP
   LET dmx=dmx-1
   DO
   LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
ELSE
   STOP
END IF
!
WHEN EXCEPTION IN
   DO   ! メインルーチン
      DO
         INPUT PROMPT " 1.入力 2.削除 3.更新 4.検索 5.一覧 6.保存 0.終了" :n$
         LET n=VAL(n$)
      LOOP UNTIL n=INT(n) AND n>=0 AND n<=6
      DO
      LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
      CALL main(n)
   LOOP UNTIL n=0
USE
   LET n=0
   CONTINUE
END WHEN
!
SUB main(n)
   SELECT CASE n
   CASE 1  ! [入力]
      DO
         IF dmx>=MX THEN
            WAIT DELAY "DATA数が上限 "&STR$(MX)&" に達していて、入力が出来ません"
            DO
            LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
            EXIT SUB
         END IF
         WHEN EXCEPTION IN
            DO
               INPUT PROMPT " ID番号入力 "&idrange$&" (入力終了は 0)" :id$
               LET id=VAL(id$)
            LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
         USE
            LET id=0
            CONTINUE
         END WHEN
         DO
         LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
         IF id=0 THEN EXIT DO
         INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
         DO
         LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
         IF name$="0" OR name$="" THEN EXIT DO
         INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
         DO
         LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
         IF tel$="0" OR tel$="" THEN EXIT DO
         LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
         LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
         IF CONFIRM$(c$)="YES" THEN
            LET dmx=dmx+1
            LET DT$(dmx,1)=STR$(id)
            LET DT$(dmx,2)=name$
            LET DT$(dmx,3)=tel$
            LET DTid(dmx)=id
            CALL tel(DTtel$(dmx),DT$(dmx,3))
         END IF
         DO
         LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
      LOOP
   CASE 2  ! [削除]
      WHEN EXCEPTION IN
         DO
            INPUT PROMPT " 削除するDATAのID番号を入力 (キャンセルは 0)" :id$
            LET id=VAL(id$)
         LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
      USE
         LET id=0
         CONTINUE
      END WHEN
      DO
      LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
      IF id=0 THEN EXIT SUB
      FOR i=1 TO dmx
         IF DTid(i)=id THEN
            LET d$="下記のDATAを削除しますか？"&CHR$(10)&"ID："&DT$(i,1)
            LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
            IF CONFIRM$(d$)="YES" THEN
               PRINT "削除したDATA"
               PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
               FOR j=i+1 TO dmx
                  LET DT$(j-1,1)=DT$(j,1)
                  LET DT$(j-1,2)=DT$(j,2)
                  LET DT$(j-1,3)=DT$(j,3)
                  LET DTid(j-1)=VAL(DT$(j,1))
                  LET DTtel$(j-1)=DTtel$(j)
               NEXT j
               LET DT$(dmx,1),DT$(dmx,2),DT$(dmx,3),DTtel$(dmx)=""
               LET DTid(dmx)=0
               LET dmx=dmx-1
            END IF
            DO
            LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
            EXIT SUB
         END IF
      NEXT i
      WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
   CASE 3  ! [更新]
      WHEN EXCEPTION IN
         DO
            INPUT PROMPT " 更新するDATAのID番号を入力 (キャンセルは 0)" :id$
            LET id=VAL(id$)
         LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
      USE
         LET id=0
         CONTINUE
      END WHEN
      DO
      LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
      IF id=0 THEN EXIT SUB
      FOR i=1 TO dmx
         IF DTid(i)=id THEN
            LET d$="下記のDATAを書き換えますか？"&CHR$(10)&"ID："&DT$(i,1)
            LET d$=d$&CHR$(10)&"氏名："&DT$(i,2)&CHR$(10)&"電話番号："&DT$(i,3)
            IF CONFIRM$(d$)="NO" THEN EXIT SUB
            PRINT "更新前のDATA"
            PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
            DO
            LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
            DO
               INPUT PROMPT " 氏名を入力 (入力終了は 0)" :name$
               DO
               LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
               IF name$="0" OR name$="" THEN EXIT SUB
               INPUT PROMPT " 電話番号を入力 (入力終了は 0)" :tel$
               DO
               LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
               IF tel$="0" OR tel$="" THEN EXIT SUB
               LET c$="このDATAで良いですか？ 訂正は [いいえ]"&CHR$(10)&"ID："
               LET c$=c$&STR$(id)&CHR$(10)&"氏名："&name$&CHR$(10)&"電話番号："&tel$
               IF CONFIRM$(c$)="YES" THEN
                  LET DT$(i,2)=name$
                  LET DT$(i,3)=tel$
                  CALL tel(DTtel$(i),DT$(i,3))
                  EXIT DO
               END IF
            LOOP
            DO
            LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
            EXIT SUB
         END IF
      NEXT i
      WAIT DELAY "ID番号 "&STR$(id)&" のDATAが見つかりません"
   CASE 4  ! [検索]
      WHEN EXCEPTION IN
         DO
            INPUT PROMPT " 検索項目  1.氏名  2.電話番号  (キャンセルは 0)": sa2$
            LET sa=VAL(sa2$)
         LOOP UNTIL sa=INT(sa) AND sa>=0 AND sa<=2
      USE
         LET sa=0
         CONTINUE
      END WHEN
      DO
      LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
      IF sa=0 THEN EXIT SUB
      INPUT PROMPT " 検索文字列 (一部分でも可, キャンセルは 0)": sa$
      DO
      LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
      IF sa$="0" OR sa$="" THEN EXIT SUB
      IF sa=1 THEN LET t$="氏名" ELSE LET t$="電話番号"
      PRINT "検索結果 [";t$;",""";sa$;"""]"
      LET sr=0
      IF sa=1 THEN
         FOR i=1 TO dmx
            IF POS(DT$(i,2),sa$)>0 THEN
               PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
               LET sr=sr+1
            END IF
         NEXT i
      ELSE  ! sa=2
         FOR j=LEN(sa$) TO 1 STEP -1
            IF sa$(j:j)<"0" OR sa$(j:j)>"9" THEN LET sa$(j:j)=""
         NEXT j
         FOR i=1 TO dmx
            IF POS(DTtel$(i),sa$)>0 THEN
               PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
               LET sr=sr+1
            END IF
         NEXT i
      END IF
      IF sr=0 THEN PRINT "該当するDATAはありませんでした"
   CASE 5  ! [一覧]
      WHEN EXCEPTION IN
         DO
            INPUT PROMPT " 1.DATA順  2.ID番号順  (キャンセルは 0)" : li$
            LET li=VAL(li$)
         LOOP UNTIL li=INT(li) AND li>=0 AND li<=2
      USE
         LET li=0
         CONTINUE
      END WHEN
      DO
      LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
      IF li=1 THEN
         PRINT "DATA一覧"
         FOR i=1 TO dmx
            PRINT USING u$: DT$(i,1),DT$(i,2),DT$(i,3)
         NEXT i
      ELSEIF li=2 THEN
         MAT sortID=ZER
         CALL sort(DTid,sortID,dmx)
         PRINT "DATA一覧 (ID番号順)"
         FOR i=1 TO dmx
            PRINT USING u$: DT$(sortID(i),1),DT$(sortID(i),2),DT$(sortID(i),3)
         NEXT i
      END IF
   CASE 6  ! [保存]
      CALL save
   CASE 0  ! [終了]
      IF CONFIRM$("プログラムを終了しますか？")="NO" THEN
         LET n=7
         DO
         LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
         EXIT SUB
      END IF
      DO
      LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
      IF CONFIRM$("DATAをファイルに保存しますか？")="YES" THEN CALL save
      CLOSE #1
   END SELECT
   DO
   LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
END SUB
!
SUB save
   IF f=1 THEN
      FILE GETSAVENAME s$
      OPEN #1: NAME s$
      LET f=f+10
   END IF
   ERASE #1
   FOR i=1 TO dmx
      IF DTid(i)<>0 THEN PRINT#1: DT$(i,1)&","&DT$(i,2)&","&DT$(i,3)
   NEXT i
END SUB
!
SUB tel(t$,d$)
   LET t$=""
   FOR j2=1 TO LEN(d$)
      IF d$(j2:j2)>="0" AND d$(j2:j2)<="9" THEN LET t$=t$&d$(j2:j2)
   NEXT j2
END SUB
!
END
! 十進BASICライブラリ"\Decimal BASIC\BASICw32\Library\SORT2.LIB"
! ixにはmと下限，上限を一致させた空の配列を指定する。
! mは参照されるのみ。
! ixにmの添字を大きさの順に並べて返す。
! つまり，m(ix(1))≦m(ix(2))≦m(ix(3))≦･･･となる。
EXTERNAL SUB sort(m(),ix(),n)  ! ソート
DECLARE EXTERNAL SUB q_sort
DECLARE NUMERIC i
FOR i=1 TO n
   LET ix(i)=i
NEXT i
CALL q_sort(m,ix,1,n)
END SUB
!
EXTERNAL SUB q_sort(m(),a(),l,r)
DECLARE NUMERIC i,j,pv,t
IF r<=l THEN
   EXIT SUB
ELSE
   LET i=l-1
   LET j=r
   LET pv=m(a(r))
   DO
      DO
         LET i=i+1
      LOOP UNTIL pv<=m(a(i))
      DO
         LET j=j-1
      LOOP UNTIL j<=i OR m(a(j))<=pv
      IF j<=i THEN EXIT DO
      LET t=a(i)
      LET a(i)=a(j)
      LET a(j)=t
   LOOP
   LET t=a(i)
   LET a(i)=a(r)
   LET a(r)=t
   CALL q_sort(m,a,l,i-1)
   CALL q_sort(m,a,i+1,r)
END IF
END SUB 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：RCカー  投稿日：2021年 8月13日(金)19時39分34秒
  > No.4948[元記事へ]

nagramさんへのお返事です。

早速の御返信ありがとうございます。 		 

Re: 電話帳プログラム作成プロセスと、プログラムの例

 投稿者：nagram  投稿日：2021年 8月15日(日)18時29分40秒
  > No.4949[元記事へ]

RCカーさんへのお返事です。

不具合を発見したので修正をお願いします。
ID番号の重複チェックをしていませんでした。同じID番号での登録ができてしまいます。
副プログラム SUB main(n) の select区 CASE 1 の WHEN EXCEPTION IN ～ END WHEN の部分を下記のように修正してください。

---------------------------------------------------------------------------------
【誤】
WHEN EXCEPTION IN
   DO
      INPUT PROMPT " ID番号入力 "&idrange$&" (入力終了は 0)" :id$
      LET id=VAL(id$)
   LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
USE
   LET id=0
   CONTINUE
END WHEN
---------------------------------------------------------------------------------
【正】
WHEN EXCEPTION IN
   DO
      LET check=0
      DO
         INPUT PROMPT " ID番号入力 "&idrange$&" (入力終了は 0)" :id$
         LET id=VAL(id$)
         DO
         LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
      LOOP UNTIL id=INT(id) AND id>=IDmin AND id<=IDmax OR id=0
      FOR i=1 TO dmx
         IF DTid(i)=id THEN
            LET c$="ID番号 "&id$&" は既に使われています。"&CHR$(10)
            LET c$=c$&"他の番号にするか、[削除]または[更新]を利用してください。"
            WAIT DELAY c$
            DO
            LOOP UNTIL GetKeyState(1)>=0 AND GetKeyState(13)>=0
            LET check=1
            EXIT FOR
         END IF
      NEXT i
   LOOP UNTIL check=0
USE
   LET id=0
   CONTINUE
END WHEN
--------------------------------------------------------------------------------- 		 

戻る