home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / srinf14a.zip / DEMOPRGS.ZIP / ONFIELD.PRG < prev    next >
Text File  |  1990-09-30  |  5KB  |  150 lines
  1. ***************************************************************************
  2. **  ONFIELD.PRG
  3. **  (C) Copyright 1990, Sub Rosa Publishing Inc.
  4. **  A demonstration program provided to SR-Info and VP-Info users.
  5. **  This program may be copied freely. If it is used in commercial code,
  6. **  please credit the source, Sub Rosa Publishing Inc.
  7. **
  8. **  ONFIELD demonstrates the use of the ON FIELD command along with a variety
  9. **  of Info commands and functions.
  10. **  ONFIELD is compatible with all current versions of SR-Info and VP-Info.
  11. **
  12. **  Bernie Melman
  13. **
  14. ** The ON FIELD/ENDON structure is unique to VP-Info and SR-Info.
  15. ** It is hoped that this sample program will help illustrate how
  16. ** this strucure can be used.
  17. **
  18. ** Many application have the following steps in common:
  19. **   i) Accept input information - often by the screenful.
  20. **  ii) Validate the information - requesting additional or corrected
  21. **      information as required.
  22. ** iii) Process the information.
  23. **  iv) Report the results.
  24. ** Using the ON FIELD/ENDON structure combines steps i and ii in a very
  25. ** natural way, allowing field by field verification as information
  26. ** is entered.
  27. **
  28. ** Input fields can defined by a series of @ x,y get statements, or by
  29. ** a 'painted' screen using the TEXT/ENDTEXT structure, or even a combination
  30. ** of the two. VP-Info creats an internal GET TABLE listing all active input
  31. ** fields. Input is activated by a READ command. If there is an ON FIELD/ENDON
  32. ** structure before the READ statement, it is referanced as part of the READ
  33. ** proces.
  34. ** The GET TABLE consists of entries numbered 0 to 65. Fields 1 to 64 refer
  35. ** to the actual input fields. Field 0 refers to a set of preprocessing
  36. ** commands, while field 65 refers to a set of post-processing commands.
  37. *
  38. ***************************************************************************
  39. * initialize variables
  40. CUSTCODE = blank(8)
  41. UNIT_WT = 5.65
  42. MIN_WT = 5.4
  43. MAX_WT = 5.85
  44. UNITS_SOLD = 0.0
  45. NET_WT = 0
  46. UNIT_PRICE = 6.48
  47. MIN_PRICE = 5.50
  48. MAX_PRICE = 8.00
  49. NET_PRICE = 0
  50. *
  51. ERASE; clears screen
  52. WINDOW 5,10,18,72 DOUBLE ; note no ',' before keyword DOUBLE
  53. * 'paint' text screen.
  54. TEXT
  55. .. custcode   !!!!!!!!
  56. .. unit_wt      99.999
  57. .. units_sold  999
  58. .. net_wt    99999.999
  59. .. unit_price  999.99
  60. .. net_price 99999.99
  61. .. min_price   $$9.99
  62. .. max_price   $$9.99
  63. .. min_wt      999.99
  64. .. max_wt      999.99
  65.  
  66.                       WIDGETS OF THE WORLD
  67.                    ORDER SUMMARY DEMO PROGRAM
  68.                  (Experiment with illegal values)
  69.  
  70.        UNITS SOLD: @units_sold    CUSTOMER CODE: @custcode
  71.                    MINIMUM    MAXIMUM     ACTUAL
  72.       UNIT WEIGHT: #min_wt    #max_wt     @unit_wt
  73.        UNIT PRICE: #min_price #max_price  @unit_price
  74.  
  75.            NET WEIGHT: @net_wt
  76.             NET PRICE: @net_price
  77.  
  78. ENDTEXT
  79. * declare the ON FIELD structure AFTER the input screen is displayed
  80. * but BEFORE the READ statemet that it controls
  81. ON field
  82. FIELD 0 ; field 0 commands are executed before an real field is processed
  83.    @ 19,22 say  ' Enter QUIT to exit '
  84.    :FIELD = field(custcode)
  85. FIELD custcode
  86. * customer code could be verified here - and customer file alligned
  87.    IF custcode = 'QUIT'
  88.       :FIELD = 65  ; i.e. fall out of the READ
  89.    ELSE
  90.       @ 19,22 say blank(38,205) ; rebuild double box
  91.       @ 19,22 say ' Enter Negative Value to Exit. '
  92.       :FIELD = field(units_sold)
  93.    ENDIF
  94. FIELD units_sold
  95.    DO CASE
  96.    CASE  units_sold < 0 ; user wants out
  97.       :FIELD = 65
  98.    CASE  units_sold > 300
  99.       RING
  100.       RING
  101.       @ 19,22 say blank(38,205) ; rebuild double box
  102.       @ 19,22 say " I won't believe more than 300 !!! "
  103.       :FIELD = field(units_sold)
  104.    CASE units_sold >=0 .and. units_sold < 20
  105.       RING
  106.       @ 19,22 say blank(38,205) ; rebuild double box
  107.       @ 19,22 say  ' Oh! Dissapointing sales volume !!! '
  108.       :FIELD = field(unit_wt)
  109.    CASE units_sold > 50 .and. units_sold < 300
  110.       ?? chr(7) ; RING does the same thing as this line
  111.       @ 19,22 say blank(38,205) ; rebuild double box
  112.       @ 19,22 say  ' Hey, Good Work !!! '
  113.       :FIELD = field(unit_wt)
  114.    OTHERWISE
  115.       @ 19,22 say  blank(38,205)
  116.       :FIELD = field(unit_wt)
  117.    ENDCASE
  118. FIELD unit_wt
  119.    IF unit_wt < min_wt .or. unit_wt > max_wt
  120.       ?? chr(7),chr(7)
  121.       @ 19,22 say blank(38,205) ; rebuild double box
  122.       @ 19,22 say  ' Oops, weight out of range! '
  123.       :FIELD = field(unit_wt)
  124.    ELSE
  125.       NET_WT = unit_wt * units_sold
  126.       :FIELD = field(unit_price)
  127.       @ 19,22 say blank(38,205) ; rebuild double box
  128.    ENDIF
  129. FIELD unit_price
  130.    IF unit_price < min_price .or. unit_price > max_price
  131.       RING
  132.       RING
  133.       @ 19,22 say blank(38,205) ; rebuild double box
  134.       @ 19,22 say  ' Oops, price out of range! '
  135.       :FIELD = field(unit_price)
  136.    ELSE
  137.       NET_PRICE = unit_price * units_sold
  138.       :FIELD = 65
  139.    ENDIF
  140. FIELD 65
  141.    RING
  142.    @ 19,22 say blank(38,205) ; rebuild double box
  143.    @ 19,22 say  ' Press any key to end demo. '
  144. ENDON
  145. READ
  146. DUMMY = inkey()
  147. WINDOW
  148. *
  149. *                    *** ONFIELD.PRG ***
  150.