home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / tools / readsub / diag.bas next >
Encoding:
BASIC Source File  |  1992-06-21  |  2.5 KB  |  104 lines
  1. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  2. '  DIAG.BAS         Diagnostic/Test Program For ReadSub
  3. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  4.  
  5. 'If you are having problems with ReadSub, this small QuickBasic Program
  6. 'will hopefully test the basic processes of ReadSub. As stated in the
  7. 'Readsub documentation, call the diag.bat program by entering "diag"
  8. 'and note responses.
  9. '
  10. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  11.  
  12. DECLARE FUNCTION sqrt (d)             'returns square root
  13.  
  14. DECLARE SUB endit ()                  'performs final housecleaning
  15. DECLARE SUB oops (msg$)               'handles input errors
  16. DECLARE SUB heading (msg$)            'creates a heading
  17. DECLARE SUB Process (d$)              'processing subroutine
  18.  
  19. DIM SHARED num, ok
  20. DIM SHARED d$
  21.  
  22. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  23.  
  24. COLOR 14, 0
  25. top:
  26. CLS
  27. CALL heading("This is Diag, a diagnostic utility for the ReadSub program")
  28. SLEEP 1
  29. LOCATE 8, 12: INPUT "Enter a number for square root determinations: "; d$
  30. CALL Process(d$)
  31. IF ok = 0 THEN GOTO top
  32.  
  33. d = VAL(d$)
  34. LOCATE 11, 15: PRINT "Getting square root of "; d; "...";
  35. n = sqrt(d)
  36. PRINT "it's:  "; num
  37. SLEEP 1
  38.  
  39.  
  40. '=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
  41.  
  42. SUB endit        'Final Housekeeping Done Here
  43.  
  44. CLS
  45. LOCATE 5, 15
  46. PRINT "Diagnostic Testing of ReadSub Has Been Completed"
  47. SLEEP 5
  48. SCREEN 0
  49. CLS
  50. END
  51.  
  52. END SUB
  53.  
  54. SUB heading (msg$)           'clears screen, centers a type line (msg$)
  55.  
  56. lmsg% = LEN(msg$)
  57. sp% = (78 - lmsg%) / 2
  58. LOCATE 4, sp%
  59. PRINT msg$
  60.  
  61.  
  62.  
  63.  
  64. END SUB
  65.  
  66. SUB oops (msg$)         'if an error occurs, this is called & pgm is ended
  67.  
  68.  
  69. FOR a = 5 TO 10
  70.  SOUND a * 100, .6
  71. NEXT a
  72. SLEEP 1
  73. CLS
  74. LOCATE 10, 12: PRINT "An Error Has Occurred: "; msg$
  75. SLEEP 2
  76.  
  77. END SUB
  78.  
  79. SUB Process (d$)     'Processes input string to ensure it's just a number
  80.  
  81. ok = 1
  82. IF d$ = "" THEN
  83.         CALL oops("Empty Entry"): ok = 0: EXIT SUB
  84. END IF
  85. IF LEN(d$) = 1 AND (ASC(d$) > 47 AND ASC(d$) < 58) THEN EXIT SUB
  86. IF LEN(d$) = 1 THEN
  87.         CALL oops("Non-Number Entry"): ok = 0: EXIT SUB
  88. END IF
  89.      FOR a = 1 TO LEN(d$)
  90.        tmp$ = MID$(d$, a, 1)
  91.        IF (ASC(d$) < 48 OR ASC(d$) > 57) THEN
  92.          CALL oops("Non-Numeric Entry"): ok = 0: EXIT SUB
  93.        END IF
  94.      NEXT a
  95.  
  96. END SUB
  97.  
  98. FUNCTION sqrt (d)         'Function Comments Here
  99.  
  100. num = SQR(d)              'this function jes' does a square root
  101.  
  102. END FUNCTION
  103.  
  104.