付録 - 茨城県教育研修センター

付　　　録

実験計測のためのプログラム
　Ⅰ章で利用したプログラム
DECLARE SUB InputMessage ()
DECLARE SUB Title ()
DECLARE SUB Menu ()
DECLARE SUB ComInit ()
DECLARE SUB SourdPlot (XR())
DECLARE SUB SourdPlot2 (A, XR())
DECLARE SUB SourdPlot3 (FIL$, XR())
DECLARE SUB SourdPlot4 (KAI, A, FIL$, XR(), FLAG)
DECLARE SUB Save (XR())
DECLARE SUB Load (KAI, FIL$, A, XR(), FLAG)
DECLARE SUB Waku (A)
DECLARE SUB Waku1 ()
DECLARE SUB Waku2 ()
DECLARE SUB Waku3 ()
DECLARE SUB Plot (KAI, FIL$, A, XR(), FLAG)
DECLARE SUB Plot1 (XR())
DECLARE SUB Plot2 (XR())
DECLARE SUB Plot3 (XR())
DECLARE SUB Erabu (A%, X, A)
DECLARE SUB Erabu2 (A%, X, YOKO)
DECLARE SUB LPUTC (C%)
DECLARE SUB LPUTS (A$)

'$INCLUDE: 'QB. BI'
'$INCLUDE: 'GRAPH. BI'

DIM SHARED XR(128), A%(2000)

CONST XO = 25, YO = 17, UX = 10, UY = 1, XFS = 10, YFS = 5, LO = 211, RO = 18, X = 160, N = 1, KAGE = 10

CLS

VIEW PRINT 1 TO 24

HAJIME:

BEEP

CALL Title

DO
   IK$ = INKEY$
LOOP WHILE IK$ = ""
BEEP

B:

CALL Menu

CALL Erabu(A%, X, A)

CLS 2

SELECT CASE A

   CASE 1
        BEEP
        CALL ComInit
        CLS
        CALL InputMessage
        CALL Waku(1)
AA:
        IK$ = ""
        DO WHILE IK$ = ""
                CALL SoundPlot(XR())
                IK$ = INKEY$
        LOOP
        IF IK$ <> CHR$(32) THEN GOTO AA
        CLOSE #1
        CALL Save(XR()): CLS 2: GOTO B
        
   CASE 2
        BEEP
        CLS
        CALL Waku(2)
        CALL Load(KAI, FIL$, A, XR(), FLAG): CLS 2: GOTO B
        
   CASE 3
        BEEP
        CLS
        CALL Waku1
        CALL Waku2
        CALL Waku3
        CALL Load(KAI, FIL$, A, XR(), FLAG): CLS 2: GOTO B
        
   CASE 4
        BEEP
        CLS
        KAI = 0
        CALL Waku(4)
        CALL Load(KAI, FIL$, A, XR(), FLAG): CLS 2: GOTO B

END SELECT

LOCATE 1, 1
BEEP
CLS

END


SUB ComInit
   OPEN "COM1:9600,N,8,1,ASC" FOR RANDOM AS 1
END SUB

SUB Erabu (A%, X, A)
        LINE (160, 96)-(450, 112), 12, BF
        GET (160, 96)-(459, 112), A%
        LINE (160, 96)-(459, 112), 0, BF
start1:
        X = 96: A = 1
        PUT (160, X), A%, XOR
ittr1:
        A$ = INKEY$: IF A$ = "" THEN GOTO ittr1
        IF A$ <> CHR$(0) + CHR$(&H48) AND A$ <> CHR$(0) + CHR$(&H50) AND A$ <> CHR$(13) THEN BEEP: GOTO ittr1
        PUT (160, X), A%, XOR
        IF (A = 5 AND A$ = CHR$(0) + CHR$(&H50)) OR (A = 1 AND A$ = CHR$(0) + CHR$(&H48)) THEN PUT (160, X), A%: GOTO ittr1
        IF A$ = CHR$(0) + CHR$(&H50) THEN BEEP: X = X + 16 * 3: A = A + 1: PUT (160, X), A%: IF A > 5 THEN GOTO start1
        IF A$ = CHR$(0) + CHR$(&H48) THEN BEEP: X = X - 16 * 3: A = A - 1: PUT (160, X), A%: IF A < 1 THEN GOTO start1
        IF A$ <> CHR$(13) THEN GOTO ittr1
