home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / instapop.zip / SURVPROC.PRG < prev   
Text File  |  1991-02-19  |  8KB  |  192 lines
  1. * SurvProc.prg
  2. *
  3. * procedure libaray for survey program
  4. *
  5. * 02/17/91
  6. *
  7. *
  8. * Contents
  9. * --------
  10. * GoPopup ()    main popup activation function
  11. * DefPops       popup definitions
  12. * KilPops       erase popups from memory
  13. *
  14.  
  15.  
  16. ****************************************
  17. * GoPopup ()
  18. * ----------
  19. *
  20. * Activates appropriate popup based on current field in READ.
  21. *
  22. * The WHEN clause of all popup-controlled fields should contain
  23. * the gopopup () call.  Using the VARREAD () function, the corresponding
  24. * popup is ACTIVATED and then the results are "typed" via the KEYBOARD
  25. * command.
  26. *
  27. function gopopup
  28.   private field_is, popped_ok, last_key
  29.   *-- Remember the last key pressed (the one that got you to this field)
  30.   last_key = lastkey ()
  31.   *-- If the key has a negative ASCII value (generated by various function
  32.   *-- keys) replace it with the ASCII value for Enter (13), unless it is -400,
  33.   *-- the value for Shift-Tab, in which case it will be replaced with 5,
  34.   *-- the up arrow.  CHR () does not like negatives.
  35.   last_key = chr (iif (last_key < 0, iif (last_key = -400, 5, 13), last_key))
  36.   *-- Assign current field name to memvar (will be all upper case)
  37.   field_is = varread ()
  38.   *-- Assume that a popup will be activated
  39.   popped_ok = .t.
  40.   *-- This CASE structure determines which popup is activated
  41.   do case
  42.     case field_is = "Q1"
  43.       activate popup popq1
  44.     case field_is = "Q2"
  45.       activate popup popq2
  46.     case field_is = "Q3"
  47.       activate popup popq3
  48.     case field_is = "Q4"
  49.       activate popup popq4
  50.     case field_is = "Q5"
  51.       activate popup popq5
  52.     case field_is = "Q6"
  53.       activate popup popq6
  54.     otherwise
  55.       *-- If the field is not one which has a popup defined, do nothing
  56.       *-- and indicate that a popup was not activated
  57.       popped_ok = .f.
  58.   endcase
  59.   *-- If a popup was activated, then
  60.   if popped_ok
  61.     *-- Get the response number (the first non-blank character on the left)
  62.     resp_num = left (ltrim (prompt ()), 1)
  63.     do case
  64.       *-- If the response was not blank (by pressing Esc, for example)
  65.       *-- and the response was not not number 0 (to skip)
  66.       case "" # resp_num .and. resp_num # "0"
  67.         *-- "Type" the response
  68.         keyboard resp_num
  69.       *-- If the left or right arrow was pressed to exit the popup
  70.       case lastkey () = 19 .or. lastkey () = 4          && 19 = left arrow, 4 = right arrow
  71.         *-- Go to the previous or next field
  72.         keyboard chr (iif (lastkey () = 19, 5, 24))     && 5 = up arrow, 24 = down arrow
  73.       otherwise
  74.         *-- otherwise, if the key pressed to get to the field in the first
  75.         *-- place was an alphabetic key (ASCII value >= 32)
  76.         *-- just "type" an Enter (ASCII 13) to move to next field
  77.         *-- otherwise, "type" that key again.  This will allow you to move
  78.         *-- backwards through the fields by pressing Esc at the popup
  79.         keyboard iif (asc (last_key) >= 32, chr (13), last_key)
  80.     endcase
  81.   endif
  82. *-- Must return TRUE for field to be edited, and KEYBOARDed response to be recognized
  83. return .t.
  84.  
  85.  
  86. ****************************************
  87. * DefPops
  88. * -------
  89. *
  90. * DEFINEs all of the POPUPs that are used in the survey program.
  91. *
  92. * To be called before READ/EDIT/APPEND.
  93. *
  94. * All popups have the question at the top, and a choice number 0 to skip
  95. * the question.
  96. *
  97. * All popups are set to DEACTIVATE upON SELECTION, so that control will
  98. * be returned to the calling function/procedure.
  99. *
  100. procedure defpops
  101.   private pop_messg
  102.   *-- Define message that will be used for all the popups
  103.   pop_messg = "Select: " + chr (17) + chr (196) + chr (217) + "   Skip: Esc" + ;
  104.     "   Previous: " + chr (27) + "   Next: " + chr (26)
  105.   *-- Define popup for Q1
  106.   define popup popq1 from  7, 9 message pop_messg
  107.   define bar  1 of popq1 prompt " My idea of a great date is" skip
  108.   define bar  2 of popq1 prompt "────────────────────────────" skip
  109.   define bar  3 of popq1 prompt " 1 - Dinner in Paris"
  110.   define bar  4 of popq1 prompt " 2 - Breakfast in Monaco"
  111.   define bar  5 of popq1 prompt " 3 - Lunch at McDonald's"
  112.   define bar  6 of popq1 prompt " ─────" skip
  113.   define bar  7 of popq1 prompt " 0 - Skip this question"
  114.   on selection popup popq1 deactivate popup
  115.   *-- Define popup for Q2
  116.   define popup popq2 from  9, 9 message pop_messg
  117.   define bar  1 of popq2 prompt " My best asset is my" skip
  118.   define bar  2 of popq2 prompt "──────────────────────────────────────────────────────" skip
  119.   define bar  3 of popq2 prompt " 1 - Quick, open, and inquisitive mind"
  120.   define bar  4 of popq2 prompt " 2 - Commanding physical presence"
  121.   define bar  5 of popq2 prompt " 3 - Wisdom and maturity"
  122.   define bar  6 of popq2 prompt " 4 - Sensitivity and undying devotion"
  123.   define bar  7 of popq2 prompt " 5 - Modesty and humility"
  124.   define bar  8 of popq2 prompt " 6 - Ability to leap tall buildings in a single bound"
  125.   define bar  9 of popq2 prompt " 7 - All of the above"
  126.   define bar 10 of popq2 prompt " ─────" skip
  127.   define bar 11 of popq2 prompt " 0 - Skip this question"
  128.   on selection popup popq2 deactivate popup
  129.   *-- Define popup for Q3
  130.   define popup popq3 from 11, 9 message pop_messg
  131.   define bar  1 of popq3 prompt " The first thing I look" skip
  132.   define bar  2 of popq3 prompt " for in a man is" skip
  133.   define bar  3 of popq3 prompt "────────────────────────" skip
  134.   define bar  4 of popq3 prompt " 1 - Nice hair"
  135.   define bar  5 of popq3 prompt " 2 - A big wallet"
  136.   define bar  6 of popq3 prompt " 3 - Long fingers"
  137.   define bar  7 of popq3 prompt " 4 - A pulse"
  138.   define bar  8 of popq3 prompt " ─────" skip
  139.   define bar  9 of popq3 prompt " 0 - Skip this question"
  140.   on selection popup popq3 deactivate popup
  141.   *-- Define popup for Q4
  142.   define popup popq4 from  7,28 message pop_messg
  143.   define bar  1 of popq4 prompt " I try to avoid men who" skip
  144.   define bar  2 of popq4 prompt "───────────────────────────────────" skip
  145.   define bar  3 of popq4 prompt " 1 - are named Wendell"
  146.   define bar  4 of popq4 prompt " 2 - part their hair in the middle"
  147.   define bar  5 of popq4 prompt " 3 - have long fingers"
  148.   define bar  6 of popq4 prompt " 4 - bowl regularly"
  149.   define bar  7 of popq4 prompt " 5 - eat sushi"
  150.   define bar  8 of popq4 prompt " ─────" skip
  151.   define bar  9 of popq4 prompt " 0 - Skip this question"
  152.   on selection popup popq4 deactivate popup
  153.   *-- Define popup for Q5
  154.   define popup popq5 from  9,28 message pop_messg
  155.   define bar  1 of popq5 prompt " My favorite color is" skip
  156.   define bar  2 of popq5 prompt "────────────────────────" skip
  157.   define bar  3 of popq5 prompt " 1 - Vermilion"
  158.   define bar  4 of popq5 prompt " 2 - Tangerine"
  159.   define bar  5 of popq5 prompt " 3 - Goldenrod"
  160.   define bar  6 of popq5 prompt " 4 - Chartreuse"
  161.   define bar  7 of popq5 prompt " 5 - Cobalt"
  162.   define bar  8 of popq5 prompt " 6 - Heliotrope"
  163.   define bar  9 of popq5 prompt " 7 - Brown"
  164.   define bar 10 of popq5 prompt " ─────" skip
  165.   define bar 11 of popq5 prompt " 0 - Skip this question"
  166.   on selection popup popq5 deactivate popup
  167.   *-- Define popup for Q6
  168.   define popup popq6 from 11,28 message pop_messg
  169.   define bar  1 of popq6 prompt " My favorite ice cream is" skip
  170.   define bar  2 of popq6 prompt "──────────────────────────" skip
  171.   define bar  3 of popq6 prompt " 1 - Strawberry"
  172.   define bar  4 of popq6 prompt " 2 - Vanilla"
  173.   define bar  5 of popq6 prompt " 3 - Chocolate"
  174.   define bar  6 of popq6 prompt " 4 - Neopolitan"
  175.   define bar  7 of popq6 prompt " ─────" skip
  176.   define bar  8 of popq6 prompt " 0 - Skip this question"
  177.   on selection popup popq6 deactivate popup
  178. return
  179.  
  180.  
  181. ****************************************
  182. * KilPops
  183. * -------
  184. *
  185. * Releases popups from memory (not patricide).
  186. *
  187. *
  188. procedure kilpops
  189.   release popup popq1, popq2, popq3, popq4, popq5, popq6
  190. return
  191.  
  192.