home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Power-Programmierung
/
CD1.mdf
/
basic
/
tools
/
readsub
/
diag.bas
next >
Wrap
BASIC Source File
|
1992-06-21
|
3KB
|
104 lines
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
' DIAG.BAS Diagnostic/Test Program For ReadSub
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
'If you are having problems with ReadSub, this small QuickBasic Program
'will hopefully test the basic processes of ReadSub. As stated in the
'Readsub documentation, call the diag.bat program by entering "diag"
'and note responses.
'
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
DECLARE FUNCTION sqrt (d) 'returns square root
DECLARE SUB endit () 'performs final housecleaning
DECLARE SUB oops (msg$) 'handles input errors
DECLARE SUB heading (msg$) 'creates a heading
DECLARE SUB Process (d$) 'processing subroutine
DIM SHARED num, ok
DIM SHARED d$
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
COLOR 14, 0
top:
CLS
CALL heading("This is Diag, a diagnostic utility for the ReadSub program")
SLEEP 1
LOCATE 8, 12: INPUT "Enter a number for square root determinations: "; d$
CALL Process(d$)
IF ok = 0 THEN GOTO top
d = VAL(d$)
LOCATE 11, 15: PRINT "Getting square root of "; d; "...";
n = sqrt(d)
PRINT "it's: "; num
SLEEP 1
'=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=
SUB endit 'Final Housekeeping Done Here
CLS
LOCATE 5, 15
PRINT "Diagnostic Testing of ReadSub Has Been Completed"
SLEEP 5
SCREEN 0
CLS
END
END SUB
SUB heading (msg$) 'clears screen, centers a type line (msg$)
lmsg% = LEN(msg$)
sp% = (78 - lmsg%) / 2
LOCATE 4, sp%
PRINT msg$
END SUB
SUB oops (msg$) 'if an error occurs, this is called & pgm is ended
FOR a = 5 TO 10
SOUND a * 100, .6
NEXT a
SLEEP 1
CLS
LOCATE 10, 12: PRINT "An Error Has Occurred: "; msg$
SLEEP 2
END SUB
SUB Process (d$) 'Processes input string to ensure it's just a number
ok = 1
IF d$ = "" THEN
CALL oops("Empty Entry"): ok = 0: EXIT SUB
END IF
IF LEN(d$) = 1 AND (ASC(d$) > 47 AND ASC(d$) < 58) THEN EXIT SUB
IF LEN(d$) = 1 THEN
CALL oops("Non-Number Entry"): ok = 0: EXIT SUB
END IF
FOR a = 1 TO LEN(d$)
tmp$ = MID$(d$, a, 1)
IF (ASC(d$) < 48 OR ASC(d$) > 57) THEN
CALL oops("Non-Numeric Entry"): ok = 0: EXIT SUB
END IF
NEXT a
END SUB
FUNCTION sqrt (d) 'Function Comments Here
num = SQR(d) 'this function jes' does a square root
END FUNCTION