home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0010 - 0019 / ibm0010-0019 / ibm0010.tar / ibm0010 / CLIPB52.ZIP / WEBER.ZIP / DESIGN1.PRG < prev    next >
Encoding:
Text File  |  1990-06-01  |  7.0 KB  |  224 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. #define SCR_COLOR IIF(ISCOLOR(),'GB/N,GB/N','W/N,W/N')
  7. #define S_G_COLOR IIF(ISCOLOR(),'RG+/N,N/W,,,W+/B','W/N,N/W,,,W/N')
  8. #define LBL_COLOR IIF(ISCOLOR(),'W+/G','W/N')
  9. #define MNU_COLOR IIF(ISCOLOR(),'W+/N,RG+/R','W/N,N/W')
  10. #define HDR_COLOR IIF(ISCOLOR(),'N/G','N/W')
  11. #define BGD_COLOR IIF(ISCOLOR(),'R/R,R/R','W/N,W/N')
  12. #define HLP_COLOR IIF(ISCOLOR(),'RG+/B','RG+/B')
  13. #define ALERT_COLOR IIF(ISCOLOR(),'*R+/B','*R+/B')
  14.  
  15. *...............................................
  16. * Simple.prg
  17. *
  18. SET CONFIRM ON
  19. SET SCOREBOARD OFF
  20. LOCAL Key, choice := 1
  21. USE PGCUS
  22. SET DELETED ON
  23. CLS
  24. SETCOLOR(BGD_COLOR)        && set background
  25. @ 1,0 CLEAR TO 22,79
  26. ScrTitle("Customer Maintenance Module","CUS")
  27. SETCOLOR(SCR_COLOR)
  28. @ 05,10 CLEAR TO 20,70
  29. @ 05,10 TO 20,70 DOUBLE
  30. @ 07,15 SAY "Name......:"
  31. @ 09,15 SAY "Street....:"
  32. @ 11,15 SAY "City......:"
  33. @ 13,15 SAY "State.....:"
  34. @ 15,15 SAY "Zip.......:"
  35. @ 17,15 SAY "Date/Time.:"
  36. DO WHILE .T.
  37.    SETCOLOR(S_G_COLOR)           && SAY and GET color set
  38.    @ 07,27 SAY CUSNAME
  39.    @ 09,27 SAY CUSADDR1
  40.    @ 11,27 SAY CUSCITY
  41.    @ 13,27 SAY CUSSTATE
  42.    @ 15,27 SAY CUSZIP
  43.    @ 17,27 SAY DTOC(DATE())+SPACE(5)+TIME()
  44.    choice := BarMenu(@choice)
  45.    ModeDisp(choice)
  46.    DO CASE
  47.       CASE choice==1        && if Add
  48.          Add_Cus()
  49.       CASE choice==2        && if Edit
  50.          EditFlds()
  51.       CASE choice==3        && if Delete
  52.          delete
  53.       CASE choice==4        && if Prev
  54.          SKIP -1
  55.       CASE choice==5        && if Next
  56.          Skip
  57.       CASE choice==6        && if Top
  58.          GO TOP
  59.       CASE choice==7        && if Bottom
  60.          GO BOTT
  61.       CASE choice==8        && if Credit
  62.          PopWindow()
  63.       OTHERWISE             && Quit
  64.          EXIT
  65.    ENDCASE
  66.    ClrMode()
  67. ENDDO
  68. @ 23,0
  69. *....................................................
  70. PROCEDURE ScrTitle(Title,Lbl)
  71. *....................................................
  72. LOCAL OldColor := SETCOLOR(LBL_COLOR)
  73. @ 1,0 CLEAR TO 1,79
  74. @ 1,INT(40-LEN(Title)/2) SAY Title
  75. @ 1,75 SAY Lbl
  76. SETCOLOR(OldColor)
  77. RETURN
  78. *....................................................
  79. PROCEDURE ModeDisp(Mode)     && Displays Mode
  80. *....................................................
  81. LOCAL OldColor := SETCOLOR(LBL_COLOR), ModeId
  82. LOCAL ModeLst := {"ADD","EDIT","DEL","PREV","NEXT",;
  83.                   "TOP","BOTTOM","CREDIT"}
  84. IF Mode>LEN(ModeLst) .OR. Mode==0
  85.    @ 1,0 SAY "QUIT"
  86. ELSE
  87.    @ 1,0 SAY ModeLst[Mode]
  88. ENDIF
  89. SETCOLOR(OldColor)
  90. RETURN
  91. *....................................................
  92. PROCEDURE ClrMode      && Clears Mode Indicator
  93. *....................................................
  94. LOCAL OldColor := SETCOLOR(LBL_COLOR)
  95. @ 1,0 SAY SPACE(10)
  96. SETCOLOR(OldColor)
  97. RETURN
  98. *....................................................
  99. FUNCTION BarMenu
  100. *....................................................
  101. PARAMETER opt
  102. LOCAL OldColor := SETCOLOR(MNU_COLOR)
  103. SET MESSAGE TO 24
  104. SET WRAP ON
  105. @ 23,0
  106. @ 23,0       PROMPT "Add"    MESSAGE "Add a record"
  107. @ 23,COL()+2 PROMPT "Edit"   MESSAGE "Edit record"
  108. @ 23,COL()+2 PROMPT "Del"    MESSAGE "Delete Record"
  109. @ 23,COL()+2 PROMPT "Prev"   MESSAGE "Go To Previous record"
  110. @ 23,COL()+2 PROMPT "Next"   MESSAGE "Go To Next Record"
  111. @ 23,COL()+2 PROMPT "Top"    MESSAGE "Go To First Record"
  112. @ 23,COL()+2 PROMPT "Bottom" MESSAGE "Go To Last Record"
  113. @ 23,COL()+2 PROMPT "Credit" MESSAGE "View Credit Info"
  114. @ 23,COL()+2 PROMPT "Quit"   MESSAGE "Quit the System"
  115. MENU TO Opt
  116. SETCOLOR(OldColor)
  117. @ 23,0 CLEAR TO 24,79
  118. RETURN (opt)
  119. *....................................................
  120. PROCEDURE Add_Cus
  121. *....................................................
  122. APPEND BLANK
  123. EditFlds()
  124. RETURN
  125. *....................................................
  126. PROCEDURE PopWindow
  127. *....................................................
  128. LOCAL oldwin := SAVESCREEN(11,30,19,65)
  129. LOCAL OldColor := SETCOLOR(HLP_COLOR)
  130. @ 11,30 CLEAR TO 19,65
  131. @ 11,30 TO 19,65 DOUBLE
  132. @ 13,35 SAY "Credit Limit..: "+STR(CUSCRELIM,5)
  133. SETCOLOR(IF(CUSCREAVA<=0,ALERT_COLOR,HLP_COLOR))
  134. @ 14,35 SAY "Credit Avail..: "+STR(CUSCREAVA,5)
  135. SETCOLOR(HLP_COLOR)
  136. @ 16,35 SAY "Strike a key to return"
  137. INKEY(0)
  138. RESTSCREEN(11,30,19,65,oldwin)
  139. SETCOLOR(OldColor)
  140. RETURN
  141. *....................................................
  142. PROCEDURE EditFlds
  143. *....................................................
  144. LOCAL CUSNAME,CUSADDR1,CUSCITY,CUSSTATE,CUSZIP
  145. LOCAL OldColor := SETCOLOR(S_G_COLOR)
  146. SET KEY -3 TO ChgZip        && F4 runs ChgZip
  147. SET KEY -4 TO EditCred      && F5 runs EditCred
  148.  
  149. M->CUSNAME  := FIELD->CUSNAME
  150. M->CUSADDR1 := FIELD->CUSADDR1
  151. M->CUSCITY  := FIELD->CUSCITY
  152. M->CUSSTATE := FIELD->CUSSTATE
  153. M->CUSZIP   := FIELD->CUSZIP
  154.  
  155. @ 07,27 GET M->CUSNAME VALID NotNan(M->CUSNAME)
  156. @ 09,27 GET M->CUSADDR1 PICTURE "@!"
  157. @ 11,27 GET M->CUSCITY PICTURE "@!"
  158. @ 13,27 GET M->CUSSTATE WHEN !EMPTY(M->CUSCITY) PICTURE "@A!" ;
  159.                         VALID M->CUSSTATE $ "GA|CA|NY|IL"
  160. @ 15,27 GET M->CUSZIP PICTURE ZipPic()
  161. READ
  162.  
  163. FIELD->CUSNAME  := M->CUSNAME
  164. FIELD->CUSADDR1 := M->CUSADDR1
  165. FIELD->CUSCITY  := M->CUSCITY
  166. FIELD->CUSSTATE := M->CUSSTATE
  167. FIELD->CUSZIP   := M->CUSZIP
  168.  
  169. SET KEY -3 TO
  170. SET KEY -4 TO
  171. SETCOLOR(OldColor)
  172. RETURN
  173. *.............................................................
  174. FUNCTION NotNan(Comp)
  175. *.............................................................
  176. LOCAL retval := .T., OldColor := SETCOLOR(ALERT_COLOR)
  177. IF Comp = "Nantucket"
  178.    @ 23,0 SAY "Sorry, we won't sell to those dead beats!"
  179.    ?? chr(7)           && ring the bell
  180.    retval = .F.
  181. ELSE
  182.    SETCOLOR(OldColor)
  183.    @ 23,0
  184. ENDIF
  185. RETURN retval
  186.  
  187. *..............................................................
  188. PROCEDURE ChgZip(Call_Prg, Line_Num, Input_Var)
  189. *..............................................................
  190. IF ZipFmt == "99999"
  191.    ZipFmt := ZipPic("99999-9999")
  192. ELSE
  193.    ZipFmt := ZipPic("99999")
  194. ENDIF
  195. @ ZipRow, ZipCol SAY SPACE(10)
  196. RETURN
  197.  
  198. *..............................................................
  199. FUNCTION ZipPic(NewPic)      && returns current zip or new zip
  200. *                            && if passed
  201. *..............................................................
  202. STATIC ZPict := "99999-9999"
  203. RETURN IF(VALTYPE(NewPic)=="C", (ZPict := NewPic), ZPict)
  204.  
  205. *.............................................................
  206. PROCEDURE EditCred(Call_Prg, Line_Num, Input_Var)
  207. *.............................................................
  208. LOCAL oldwin := SAVESCREEN(11,30,19,65)
  209. LOCAL OldColor := SETCOLOR(HLP_COLOR)
  210. SAVE GETS
  211. @ 11,30 CLEAR TO 19,65
  212. @ 11,30 TO 19,65 DOUBLE
  213. M->CUSCRELIM := FIELD->CUSCRELIM
  214. @ 13,35 SAY "Credit Limit..:" GET M->CUSCRELIM PICT "99999"
  215. @ 14,35 SAY "Credit Avail..: "+STR(CUSCREAVA,5)
  216. @ 16,35 SAY "Enter New Credit Limit"
  217. READ
  218. FIELD->CUSCREAVA := FIELD->CUSCREAVA+(M->CUSCRELIM-FIELD->CUSCRELIM)
  219. FIELD->CUSCRELIM := M->CUSCRELIM
  220. RESTSCREEN(11,30,19,65,oldwin)
  221. SETCOLOR(OldColor)
  222. REST GETS
  223. RETURN
  224.