home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / WEBER.ZIP / GET5.PRG < prev    next >
Encoding:
Text File  |  1990-05-29  |  3.0 KB  |  110 lines
  1. #command SAVE GETS => __PushGet()
  2. #command REST GETS => __PopGet()
  3. *...............................................
  4. * Simple.prg
  5. *
  6. LOCAL Key, choice := 1
  7. USE PGCUS
  8. CLS
  9. @ 05,10 TO 20,70 DOUBLE
  10. @ 07,15 SAY "Name......:"
  11. @ 09,15 SAY "Street....:"
  12. @ 11,15 SAY "City......:"
  13. @ 13,15 SAY "State.....:"
  14. @ 15,15 SAY "Zip.......:"
  15. @ 17,15 SAY "Date/Time.:"
  16. DO WHILE .T.
  17.    @ 07,27 SAY CUSNAME
  18.    @ 09,27 SAY CUSADDR1
  19.    @ 11,27 SAY CUSCITY
  20.    @ 13,27 SAY CUSSTATE
  21.    @ 15,27 SAY CUSZIP
  22.    @ 17,27 SAY DTOC(DATE())+SPACE(5)+TIME()
  23.    choice = BarMenu(@choice)
  24.    DO CASE
  25.       CASE choice==1        && if Add
  26.          Add_Cus()
  27.       CASE choice==2        && if Edit
  28.          EditFlds()
  29.       CASE choice==3        && if Delete
  30.          delete
  31.       CASE choice==4        && if Prev
  32.          SKIP -1
  33.       CASE choice==5        && if Next
  34.          Skip
  35.       CASE choice==6        && if Top
  36.          GO TOP
  37.       CASE choice==7        && if Bottom
  38.          GO BOTT
  39.       OTHERWISE             && Quit
  40.          EXIT
  41.    ENDCASE
  42. ENDDO
  43. @ 23,0
  44. *....................................................
  45. FUNCTION BarMenu
  46. *....................................................
  47. PARAMETER opt
  48. @ 23,0
  49. @ 23,0       PROMPT "Add"
  50. @ 23,COL()+2 PROMPT "Edit"
  51. @ 23,COL()+2 PROMPT "Del"
  52. @ 23,COL()+2 PROMPT "Prev"
  53. @ 23,COL()+2 PROMPT "Next"
  54. @ 23,COL()+2 PROMPT "Top"
  55. @ 23,COL()+2 PROMPT "Bottom"
  56. @ 23,COL()+2 PROMPT "Quit"
  57. MENU TO Opt
  58. @ 23,0 CLEAR TO 24,79
  59. RETURN (opt)
  60. *....................................................
  61. PROCEDURE Add_Cus
  62. *....................................................
  63. APPEND BLANK
  64. EditFlds()
  65. RETURN
  66. *....................................................
  67. PROCEDURE EditFlds
  68. *....................................................
  69. LOCAL CUSNAME,CUSADDR1,CUSCITY,CUSSTATE,CUSZIP
  70. SET KEY -1 TO EditCred
  71. M->CUSNAME  := FIELD->CUSNAME
  72. M->CUSADDR1 := FIELD->CUSADDR1
  73. M->CUSCITY  := FIELD->CUSCITY
  74. M->CUSSTATE := FIELD->CUSSTATE
  75. M->CUSZIP   := FIELD->CUSZIP
  76.  
  77. @ 07,27 GET M->CUSNAME PICTURE "@!"
  78. @ 09,27 GET M->CUSADDR1 PICTURE "@!"
  79. @ 11,27 GET M->CUSCITY PICTURE "@!"
  80. @ 13,27 GET M->CUSSTATE WHEN !EMPTY(M->CUSCITY) PICTURE "@A!" ;
  81.                         VALID M->CUSSTATE $ "GA|CA|NY|IL"
  82. @ 15,27 GET M->CUSZIP PICTURE "99999-9999"
  83. READ
  84.  
  85. FIELD->CUSNAME  := M->CUSNAME
  86. FIELD->CUSADDR1 := M->CUSADDR1
  87. FIELD->CUSCITY  := M->CUSCITY
  88. FIELD->CUSSTATE := M->CUSSTATE
  89. FIELD->CUSZIP   := M->CUSZIP
  90.  
  91. SET KEY -1 TO
  92. RETURN
  93. *.............................................................
  94. PROCEDURE EditCred(Call_Prg, Line_Num, Input_Var)
  95. *.............................................................
  96. LOCAL oldwin
  97. SAVE GETS
  98. oldwin = SAVESCREEN(11,30,19,65)
  99. @ 11,30 CLEAR TO 19,65
  100. @ 11,30 TO 19,65 DOUBLE
  101. M->CUSCRELIM := FIELD->CUSCRELIM
  102. @ 13,35 SAY "Credit Limit..:" GET M->CUSCRELIM PICT "99999"
  103. @ 14,35 SAY "Credit Avail..: "+STR(CUSCREAVA,5)
  104. @ 16,35 SAY "Enter New Credit Limit"
  105. READ
  106. FIELD->CUSCRELIM := M->CUSCRELIM
  107. RESTSCREEN(11,30,19,65,oldwin)
  108. REST GETS
  109. RETURN
  110.