END SUB

SUB Erabu2 (A%, X, YOKO)
        VIEW SCREEN (0, 0)-(639, 399)
        LINE (80, 368)-(128, 384), 12, BF
        GET (80, 368)-(128, 384), A%
        LINE (80, 368)-(128, 384), 0, BF
        COLOR 23
        LOCATE 22, 1:PRINT "　　　　　→←で選んで，リターンキーを押して下さい　！　　　　　";
        LOCATE 24, 11: COLOR 6:PRINT "波形Ａ　　　　波形Ｂ　　　　波形Ｃ　　　　";
        LOCATE 24, 65: COLOR 2:PRINT "メニューへ";
start1:
        X = 80: YOKO = 1
        PUT (X, 368), A%, XOR
ittr:
        A$ = INKEY$: IF A$ = "" THEN GOTO ittr
        IF A$ <> CHR$(0) + CHR$(&H4D) AND A$ <> CHR$(0) + CHR$(&H4B) AND A$ <> CHR$(13) THEN GOTO ittr
        PUT (X, 368), A%, XOR
        IF (YOKO = 4 AND A$ = CHR$(0) + CHR$(&H4D)) OR (YOKO = 1 AND A$ = CHR$(0) + CHR$(&H4B)) THEN PUT (X, 368), A%: GOTO ittr
        IF A$ = CHR$(0) + CHR$(&H4D) THEN BEEP: X = X + 16 * 9: YOKO = YOKO + 1: PUT (X, 368), A%: IF YOKO > 4 THEN GOTO start
        IF A$ = CHR$(0) + CHR$(&H4B) THEN BEEP: X = X - 16 * 9: YOKO = YOKO - 1: PUT (X, 368), A%: IF YOKO < 1 THEN GOTO start
        IF A$ <> CHR$(13) THEN GOTO ittr
        LOCATE 12, 53: PRINT "　　　　　　　　　　";
        LOCATE 14, 53: PRINT "　　　　　　　　　　";
        BEEP
END SUB

SUB InputMessage
 COLOR 6
 LOCATE 12, 53: PRINT "取り込みたいところで"
 LOCATE 14, 53: PRINT "スペースキーを押して下さい"
END SUB

SUB Load (KAI, FIL$, A, XR(), FLAG)
 FLAG = 0
j:
 IF A <> 4 THEN GOTO G
 LOCATE 4, 22: COLOR 7: PRINT "取り込んだ波形を重ね合わせます"
 LOCATE 10, 60: COLOR 7: PRINT "ー　波形Ａ"
 LOCATE 13, 60: COLOR 6: PRINT "ー　波形Ｂ"
 LOCATE 16, 60: COLOR 4: PRINT "ー　波形Ｃ"
G:
 IF A <> 3 THEN GOTO K
 LOCATE 4, 26: COLOR 7: PRINT "取り込んだ波形を表示します"
 LOCATE 6, 12: PRINT "波形Ａ": LOCATE 6, 38: PRINT "波形Ｂ": LOCATE 6, 64: PRINT "波形Ｃ"
K:
 COLOR 7
 CALL Erabu2(A%, X, YOKO)
 IF YOKO = 1 THEN FIL$ = "波形Ａ"
 IF YOKO = 2 THEN FIL$ = "波形Ｂ"
 IF YOKO = 3 THEN FIL$ = "波形Ｃ"
 IF YOKO = 4 THEN GOTO H
 OPEN FIL$ FOR INPUT AS #1
   FOR i = 1 TO 128
      INPUT #1, XR(i)
   NEXT
 CLOSE #1
 IF A = 2 THEN CALL SoundPlot2(A, XR())
 IF A = 3 THEN CALL SoundPlot3(FIL$, XR())
 IF A = 4 THEN FLAG = 1: CALL SoundPlot4(KAI, A, FIL$, XR(), FLAG)
 LOCATE 4, 17: PRINT "　　　　　取り込んだ波形です　　"
 IF A = 2 THEN GOTO K
 IF A = 3 OR A = 4 THEN GOTO j
H:
END SUB

