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