home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload / ShartewareOverload.cdr / database / instapop.zip / SURVMAIN.PRG < prev    next >
Text File  |  1991-02-19  |  9KB  |  320 lines
  1. * SurvMain.prg
  2. *
  3. * Main survey program
  4. *
  5. * 02/17/91
  6. *
  7.  
  8. *-- Set up
  9. *-- save SETtings
  10. private old_talk, old_status, old_conf, old_bell, old_exact
  11. old_talk = set ("talk")
  12. old_stat = set ("status")
  13. old_conf = set ("confirm")
  14. old_bell = set ("bell")
  15. old_exact = set ("exact")
  16. *-- make SETtings for program
  17. set talk off
  18. set status off                  && no status bar
  19. set confirm off                 && don't have to press Enter after every field
  20. set bell off                    && turn off annoying bell
  21. set exact off                   && don't require exact string matches
  22. *-- procedure
  23. set procedure to survproc
  24. *-- databases
  25. use survey
  26. *-- format
  27. set format to survform
  28.  
  29. *-- display background
  30. clear
  31. do backgrnd
  32. @  0, 0 say "Insta-Pop Demo"
  33.  
  34. *-- Show main menu popup
  35. define popup survmain from  3, 2
  36. define bar  1 of survmain prompt " Da Main Menu" skip
  37. define bar  2 of survmain prompt "──────────────" skip
  38. define bar  3 of survmain prompt " Add new" ;
  39.   message "Add new surveys to database"
  40. define bar  4 of survmain prompt " Lookup old" ;
  41.   message "Lookup old surveys by ID #"
  42. define bar  5 of survmain prompt " Reports" ;
  43.   message "Print reports and statistics"
  44. define bar  6 of survmain prompt "──────────────" skip
  45. define bar  7 of survmain prompt " Info" ;
  46.   message "Information about this program and how it was made.  GOOD READING!"
  47. define bar  8 of survmain prompt " Quit" ;
  48.   message "Pretty obvious"
  49. on selection popup survmain do mainmenu
  50. activate popup survmain
  51. *-- Popup will maintain control until Quit option is selected.  When
  52. *-- that happens, close everything
  53. release popup survmain
  54. close format
  55. close databases
  56. close procedure
  57. *-- reset SETtings
  58. set exact &old_exact
  59. set bell &old_bell
  60. set confirm &old_conf
  61. set status &old_stat
  62. set talk &old_talk
  63. clear
  64.  
  65. *-- and then quit.  But for this test program, just return to dot prompt
  66. return
  67. *
  68. *-- EOP: survmain
  69.  
  70.  
  71.  
  72.  
  73. ****************************************
  74. * MainMenu
  75. * --------
  76. *
  77. * Processes the choices made from popup survmain and takes the
  78. * appropriate action
  79. *
  80. procedure mainmenu
  81.   private choice
  82.   *-- trim leading blanks and make choice lower case for string matching
  83.   choice = lower (ltrim (prompt ()))
  84.   do case
  85.     case choice = "add"
  86.       *-- define the popups
  87.       do defpops
  88.       *-- save the screen
  89.       save screen to scratch
  90.       *-- let 'er rip
  91.       append
  92.       *-- restore screen
  93.       restore screen from scratch
  94.       release screen scratch
  95.       *-- undefine the popups to keep memory clear
  96.       do kilpops
  97.     case choice = "lookup"
  98.       *-- display message "Not done"
  99.       do notdone
  100.     case choice = "reports"
  101.       *-- display message "Not done"
  102.       do noway
  103.     case choice = "info"
  104.       *-- tell the user all about this program
  105.       do info
  106.     case choice = "quit"
  107.       *-- return control to main program be deactivating the popup
  108.       deactivate popup
  109.   endcase
  110. return
  111.  
  112.  
  113. ****************************************
  114. * Backgrnd
  115. * --------
  116. *
  117. * Displays a (funky) background to give screen depth
  118. *
  119. *
  120. procedure backgrnd
  121.   private rw
  122.   @  1, 0 say replicate ("▄", 80)
  123.   @ 23, 0 say replicate ("▀", 80)
  124.   rw = 20
  125.   do while rw > 1
  126.     @ rw, 0 say replicate ("░▒▓", 80)
  127.     rw = rw - 3
  128.   enddo
  129. return
  130.  
  131. ****************************************
  132. * NotDone
  133. * -------
  134. *
  135. * Display message saying "Not done".
  136. *
  137. procedure notdone
  138.   *-- screen will be restored by procedure clearmsg
  139.   save screen to scratch
  140.   *-- print message
  141.   @  6,20 to  9,58
  142.   @  7,21 clear to 8,57
  143.   @  7,22 say "Sorry, but that part of the program"
  144.   @  8,22 say "is not done yet."
  145.   *-- wait for a key press
  146.   on key do clearmsg
  147. return
  148.  
  149.  
  150. ****************************************
  151. * NoWay
  152. * -----
  153. *
  154. * Display message saying "Not done" in somewhat plainer language.
  155. *
  156. procedure noway
  157.   *-- screen will be restored by procedure clearmsg
  158.   save screen to scratch
  159.   @  7,20 to 11,54 double
  160.   @  8,21 clear to 10,53
  161.   @  8,22 say "What are you kidding?  There is"
  162.   @  9,22 say "no way that this thing would be"
  163.   @ 10,22 say "working at this juncture."
  164.   *-- wait for a key press
  165.   on key do clearmsg
  166. return
  167.  
  168.  
  169. ****************************************
  170. * ClearMsg
  171. * --------
  172. *
  173. * Clears the message by restoring the screen to its previous state.
  174. *
  175. * Normally, an ON KEY procedure should clear the keyboard buffer by
  176. * using an INKEY () statement, otherwise, the ON KEY procedure would
  177. * be called continuously.  But in this case, we want to pass the key
  178. * pressed to the popup, so we simply deactivate the ON KEY.  That
  179. * way, the message stays on screen until we press a key, and that
  180. * key does what it supposed to do normally.
  181. *
  182. procedure clearmsg
  183.   *-- restore screen and release it
  184.   restore screen from scratch
  185.   release screen scratch
  186.   *-- don't wait for another key
  187.   on key
  188. return
  189.  
  190.  
  191. ****************************************
  192. * Info
  193. * ----
  194. *
  195. * Describes how this Insta-Popup program was written
  196. *
  197. procedure info
  198.   private wait_key
  199.   *-- screen will be restored at end of procedure
  200.   save screen to scratch
  201.   *-- clear message line
  202.   @ 24, 0 clear to 24,79
  203.   *-- display a nice border
  204.   @  2,20 to 21,79 double
  205.   @  3,21 clear to 20,78
  206.   @  2,47 say " Info "
  207.   *-- and print inside a borderless window
  208.   define window scratch from  3,22 to 20,77 none
  209.   activate window scratch
  210.   text
  211. The making of the Survey program
  212.   ** Featuring Insta-Pop format screens **
  213. ──────────────────────────────────────────
  214.  
  215.  1. Create the Survey database file.
  216.  
  217.     SURVEY.dbf has an ID field, six question fields
  218.     named Q1 - Q6, and a field for the initials of
  219.     the person who typed in the data.
  220.  
  221.     It is a good idea to have a field at both the
  222.     beginning and the end of the READ/APPEND/EDIT
  223.     screen that does not have an instant popup.  That
  224.     way, a person can get out of the record right away
  225.     at the beginning or go back at the end.
  226.  
  227. Press any key to continue...
  228.   endtext
  229.   wait_key = inkey (0)
  230.   text
  231.  
  232.  2. Create the popup activation UDF.
  233.  
  234.     Since we are using format (.fmt) files, we need a
  235.     procedure file containing our popup activation
  236.     UDF, in this case called GOPOPUP ().  The procedure
  237.     file is named SURVPROC.
  238.  
  239.     The function includes a CASE structure to control
  240.     which popup named POPQ1 - POPQ6 is activated, some
  241.     logic to KEYBOARD the correct response, and must
  242.     RETURN .T. so that it can be used in the screen
  243.     definition.
  244.  
  245.     
  246.  
  247.  
  248. Press any key to continue...
  249.   endtext
  250.   wait_key = inkey (0)
  251.   text
  252.  
  253.  3. Create the screen and generate a format (.fmt)
  254.     file.  Put GOPOPUP () in all of the Permit edit if
  255.     clauses for each of the fields with an instant
  256.     popup.  Our screen/format is named SURVFORM.
  257.  
  258.  4. Edit the .fmt if necessary.
  259.  
  260.     In this case, we had the questions going down in
  261.     two columns.  The screen generator reads fields
  262.     across, not down, so the .fmt file had to be
  263.     edited so that the questions were in order.
  264.  
  265.     You should CLOSE FORMAT and erase the .fmo file
  266.     before making any changes.
  267.  
  268.  
  269. Press any key to continue...
  270.   endtext
  271.   wait_key = inkey (0)
  272.   text
  273.  
  274.  5. Create a "define all the relevant popups"
  275.     procedure.
  276.  
  277.     A single procedure can define all of the popups
  278.     in advance.  That way, all the popups will be in
  279.     memory and should perform faster.
  280.  
  281.     You may want to refer to the coordinates generated
  282.     by the screen designer to help in the placement of
  283.     the popups.
  284.  
  285.  6. Create a "release all of those popups I just
  286.     defined" procedure. This is for when the program is
  287.     finished; you don't want all those unwanted popups
  288.     lying around.
  289.  
  290. Press any key to continue...
  291.   endtext
  292.   wait_key = inkey (0)
  293.   text
  294.  
  295.  7. Create the main procedure.  The logic of this for
  296.     a program that just APPENDs is like:
  297.  
  298.     SET PROCEDURE TO <procedure file>
  299.     USE <database>
  300.     SET FORMAT TO <format file>
  301.     DO <define popup procedure>
  302.     APPEND
  303.     DO <undefine popup procedure>
  304.     CLOSE FORMAT
  305.     CLOSE DATABASES
  306.     CLOSE PROCEDURE
  307.  
  308.     This is essentially what this program, SURVMAIN,
  309.     does.
  310.  
  311. ** End of Info.  Press any key to return to main menu.
  312.   endtext
  313.   wait_key = inkey (0)
  314.   deactivate window scratch
  315.   release window scratch
  316.   restore screen from scratch
  317.   release screen scratch
  318. return
  319.  
  320.