home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / WEBER.ZIP / GET2.PRG < prev    next >
Encoding:
Text File  |  1990-05-17  |  2.3 KB  |  85 lines
  1. *...............................................
  2. * Simple.prg
  3. *
  4. LOCAL Key
  5. USE PGCUS
  6. CLS
  7. @ 05,10 TO 20,70 DOUBLE
  8. @ 07,15 SAY "Name......:"
  9. @ 09,15 SAY "Street....:"
  10. @ 11,15 SAY "City......:"
  11. @ 13,15 SAY "State.....:"
  12. @ 15,15 SAY "Zip.......:"
  13. @ 17,15 SAY "Date/Time.:"
  14. @ 19,18 SAY "Touch any key for next record. ESC to exit."
  15. DO WHILE .NOT. EOF()
  16.    @ 07,27 SAY CUSNAME
  17.    @ 09,27 SAY CUSADDR1
  18.    @ 11,27 SAY CUSCITY
  19.    @ 13,27 SAY CUSSTATE
  20.    @ 15,27 SAY CUSZIP
  21.    @ 17,27 SAY DTOC(DATE())+SPACE(5)+TIME()
  22.    key = INKEY(0)     && wait for a key press
  23.    DO CASE
  24.       CASE Key==27         && if ESC
  25.          EXIT
  26.       CASE Key=-1         && Hit F2
  27.          PopWindow()
  28.       CASE Key=-2         && Hit F3
  29.          EditFlds()
  30.       OTHERWISE
  31.          SKIP
  32.    ENDCASE
  33. ENDDO
  34. @ 23,0
  35. *....................................................
  36. PROCEDURE PopWindow
  37. *....................................................
  38. LOCAL oldwin
  39. oldwin = SAVESCREEN(11,30,19,65)
  40. @ 11,30 CLEAR TO 19,65
  41. @ 11,30 TO 19,65 DOUBLE
  42. @ 13,35 SAY "Credit Limit..: "+STR(CUSCRELIM,5)
  43. @ 14,35 SAY "Credit Avail..: "+STR(CUSCREAVA,5)
  44. @ 16,35 SAY "Strike a key to return"
  45. INKEY(0)
  46. RESTSCREEN(11,30,19,65,oldwin)
  47. RETURN
  48. *....................................................
  49. PROCEDURE EditFlds
  50. *....................................................
  51. LOCAL CUSNAME,CUSADDR1,CUSCITY,CUSSTATE,CUSZIP
  52.  
  53. M->CUSNAME  := FIELD->CUSNAME
  54. M->CUSADDR1 := FIELD->CUSADDR1
  55. M->CUSCITY  := FIELD->CUSCITY
  56. M->CUSSTATE := FIELD->CUSSTATE
  57. M->CUSZIP   := FIELD->CUSZIP
  58.  
  59. @ 07,27 GET M->CUSNAME VALID NotNan(M->CUSNAME)
  60. @ 09,27 GET M->CUSADDR1 PICTURE "@!"
  61. @ 11,27 GET M->CUSCITY PICTURE "@!"
  62. @ 13,27 GET M->CUSSTATE WHEN !EMPTY(M->CUSCITY) PICTURE "@A!" ;
  63.                         VALID M->CUSSTATE $ "GA|CA|NY|IL"
  64. @ 15,27 GET M->CUSZIP PICTURE "99999-9999"
  65. READ
  66.  
  67. FIELD->CUSNAME  := M->CUSNAME
  68. FIELD->CUSADDR1 := M->CUSADDR1
  69. FIELD->CUSCITY  := M->CUSCITY
  70. FIELD->CUSSTATE := M->CUSSTATE
  71. FIELD->CUSZIP   := M->CUSZIP
  72.  
  73. *.............................................................
  74. FUNCTION NotNan(Comp)
  75. *.............................................................
  76. LOCAL retval := .T.
  77. IF Comp = "Nantucket"
  78.    @ 23,0 SAY "Sorry, we won't sell to those dead beats!"
  79.    ?? chr(7)           && ring the bell
  80.    retval = .F.
  81. ELSE
  82.    @ 23,0
  83. ENDIF
  84. RETURN retval
  85.