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