home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / basic / library / pb / library3 / inpusing.bas < prev    next >
Encoding:
BASIC Source File  |  1990-12-02  |  3.7 KB  |  121 lines
  1. cls
  2. mask$ ="Phone (###) ###-####"
  3. color 0,7
  4. ans$ = "3035551212"    ' <--- data does not need to be pre-formatted
  5. retcode% = 0           ' <--- complete entry NOT required
  6. CALL MaskInput$(12,20,mask$,ans$,retcode%)
  7. locate 21,20 : color 7,0
  8. ? ans$
  9. ans$="123-45-67"       ' <--- try incomplete/required field
  10. locate 13,20:? "SocSec No: ";   ' rtecode% NOT changed from prev. call
  11. CALL MaskInput$(13, pos(0), "###-##-####",ans$,retcode%)
  12. locate 22,20:? ans$
  13. ans$=left$(date$,2) + mid$(date$,4,2) +mid$(date$,9,2)
  14. locate 14,20 : ?"Date: ";:lastkey% = 1
  15. CALL MaskInput$(14,pos(x),"##-##-##",ans$,retcode%)
  16. locate 23,20 : color 7,0
  17. ? ans$;
  18. print lastkey%
  19. end
  20.  
  21. SUB MaskInput(row%, col%, mask$,ans$,mustfill%)
  22.   '┌──────────────────────────────────────────────────────────────┐
  23.   '│ Mask numeric input only ! - good for Social Security #'s,    │
  24.   '│ dates, telephone numbers, etc. You can use a prompt as       │
  25.   '│ part of the mask, but the prompt will be returned as part    │
  26.   '│ of the data.  On exit mustfill% will contain exitkey% to     │
  27.   '│ allow test for terminating key. A negative value indicates   │
  28.   '│ an extended keycode/function key. To defeat mustfill% code,  │
  29.   '│ the user can/must SPACE thru entire entry.                   │
  30.   '└──────────────────────────────────────────────────────────────┘
  31.   LOCAL x%, y%
  32.   %right = 1:%left = -1
  33.    'col% = pos(x)
  34.    anslen% = LEN(mask$)
  35.    old$ = ans$ : fillchar% = ASC("▒") ' <--- use your own preference
  36.    CALL DispMask(row%, col%, mask$, ans$, fillchar%)
  37.    CALL fbmove(mask$, x%, anslen%, %right)
  38.    DO
  39.      LOCATE row% ,col% + x%-1,1
  40.      WHILE NOT instat:WEND
  41.      w$ = inkey$
  42.      IF LEN(w$) = 2 THEN
  43.       w% = ASC(RIGHT$(w$,1))
  44.       SELECT CASE w%
  45.         CASE 75 : CALL fbmove(mask$, x%, anslen%, %left)
  46.         CASE 77 : CALL fbmove(mask$, x%, anslen%, %right)
  47.         CASE 71 : CALL fbmove(mask$, x%, anslen%, 0)
  48.         CASE 79 : CALL fbmove(mask$, x%, anslen%, anslen%)
  49.         CASE 83   'Del
  50.             MID$(ans$, x%, 1) = chr$(fillchar%)
  51.             ? CHR$(fillchar%);
  52.         CASE ELSE
  53.             exitkey% = -w%
  54.       END SELECT
  55.      ELSE
  56.       SELECT CASE w$
  57.         CASE chr$(8)
  58.             IF x% >1 THEN
  59.                 w$ = CHR$(fillchar%)
  60.                 CALL fbmove(mask$, x%, anslen%, %left)
  61.                 LOCATE ,col% + x%-1,1
  62.                 MID$(ans$, x%, 1) = w$:? w$;
  63.             ELSE
  64.                 BEEP
  65.             END IF
  66.         CASE chr$(13) : exitkey% = 13
  67.         CASE CHR$(27)  'Escape
  68.             ans$ = old$ : exitkey% = 27
  69.         CASE "0" to "9", " "
  70.             MID$(ans$, x%, 1) = w$:?w$;
  71.             CALL fbmove (mask$, x%, anslen%, %right)
  72.         CASE ELSE : BEEP
  73.         END SELECT
  74.       END IF
  75.       IF exitkey% AND mustfill% THEN
  76.         IF INSTR(ans$, CHR$(fillchar%)) THEN
  77.             BEEP:exitkey% = 0:row% = CSRLIN
  78.             LOCATE 24,1:? "Incomplete entry ! ";
  79.             LOCATE row%
  80.         END IF
  81.       END IF
  82.    LOOP until exitkey%
  83.    mustfill% = exitkey%
  84.    REPLACE CHR$(fillchar%) WITH " " IN ans$
  85. END SUB
  86.  
  87. SUB DispMask(r%, c%, mask$, ans$, fillchar%)
  88.    LOCAL x%, y%, z%, MaskValue$, ans2$
  89.    MaskValue$ = "#"
  90.    ans2$ = space$(LEN(mask$))
  91.    IF LEN(ans$) = LEN(mask$) THEN z%=1
  92.    FOR x% = 1 TO LEN(mask$)
  93.        IF z% OR instr(MaskValue$, MID$(mask$, x%, 1)) THEN
  94.         DO
  95.          incr y% : IF y% > LEN(ans$) THEN ch$="":EXIT LOOP
  96.          ch$ = MID$(ans$, y%, 1)
  97.         LOOP WHILE instr("0123456789", ch$)=0
  98.        ELSE
  99.          ch$ = MID$(mask$, x%,1)
  100.        END IF
  101.       IF ch$=""  THEN ch$ = CHR$(fillchar%) '"▒"
  102.       MID$(ans2$, x%, 1) = ch$
  103.    NEXT
  104.    LOCATE r%,c%
  105.    ans$ = ans2$
  106.    ? ans$;
  107. END SUB
  108.  
  109. SUB fbmove(mask$, x%, anslen%, move%)
  110.   IF move% = 0 THEN x%=0:move% = 1
  111.   IF move% >=anslen% THEN x% = anslen%
  112.   IF move% < 0 and instr(LEFT$(mask$, x%-1),"#")=0 THEN EXIT SUB
  113.   DO
  114.     x% = x% + move%
  115.     x% = max%(x%,0)
  116.     x% = min(x%,anslen%)
  117.     IF x% = 0 OR x% = anslen% THEN EXIT LOOP
  118.     IF instr("#", MID$(mask$, x% ,1)) THEN EXIT LOOP
  119.   LOOP
  120. END SUB
  121.