home *** CD-ROM | disk | FTP | other *** search
/ Monster Media 1994 #1 / monster.zip / monster / PROG_BAS / PRO98SRC.ZIP / EDIT.BAS < prev    next >
BASIC Source File  |  1994-01-14  |  6KB  |  209 lines
  1. FUNCTION REL$(FLD AS STRING * 20)
  2.     R$=RTRIM$(FLD,ANY CHR$(0,32))+":"
  3.         IF INSTR(R$,".") THEN R$=MID$(R$,INSTR(R$,".")+1)
  4.         REL$=R$
  5. END FUNCTION
  6.  
  7. SUB VarEditFields(Ecode%)
  8. Ecode%=0
  9. of%=3:ob%=4
  10. Fld%=1 ' start with the first field on the screen
  11. ' Now make one pass and DRAW the fields on the screen with defaults
  12. DO UNTIL DBE(Fld%).FieldLength=0
  13.         PROZOLOCATE DBE(Fld%).FieldRow,DBE(Fld%).FieldCol
  14.         PROZOCOLOR of%,ob%
  15.         PROZOPRINT REL$(DBE(Fld%).FieldName)
  16.         PROZOPRINT "@SCP()"
  17.         PROZOCOLOR DBE(Fld%).FieldFG,DBE(Fld%).FieldBG
  18.         PROZOPRINT SPACE$(DBE(Fld%).FieldLength)
  19.         PROZOPRINT "@RCP()"
  20.         IF DBE(Fld%).FieldType="N" THEN
  21.                 PROZOPRINT LTRIM$(GETVAR$((DBE(Fld%).FieldName)))
  22.     ELSE
  23.                 PROZOPRINT GETVAR$((DBE(Fld%).FieldName))
  24.     END IF
  25.  
  26.     INCR Fld%
  27. LOOP
  28.  
  29.  
  30. Fld%=1 ' start with the first field on the screen
  31. ' Now go back and edit the fields
  32. DO UNTIL DBE(Fld%).FieldLength=0
  33.         PROZOLOCATE DBE(Fld%).FieldRow,DBE(Fld%).FieldCol
  34.         PROZOCOLOR of%,ob%
  35.         PROZOPRINT REL$(DBE(Fld%).FieldName)
  36.         r%=PROZOCSRLIN:C%=PROZOPOS
  37.         IF DBE(Fld%).FieldType="N" THEN
  38.                 num%=1
  39.             ED$=LTRIM$(GETVAR$((DBE(Fld%).FieldName)))
  40.     ELSE
  41.                 num%=0
  42.             ED$=GETVAR$((DBE(Fld%).FieldName))
  43.     END IF
  44.  
  45.         ED$=DBGET$(r%, c%, (DBE(Fld%).FieldLength), (DBE(Fld%).FieldFG),_
  46.                   (DBE(Fld%).FieldBG), ED$, -1, num%,KeyFlag%)
  47.  
  48.         IF num% THEN
  49.             VSET2 DBE(Fld%).FieldName, STR$(VAL(ED$))
  50.         ELSE
  51.             VSET2 DBE(Fld%).FieldName,ED$
  52.     END IF
  53.  
  54.     SELECT CASE KeyFlag%
  55.             CASE 10
  56.                         PUSHARG "-1"
  57.                         EXIT LOOP
  58.         CASE 5
  59.                         PUSHARG "0"
  60.                     EXIT LOOP
  61.         CASE 0,2,6
  62.                     INCR Fld%
  63.                         IF DBE(Fld%).FieldLength=0 THEN
  64.                                 PUSHARG "-1"
  65.                                 EXIT LOOP
  66.                                 END IF
  67.                 CASE 4,8
  68.                     DECR Fld%
  69.                         IF Fld%=0 THEN Fld%=1
  70.         END SELECT
  71. LOOP
  72. PROZOCOLOR Of%, Ob%
  73.  
  74. END SUB
  75.  
  76. FUNCTION DBGET$(y%,x%,length%,fg%,bg%,whole$,ins%,num%,keyflag%)
  77. LOCAL tscan%, xitflag%, curpos%, tempwhole$, first%
  78.   ofg%=(PBVSCRNTXTATTR AND &HF)
  79.   ofb%=PBVSCRNTXTATTR / &H10
  80.   keyflag% = 0
  81.   tempwhole$ = whole$
  82.   first% = %TRUE
  83.   PROZOLOCATE y%,x%
  84.   PROZOCOLOR fg%,bg% : PROZOPRINT SPACE$(length%)
  85.   xitflag% = %FALSE
  86.   curpos% = 0
  87.  
  88.   DO
  89.     'IF ins% THEN tscan% = %INSERTSCAN ELSE tascn% = %OVERWRITESCAN
  90.         IF LEN(Whole$)>Length% THEN WHOLE$=LEFT$(Whole$,Length%)
  91.         IF LEN(Whole$)<Length% THEN WHOLE$=WHOLE$+SPACE$(Length%=LEN(Whole$))
  92.         PROZOLOCATE y%,x% : PROZOPRINT whole$
  93.         PROZOLOCATE y%,x%+curpos%
  94.  
  95.     ky$ = GETKEY$("")
  96.     IF ky$ < CHR$(31) THEN first% = %FALSE
  97.     SELECT CASE ky$
  98.       CASE > CHR$(31)
  99.         IF num% THEN
  100.           IF ky$ > CHR$(62) THEN EXIT SELECT
  101.         END IF
  102.         IF first% THEN
  103.           whole$ = ky$
  104.           curpos% = 1
  105.           first% = %FALSE
  106.           EXIT SELECT
  107.         END IF
  108.         IF ins% THEN
  109.           IF curpos% < LEN(whole$) THEN
  110.             whole$ = RTRIM$(whole$)
  111.             IF LEN(whole$) < length% THEN
  112.               whole$ = LEFT$(whole$,curpos%)+ky$+RIGHT$(whole$,LEN(whole$)-curpos%)
  113.               INCR curpos%,1
  114.               IF curpos% = length% THEN DECR curpos%,1
  115.             END IF
  116.           ELSE
  117.             whole$ = whole$ + ky$
  118.             INCR curpos%,1
  119.             IF curpos% = length% THEN DECR curpos%,1
  120.           END IF
  121.         ELSE
  122.           IF curpos% < LEN(whole$) THEN
  123.             MID$(whole$,curpos%+1) = ky$
  124.           ELSE
  125.             whole$ = whole$ + ky$
  126.           END IF
  127.           INCR curpos%,1
  128.           IF curpos% = length% THEN DECR curpos%,1
  129.         END IF
  130.       CASE CHR$(0,75) '**** LEFT ****
  131.         IF curpos% <> 0 THEN DECR curpos%,1
  132.       CASE CHR$(0,77)'**** RIGHT ****
  133.         IF curpos% <> length%-1 THEN INCR curpos%,1
  134.         IF curpos% > LEN(whole$) THEN whole$=whole$+" "
  135.       CASE CHR$(0,71)'**** HOME ****
  136.         curpos% = 0
  137.       CASE CHR$(0,79)'**** END ****
  138.            whole$ = RTRIM$(whole$)
  139.            curpos% = LEN(whole$)
  140.            IF LEN(whole$) = length% THEN DECR curpos%,1
  141.       CASE CHR$(0,82)'**** INS ****
  142.         ins% = NOT ins%
  143.         IF tscan% = 3 THEN tscan% = 6 ELSE tscan% = 3
  144.       CASE CHR$(0,83)'**** DEL ****
  145.         IF curpos% > LEN(whole$)-1 THEN EXIT SELECT
  146.         whole$ = LEFT$(whole$,curpos%) + RIGHT$(whole$,LEN(whole$)-curpos%-1)
  147.       CASE CHR$(8)'**** BACKSPACE ****
  148.         IF curpos% <> 0 THEN
  149.           whole$ = LEFT$(whole$,curpos%-1) + RIGHT$(whole$,LEN(whole$)-curpos%)
  150.           DECR curpos%,1
  151.         END IF
  152.       CASE CHR$(13)'**** ENTER ****
  153.         xitflag% = %TRUE
  154.         keyflag% = 0
  155.       CASE CHR$(27)'**** ESC ****
  156.         xitflag% = %TRUE
  157.         keyflag% = 5
  158.         whole$ = tempwhole$
  159.       CASE CHR$(0,72)'**** UP ARROW ****
  160.         xitflag% = %TRUE
  161.         keyflag% = 8
  162.       CASE CHR$(0,80)'**** DOWN ARROW ****
  163.         xitflag% = %TRUE
  164.         keyflag% = 2
  165.       CASE CHR$(9)'**** TAB ****
  166.         xitflag% = %TRUE
  167.         keyflag% = 6
  168.       CASE CHR$(0,15)'**** SHFT-TAB ****
  169.         xitflag% = %TRUE
  170.         keyflag% = 4
  171.           CASE CHR$(0,117),CHR$(0,68),CHR$(14)
  172.               xitflag%=%TRUE
  173.                 keyflag%=10
  174.  
  175.     END SELECT
  176.  
  177.   LOOP UNTIL xitflag%
  178.   xitflag%=%FALSE
  179.   PROZOCOLOR ofg%, obg%
  180.   DBGET$ = RTRIM$(whole$)
  181.  
  182. END FUNCTION
  183.  
  184. FUNCTION getkey$(mstr$)
  185.   IF mstr$ = "" THEN
  186.     DO
  187.       IF INSTAT THEN k$=PROZOINKEY$ ELSE k$ = PROZOINKEY$:IF K$=CHR$(27) THEN GOSUB K.Arrow
  188.     LOOP UNTIL k$ <> ""
  189.   ELSE
  190.     DO
  191.      IF INSTAT THEN k$ = PROZOINKEY$ ELSE k$=PROZOINKEY$:IF K$=CHR$(27) THEN GOSUB K.ARROW
  192.     LOOP UNTIL INSTR(k$,ANY mstr$)
  193.   END IF
  194. GOTO EndGetKeyFunction
  195.  
  196. K.ARROW:
  197. DELAY .25
  198.     IF COMCHARS% THEN K$=K$+COMCHAR$ ELSE RETURN
  199.         IF INSTR(K$,"A") THEN K$=CHR$(0,72)
  200.         IF INSTR(K$,"B") THEN K$=CHR$(0,80)
  201.         IF INSTR(K$,"C") THEN K$=CHR$(0,75)
  202.         IF INSTR(K$,"D") THEN K$=CHR$(0,77)
  203. RETURN
  204.  
  205.  
  206. EndGetKeyFunction:
  207.   getkey$ = k$
  208. END FUNCTION
  209.