SUB LPUTC (C%)
 WHILE (INP(&H42) AND 4) <> 4
 WEND
 OUT &H40, C%
 OUT &H46, 14
 OUT &H46, 15
END SUB

SUB LPUTC (A$)
 FOR K = 1 TO LEN(A$)
        C% = ASC(MID$(A$, K, 1))
        LPUTC C%
 NEXT K
END SUB

SUB Menu
 CLS
 LINE (0, 0)-(639, 399), 9, BF
 LINE (16 * 8, 5 * 16)-(60 * 8, 20 * 16), 7, B
 LINE (16 * 8 + 1, 5 * 16 + 1)-(60 * 8 - 1, 20 * 16 - 1), 0, BF
 COLOR 15
 LOCATE 3, 28: PRINT "オペレーションメニュー"
 COLOR 6
 LOCATE 7, 21: PRINT "１　波形を取り込む　・・・・"
 LOCATE 10, 21: PRINT "２　波形を確認する　・・・・"
 LOCATE 13, 21: PRINT "３　波形を比べる　・・・・・"
 LOCATE 16, 21: PRINT "４　波形を重ねる　・・・・・"
 COLOR 2
 LOCATE 19, 21: PRINT "５　終了　・・・・・・・・・"
 COLOR 21
 LOCATE 23, 17: PRINT "↑　↓で選んで，リターンキーを押して下さい　！"
 COLOR 7
END SUB

SUB Plot (KAI, FIL$, A, XR(), FLAG)
IF A = 1 OR A = 2 THEN col = 7
IF A = 4 AND FIL$ = "波形Ａ" THEN col = 7
IF A = 4 AND FIL$ = "波形Ｂ" THEN col = 6
IF A = 4 AND FIL$ = "波形Ｃ" THEN col = 4
IF A = 4 THEN KAI = KAI + 1
IF KAI >= 3 OR FLAG = 1 THEN GOTO L
  FOR i = 1 TO XFS - 1
        LINE (8 * XO + 8 * UX * 128 / XFS * i / 50, 16 * YO + 8 - 2 * UY * (-50) - 80 - 1)-
             (8 * XO + 8 * UX * 128 / XFS * i / 50, 16 * YO + 8 - 2 * UY * 50 - 80 + 1), 4, , &H8888
  NEXT
  FOR i = -YFS + 1 TO YFS - 1
        LINE (8 * XO, 16 * YO + 8 - 2 * UY * 10 * i - 80)-
             (8 * XO + 8 * UX * 128 / 50, 16 * YO + 8 - 2 * UY * 10 * i - 80), 4, , &H8888
  NEXT
L:
  COLOR col
  i = 2: PSET (8 * XO + 8 * UX * 1.28 * (i - 1) / 50, 16 * YO + 8 - 2 * UY * XR(i) - 80)
  FOR i = 3 TO 99
        LINE -(8 * XO + 8 * UX * 1.28 * (i - 1) / 50, 16 * YO + 8 - 2 * UY * XR(i) - 80)
  NEXT

END SUB

SUB Plot1 (XR())
  i = 2: PSET (8 * XO + 8 * UX * 1.28 * (i - 1) / 50 - LO + RO, 16 * YO + 8 - 2 * UY * XR(i) - 80)
  FOR i = 3 TO 99
        LINE -(8 * XO + 8 * UX * 1.28 * (i - 1) / 50 - LO + RO, 16 * YO + 8 - 2 * UY * XR(i) - 80), 7
  NEXT
END SUB

SUB Plot2 (XR())
  i = 2: PSET (8 * XO + 8 * UX * 1.28 * (i - 1) / 50 + RO, 16 * YO + 8 - 2 * UY * XR(i) - 80)
  FOR i = 3 TO 99
        LINE -(8 * XO + 8 * UX * 1.28 * (i - 1) / 50 + RO, 16 * YO + 8 - 2 * UY * XR(i) - 80), 7
  NEXT
END SUB

SUB Plot3 (XR())
  i = 2: PSET (8 * XO + 8 * UX * 1.28 * (i - 1) / 50 + LO + RO, 16 * YO + 8 - 2 * UY * XR(i) - 80)
  FOR i = 3 TO 99
        LINE -(8 * XO + 8 * UX * 1.28 * (i - 1) / 50 + LO + RO, 16 * YO + 8 - 2 * UY * XR(i) - 80), 7
  NEXT
