home *** CD-ROM | disk | FTP | other *** search
/ C!T ROM 2 / ctrom_ii_b.zip / ctrom_ii_b / PROGRAM / CLIPPER / SCRNUZ / TEST.PRG < prev   
Text File  |  1991-12-13  |  5KB  |  197 lines
  1. *.............................................................................
  2. *
  3. *   Program Name: TEST.PRG          Copyright: EDON Corporation
  4. *   Date Created: 03/19/91           Language: Clipper S'87
  5. *   Time Created: 13:46:31             Author: Ed Phillips
  6. *           Desc:
  7. *.............................................................................
  8.  
  9. dnarrow = 24
  10. uparrow = 5
  11. pgdn = 3
  12. esc = 27
  13. ctrl_home = 29
  14. ctrl_end = 23
  15.  
  16. ex_flg = .f.
  17. ok = .t.
  18. c_norm = 'w+/b'
  19. c_field = 'W+/b,W+/r'
  20. c_say = 'N/W'
  21. c_error = 'W+/R'
  22.  
  23. ReadExit(.t.)
  24.  
  25. Opendata('Screen,n5nn;Scrngets,n5nn;Genmeet,n5nn','Screen;Scrngets;Genmeet')
  26.  
  27. SELECT Scrngets
  28. INDEX ON Scrn_name TO Temp
  29. SET INDEX TO Temp
  30.  
  31. SELECT Genmeet
  32. Automem('PUB')
  33. PUBLIC all, sub
  34. all = .f.
  35. sub = ' '
  36. setcolor(c_norm)
  37. clear
  38.  
  39. Automem('STUP')
  40. PopScreen('NEWMEET')
  41.  
  42. Says('NEWMEET')
  43. ok = Gets('NEWMEET')
  44.  
  45. IF ok
  46.    Automem('REPL')
  47. ENDIF                                            && IF ok
  48. CLOSE ALL
  49. RETURN
  50.  
  51. *----------------------------
  52. *         Author: Ed Phillips
  53. *   Date Created: 03/19/91
  54. *   Time Created: 14:12:05
  55. *----------------------------
  56. FUNCTION Gets
  57.    PARAMETERS scrname
  58.    PRIVATE ret_val, oldarea, gtop, gbottom, work, oldcolor
  59.  
  60.    ret_val = .t.
  61.    oldarea = Select()
  62.  
  63.    SELECT Scrngets
  64.    SEEK scrname
  65.    IF !Found()
  66.       ret_val = .f.
  67.    ENDIF                                         && IF !Found()
  68.  
  69.    gtop = Recno()
  70.    oldcolor = Setcolor(c_error)
  71.    DO WHILE scrname = Trim(Scrn_name) .AND. ! Eof()
  72.       var = Trim(G_var)
  73.       pic = Trim(G_pic)
  74.  
  75.       *--------------
  76.       * Issue one SAY
  77.       *--------------
  78.       DO CASE
  79.          CASE Empty(pic)
  80.             @ G_row, G_col SAY M->&var.
  81.          OTHERWISE
  82.             @ G_row, G_col SAY M->&var. PICT pic
  83.       ENDCASE                                       && DO CASE
  84.       SKIP
  85.    ENDDO                                         && DO WHILE scrname = Trim(Scrn_name) .AND. ! Eof()
  86.    SKIP -1
  87.    gbottom = Recno()
  88.    GO gtop
  89.    SET KEY ctrl_end TO CtrlEnd
  90.    SET KEY ctrl_home TO CtrlHome
  91.    Setcolor(c_field)
  92.    DO WHILE scrname = Trim(Scrn_name) .AND. ! Eof()
  93.       var = Trim(G_var)
  94.       pic = Trim(G_pic)
  95.       val = Trim(G_valid)
  96.  
  97.       *--------------
  98.       * Issue one GET
  99.       *--------------
  100.       DO CASE
  101.          CASE Empty(pic)
  102.             @ G_row, G_col GET M->&var.
  103.          OTHERWISE
  104.             @ G_row, G_col GET M->&var. PICT pic
  105.       ENDCASE                                       && DO CASE
  106.  
  107.       READ
  108.  
  109.       IF !Empty(val)
  110.          IF ! &val.                              && validation failed
  111.             LOOP
  112.          ENDIF                                      && IF ! &val.
  113.       ENDIF                                         && IF !Empty(val)
  114.  
  115.       DO CASE
  116.          CASE Lastkey() = dnarrow
  117.             NextGet()
  118.          CASE Lastkey() = uparrow                && prev field
  119.             PrevGet()
  120.          CASE Lastkey() = pgdn
  121.             EXIT
  122.          CASE Lastkey() = esc
  123.             ret_val = .f.
  124.             EXIT
  125.          OTHERWISE
  126.             SKIP
  127.       ENDCASE                                       && DO CASE
  128.  
  129.    ENDDO
  130.    Setcolor(oldcolor)
  131.    SELECT (oldarea)
  132.  
  133.    SET KEY ctrl_end TO
  134.    SET KEY ctrl_home TO
  135. RETURN (ret_val)
  136.  
  137. *----------------------------
  138. *         Author: Ed Phillips
  139. *   Date Created: 03/19/91
  140. *   Time Created: 14:16:52
  141. *----------------------------
  142. FUNCTION PrevGet
  143.    SKIP -1
  144.    IF scrname != Trim(Scrn_name)
  145.       GO gbottom
  146.    ENDIF                                         && IF Scrn_name != scrname
  147. RETURN(.T.)
  148.  
  149. FUNCTION NextGet
  150.    SKIP
  151.    IF scrname != Trim(Scrn_name)
  152.       GO gtop
  153.    ENDIF                                         && IF scrname != Trim(Scrn_name)
  154. RETURN(.T.)                                      && FUNCTION NextGet
  155.  
  156. FUNCTION Says
  157.    PARAMETERS scrname
  158.    PRIVATE oldarea, var, pic, oldcolor
  159.  
  160.    oldarea = Select()
  161.    oldcolor = Setcolor(c_say)
  162.  
  163.    SELECT Scrngets
  164.    SEEK scrname
  165.  
  166.    DO WHILE scrname = Trim(Scrn_name) .AND. ! Eof()
  167.       var = Trim(G_var)
  168.       pic = Trim(G_pic)
  169.  
  170.       *--------------
  171.       * Issue one GET
  172.       *--------------
  173.       DO CASE
  174.          CASE Empty(pic)
  175.             @ G_row, G_col SAY M->&var.
  176.          OTHERWISE
  177.             @ G_row, G_col SAY M->&var. PICT pic
  178.       ENDCASE                                       && DO CASE
  179.       SKIP
  180.    ENDDO                                         && DO WHILE scrname = Trim(Scrn_name) .AND. ! Eof()
  181.    SELECT (oldarea)
  182.    Setcolor(oldcolor)
  183.  
  184. RETURN .t.
  185.  
  186. PROCEDURE CtrlEnd
  187.    GO gbottom
  188.    KEYBOARD Chr(uparrow)+Chr(dnarrow)
  189. RETURN                                           && PROCEDURE CtrlEnd
  190.  
  191. PROCEDURE CtrlHome
  192.    GO gtop
  193.    KEYBOARD Chr(uparrow)+Chr(dnarrow)
  194. RETURN                                           && PROCEDURE CtrlEnd
  195.  
  196. * EOF: TEST.PRG
  197.