home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / MISC / TNH_PC.ZIP / SCREEN.BAS < prev    next >
Encoding:
BASIC Source File  |  1987-01-14  |  3.6 KB  |  67 lines
  1. 10 ' DEMONSTRATION PROGRAM TO CALL SUBROUTINE GENIN
  2. 14 ' *********************************************************************
  3. 20 KROW%=10:KCOL%=3
  4. 30 KLEN%=30
  5. 40 KTYP$="A"
  6. 45 CLS:LOCATE KROW%,1,1:PRINT ">";
  7. 50 GOSUB 10020
  8. 60 PRINT
  9. 70 PRINT
  10. 80 PRINT ":"+INP.STR$+":";" RTRN%:";RTRN%
  11. 90 STOP:GOTO 45
  12. 95 ' AT THIS POINT YOU CAN CHANGE THE VALUES OF KROW, KLEN, KCLO, OR KTYP AND
  13. 96 ' TYPE "CONT"
  14. 99 '
  15. 10000 ' Subroutine: GENIN                 Author: Kenneth D. Crebs
  16. 10001 '
  17. 10002 ' ========== Generalized Screen Input Subroutine ===========
  18. 10005 '
  19. 10006 '  Inputs:                                 DEFAULTS
  20. 10007 '         KROW%  = Row Input Starts    -  Current Row
  21. 10008 '         KCOL%  = Column Input Starts -  Current Column
  22. 10009 '         KLEN%  = Length of Input     -  80-KCOL%
  23. 10010 '         KTYP%  = Data Type of Input  -  (A)lphanumeric
  24. 10011 '         KSIGN% = Allow Minus Sign    -  Not allowed (=0)
  25. 10012 '  Outputs:
  26. 10013 '         INP.STR$ =  Holds Data Entered (In String Format)
  27. 10014 '         INP.INT% =  If KTYP$=I,Holds Data Entered (In Integer Format)
  28. 10015 '         INP.REL! =  If KTYP$=R,Holds Data Entered (In Real Format)
  29. 10016 '         RTRN%    =  0 - Nothing Entered, <Enter> Pressed
  30. 10017 '                  =  1 - Data Entered, <Enter> Pressed
  31. 10018 '                  =  9 - <Esc> Pressed
  32. 10019 '
  33. 10020 IF KROW%<1 OR KROW%>25 THEN KROW%=CSRLIN
  34. 10030 IF KCOL%<1 OR KCOL%>80 THEN KCOL%=POS(0)
  35. 10040 IF KLEN%<1 OR KLEN%>(80-KCOL%) THEN KLEN%=80-KCOL%+1
  36. 10050 DE%=-1:SE%=1:INP.STR$=SPACE$(KLEN%):GOTO 10070
  37. 10060 ' SOUND 400,4   'BEEP when past end
  38. 10070 COLOR 15,0,0:LOCATE KROW%,KCOL%,1,0,7
  39. 10080 CS$=INKEY$:IF CS$= "" THEN 10080
  40. 10090 KPTR%=POS(0)   ' Current Cursor POSition
  41. 10095 IF KPTR%<KCOL% THEN KPTR%=KCOL%  ' This line needed in case of      <Ctrl><Break>
  42. 10100 IF CS$>CHR$(31) THEN 10160
  43. 10110 IF CS$=CHR$(13) THEN LOCATE ,,0:IF DE% THEN RTRN%=0:RETURN ELSE       RTRN%=1:GOTO 10300
  44. 10120 IF CS$=CHR$(27) THEN LOCATE ,,0:RTRN%=9:RETURN  'Esc
  45. 10130 IF CS$=CHR$(8) THEN 10250  'Backspace (Destructive)
  46. 10140 IF CS$=CHR$(0)+CHR$(75) THEN GOTO 10270  'Left Arrow (Non-Destructive)
  47. 10150 IF CS$=CHR$(0)+CHR$(77) THEN GOTO 10290  'Right Arrow (Non-Destructive)
  48. 10155 BEEP:GOTO 10080
  49. 10160 ACODE%=ASC(CS$)
  50. 10170 IF KTYP$="R" THEN IF (ACODE%<48) OR (ACODE%>57) THEN IF KSIGN% THEN IF ACODE%<45 OR ACODE%>46) THEN BEEP:GOTO 10080 ELSE GOTO 10200 ELSE IF ACODE%<>46 THEN BEEP:GOTO 10080 ELSE GOTO 10200 ELSE GOTO 10200
  51. 10180 IF KTYP$="I" THEN IF (ACODE%<48) OR (CODE%>57) THEN IF KSIGN% THEN IF ACODE%<>45 THEN BEEP:GOTO 10080 ELSE GOTO 10200 ELSE BEEP:GOTO 10080 ELSE GOTO 10200
  52. 10190 IF (ACODE%<32 OR ACODE%>122) THEN BEEP:GOTO 10080
  53. 10200 IF DE% THEN PRINT SPACE$(KLEN%);:LOCATE KROW%,KPTR%:DE%=0
  54. 10210 PRINT CS$;:SE%=KPTR%-KCOL%+1  ' Calculate Position in INP.STR$ (SE%)
  55. 10220 MID$(INP.STR$,SE%,1)=CS$
  56. 10230 IF KPTR%>=KCOL%+KLEN%-1 THEN GOTO 10060 ELSE GOTO 10080
  57. 10240 ' Backspace (Destructive)
  58. 10250 IF KPTR%<KCOL%+1 THEN GOTO 10080 ELSE KPTR%=KPTR%-1:LOCATE , KPTR%:PRINT      " ";:SE%=KPTR%-KCOL%+1:MID$(INP.STR$,SE%,1)=" ":LOCATE  ,KPTR%:IF SE%=1 THEN       DE%=-1:GOTO 10080 ELSE GOTO 10080
  59. 10260 ' Backspace (Non-Destructive)
  60. 10270 IF KPTR%<KCOL%+1 THEN GOTO 10080 ELSE KPTR%=KPTR%-1:LOCATE      ,KPTR%:SE%=KPTR%-KCOL%+1:GOTO 10080
  61. 10280 ' Forwardspace (Non-Destructive)
  62. 10290 IF KPTR%>=KCOL%+KLEN%-1 THEN GOTO 10060 ELSE KPTR%=KPTR%+1:LOCATE ,      KPTR%:SE%=KPTR%-KCOL%+1:GOTO 10080
  63. 10300 IF KTYP$<>"I" AND KTYP$<>"R" THEN RETURN
  64. 10310 IF KTYP$="I" THEN INP.INT%=VAL(INP.STR$):RETURN
  65. 10320 INP.REL!=VAL(INP.STR$):IF INP.REL!=0 THEN INP.REL!-0
  66. 10330 RETURN
  67.