END SUB

SUB Save (XR())
BEEP
LOCATE 4, 15: PRINT "　　　　　この波形を取り込みました　　　　　"
COLOR 7
LOCATE 12, 53: PRINT "どこに保存しますか？"
LOCATE 14, 53: PRINT "保存しないときはメニューへ"
CALL Erabu2(A%, X, YOKO)
        IF YOKO = 1 THEN FIL$ = "波形Ａ"
        IF YOKO = 2 THEN FIL$ = "波形Ｂ"
        IF YOKO = 3 THEN FIL$ = "波形Ｃ"
        IF YOKO = 4 THEN GOTO GG
 OPEN FIL$ FOR OUTPUT AS #1
   FOR i = 1 TO 128
   WHILE #1, XR(i)
   NEXT
 CLOSE #1
GG:
END SUB
 SUB SoundPlot (XR())
   PRINT #1, "c"
   DO WHILE INPUT$(1, #1) <> "e"
   LOOP
   PRINT #1, "i"
   FOR i = 1 TO 100
         LINE INPUT #1, D$
         XR(i) = (10 * VAL("&H" + RIGHT&(D$, 2)) / 256 - 5) * 10
   NEXT
   CLS 1
  FOR i = 1 TO XFS
        LINE (8 * XO + 8 * UX * 128 / XFS * i / 50, 16 * YO + 8 - 2 * UY * (-50) - 80 - 1)-
             (8 * XO + 8 * UX * 128 / XFS * i / 50, 16 * YO + 8 - 2 * UY * 50 - 80 + 1), 4, , &H8888
  NEXT
  i = 2: PSET (8 * XO + 8 * UX * 1.28 * (i - 1) / 50, 16 * YO + 8 - 2 * UY * XR(i) - 80), 
  FOR i = 3 TO 99
        LINE -(8 * XO + 8 * UX * 1.28 * (i - 1) / 50, 16 * YO + 8 - 2 * UY * XR(i) - 80), 7
  NEXT
END SUB

SUB SoundPlot2 (A, XR())
VIEW SCREEN (8 * XO + 1, 16 * YO + 8 - 2 * UY * (-50) - 80 - 1)-
            (8 * XO + 8 * UX * 127 / 50, 16 * YO + 8 - 2 * UY * 50 - 80 + 1)
CLS 1
VIEW SCREEN (0, 0)-(639, 399)
CALL Plot(KAI, FIL$, A, XR(), FLAG)
END SUB

SUB SoundPlot3 (FIL$, XR())
IF FIL$ = "波形Ａ" THEN CALL Plot1(XR())
IF FIL$ = "波形Ｂ" THEN CALL Plot2(XR())
IF FIL$ = "波形Ｃ" THEN CALL Plot3(XR())
END SUB

SUB SoundPlot4 (KAI, A, FIL$, XR(), FLAG)
VIEW SCREEN (0, 0)-(639, 399)
CALL Plot(KAI, FIL$, A, XR(), FLAG)
END SUB

SUB Title
 CLS
 LINE (60, 60)-(580, 150), 9, BF
 LINE (59, 59)-(581, 151), 6, B
 LINE (58, 58)-(582, 152), 6, B
 LINE (57, 57)-(583, 153), 6, B
 PAINT (61, 61), 6, 9
 COLOR 6
 LOCATE 7, 15: PRINT "　　　デジタルオシロスコープで";
 COLOR 7: PRINT "波の性質";
 COLOR 6: PRINT "を調べよう"
 COLOR 7
 COLOR 19
 LOCATE 22, 21: PRINT "用意ができましたら，どれかキーを押して下さい"
 COLOR 7
END SUB

SUB Waku (A)
        CLS 1
        COLOR 7
        LOCATE 4, 28: PRINT "デジタルオシロスコープ"
        LINE (8 * XO, 16 * YO + 8 - 2 * UY * (-50) - 80)-
             (8 * XO + 8 * UX * 127 / 50 + 1, 16 * YO + 8 - 2 * UY * 50 - 80), 4, B
        PAINT(0, 0), 9, 4
        LINE (63, 360)-(576, 392), 0, BF
        LINE (63, 360)-(576, 392), 10, B
        LINE (40 + KAGE, 149 + KAGE)-(152 + KAGE, 249 + KAGE), 0, BF
        LINE (40, 149)-(152, 249), 1, BF
        LOCATE 14, 8: PRINT "横軸：時間"
        LOCATE 12, 8: PRINT "縦軸：振幅"
        FOR i = 0 TO XFS
           KPUT 8 * XO + 8 * UX * 128 / XFS * i / 50 - 12,
               16 * YO + 8 - 2 * UY * (-50) - 75, RIGHT$(STR$(i), 2), 7, 9
        NEXT
        KPUT 8 * XO + 8 * UX * 128 / XFS * (XFS + 1) / 50 - 10,
               16 * YO + 8 - 2 * UY * (-50) - 75, "ms", 7, 9
        FOR i = -YFS TO YFS
           KPUT 8 * XO - 24, 16 * YO + 8 - 2 * UY * 10 * i - 88, RIGHT$(STR$(i), 2), 7, 9
        NEXT
        FOR i = 1 TO XFS
           LINE (8 * XO + 8 * UX * 128 / XFS * i / 50, 16 * YO + 8 - 2 * UY * (-50) - 80 - 1)-
                (8 * XO + 8 * UX * 128 / XFS * i / 50, 16 * YO + 8 - 2 * UY * 50 - 80 + 1), 4, , &H8888
        NEXT
        FOR i = -YFS + 1 TO YFS - 1
           LINE (8 * XO, 16 * YO + 8 - 2 * UY * 10 * i - 80)-
                (8 * XO + 8 * UX * 128 / 50, 16 * YO + 8 - 2 * UY * 10 * i - 80), 4, , &H8888
        NEXT
        IF A <> 1 GOTO END.SUB
        COLOR 2
        LOCATE 24, 17: PRINT "メニューに戻りたい時もスペースキーを押して下さい";
END.SUB:
        BEEP
END SUB

SUB Waku2 (A)
  FOR i = 1 TO XFS -1
       LINE (8 * XO + 8 * UX * 128 / XFS * i / 50 + RO, 16 * YO + 8 - 2 * UY * (-50) - 80 - 1)-
            (8 * XO + 8 * UX * 128 / XFS * i / 50 + RO, 16 * YO + 8 - 2 * UY * 50 - 80 + 1), 4, , &H8888
  NEXT

  FOR i = -YFS + 1 TO YFS -1
       LINE (8 * XO + RO, 16 * YO + 8 - 2 * UY * 10 * i - 80)-
            (8 * XO + 8 * UX * 128 / 50 + RO, 16 * YO + 8 - 2 * UY * 10 * i - 80), 4, , &H8888
  NEXT
  LINE (8 * XO + RO, 16 * YO + 8 - 2 * UY * (-50) - 80)-
       (8 * XO + 8 * UX * 127 / 50 + RO + 1, 16 * YO + 8 - 2 * UY * 50 - 80), 4, B
END SUB

SUB Waku3 (A)
  FOR i = 1 TO XFS -1
       LINE (8 * XO + 8 * UX * 128 / XFS * i / 50 + LO + RO, 16 * YO + 8 - 2 * UY * (-50) - 80 - 1)-
            (8 * XO + 8 * UX * 128 / XFS * i / 50 + LO + RO, 16 * YO + 8 - 2 * UY * 50 - 80 + 1), 4, , &H8888
  NEXT

  FOR i = -YFS + 1 TO YFS -1
       LINE (8 * XO + LO + RO, 16 * YO + 8 - 2 * UY * 10 * i - 80)-
            (8 * XO + 8 * UX * 128 / 50 + LO + RO, 16 * YO + 8 - 2 * UY * 10 * i - 80), 4, , &H8888
  NEXT
  LINE (8 * XO + LO + RO + 1, 16 * YO + 8 - 2 * UY * 10 * i - 80)-
       (8 * XO + 8 * UX * 128 / 50 + LO + RO - 1, 16 * YO + 8 - 2 * UY * 50 - 80), 4, B
  PAINT (0, 0), 9, 4
  LINE (63, 360)-(576, 392), 0, BF
  LINE (63, 360)-(576, 392), 10, B
END SUB
[目次へ]
付 録

付　　　録
