home *** CD-ROM | disk | FTP | other *** search
/ Simtel MSDOS 1992 September / Simtel20_Sept92.cdr / msdos / clipper / nannws13.arc / MENUDEMO.PRG < prev    next >
Text File  |  1987-02-13  |  6KB  |  223 lines
  1. *************************************************************
  2. * Program.....: Menudemo
  3. * Author......: Jason Castle
  4. * Date........: 07/18/86
  5. * Purpose.....: To demonstrate use of Clipper
  6. *               extensions to create pull-down menus:
  7. *
  8. *                  SET MESSAGE TO <expN>
  9. *                  @ <row,col> PROMPT <expC> [MESSAGE <expC>]
  10. *                  MENU TO <memvar>
  11. *                  KEYBOARD
  12. *                  SET KEY
  13. *                  SAVE SCREEN
  14. *                  RESTORE SCREEN
  15. *                  @ <row,col> TO <row,col>
  16. *
  17. * Note........: This is a take-off on MENU.PRG provided on
  18. *               the Clipper Utilities disk. Modified slightly
  19. *               for publication 12/86. Runs under Winter '85
  20. *               or Autumn '86 versions.
  21. *************************************************************
  22. *
  23. CLEAR
  24. *
  25. * display menu description on line 24:
  26. SET MESSAGE TO 24
  27. *
  28. * single-line frame for BOX command:
  29. single = CHR(218) + CHR(196) + CHR(191) + CHR(179) + CHR(217) +;
  30.          CHR(196) + CHR(192) + CHR(179) + CHR(32)
  31. *
  32. * double-line frame for BOX command:
  33. double = CHR(201) + CHR(205) + CHR(187) + CHR(186) + CHR(188) +;
  34.          CHR(205) + CHR(200) + CHR(186) + CHR(32)
  35. *
  36. *
  37. menu_id = 1          && top level menu item
  38. item_id = 1          && pull-down menu item
  39. *
  40. * Rectangle to designate area available to program modules:
  41. @ 2,0,23,79 BOX single
  42. *
  43. * main loop:
  44. *
  45. sysquit = .F.
  46. *
  47. DO WHILE .NOT. sysquit
  48.   DO WHILE (menu_id != 0)
  49.     SET INTENSITY ON
  50.     @ 01,00 PROMPT " File " ;
  51.     MESSAGE 'Open, Save, or Print a file; Quit system'
  52.     @ 01,06 PROMPT " Edit " ;
  53.     MESSAGE 'Copy, Paste, or Erase a selection'
  54.     @ 01,12 PROMPT " Reports " ;
  55.     MESSAGE 'Weekly, Monthly, Summary, Regions reports'
  56.     @ 01,21 PROMPT " Utilities " ;
  57.     MESSAGE 'Change date, Reindex files, etc.'
  58.     MENU TO menu_id
  59.     *
  60.     IF (menu_id != 0)            && esc to exit
  61.       SAVE SCREEN
  62.       DO Sub_Menu WITH menu_id
  63.       RESTORE SCREEN
  64.  
  65.       * if not esc from top menu or quit from menu 1 put
  66.       * up small menu in center of screen.
  67.  
  68.       IF (item_id != 0) .AND. !(item_id = 4 .AND. menu_id = 1)
  69.         SET INTENSITY OFF
  70.         * next 8 lines are for demo purposes only:
  71.         @ 10,30,15,50 BOX double
  72.         @ 12,35 SAY 'Menu no.: ' + LTRIM(STR(menu_id))
  73.         @ 13,35 SAY 'Item no.: ' + LTRIM(STR(item_id))
  74.         @ 24,0
  75.         nput = ' '
  76.         @ 24,0 SAY 'Press any key to continue...' ;
  77.         GET nput PICTURE '!'
  78.         READ
  79.         *
  80.         DO CASE
  81.           CASE menu_id = 1
  82.             * File:
  83.             DO CASE
  84.               CASE item_id = 1
  85.                 * DO Open          && Put program modules
  86.               CASE item_id = 2      && into these slots
  87.                 * DO Save
  88.               CASE item_id = 3
  89.                 * DO Print
  90.               CASE item_id = 4
  91.                 * DO Quit:
  92.                 EXIT
  93.             ENDCASE
  94.           CASE menu_id = 2
  95.             * Edit:
  96.             DO CASE
  97.               CASE item_id = 1
  98.                 * DO Copy
  99.               CASE item_id = 2             
  100.                 * DO Paste
  101.               CASE item_id = 3
  102.                 * DO Erase
  103.             ENDCASE
  104.           CASE menu_id = 3
  105.             * Reports:
  106.             DO CASE
  107.               CASE item_id = 1
  108.                 * DO Weekly
  109.               CASE item_id = 2
  110.                 * DO Monthly
  111.               CASE item_id = 3
  112.                 * DO Summary
  113.               CASE item_id = 4
  114.                 * DO Regions
  115.             ENDCASE
  116.           CASE menu_id = 4
  117.             * Utilities:
  118.             DO CASE
  119.               CASE item_id = 1
  120.                 * DO Date
  121.               CASE item_id = 2             
  122.                 * DO Reindex
  123.               CASE item_id = 3
  124.                 * DO Purge
  125.               CASE item_id = 4
  126.                 * DO Backup
  127.               CASE item_id = 5
  128.                 * DO Space_on_disk
  129.             ENDCASE
  130.         ENDCASE
  131.         @ 2,0 CLEAR
  132.         @ 2,0,23,79 BOX single
  133.       ENDIF
  134.       * if quit from menu 1 then exit from loop
  135.       IF  (item_id = 4 .AND. menu_id = 1)
  136.         EXIT
  137.       ENDIF
  138.     ENDIF
  139.   ENDDO
  140.   *
  141.   SET INTENSITY OFF
  142.   * Quit System:
  143.   halt = 'N'
  144.   @ 24,0
  145.   @ 24,0  SAY 'Are you sure you wish to quit system? [Y/N]'
  146.   @ 24,45 GET halt PICTURE '!'
  147.   READ
  148.   IF halt = 'Y'
  149.     sysquit = .T.
  150.   ELSE
  151.     menu_id = 1
  152.     LOOP
  153.   ENDIF
  154. ENDDO
  155.  
  156. *
  157. CLEAR
  158. RETURN
  159. * End-of-Program
  160. **************************************
  161. PROCEDURE Sub_Menu
  162.   PARAMETER menu_number
  163.   *
  164.   DO CASE
  165.     CASE menu_number = 1
  166.       * File:
  167.       @ 2,0,7,8 BOX double
  168.       @ 3,1 PROMPT ' Open  '     
  169.       @ 4,1 PROMPT ' Save  '       && add MESSAGEs to these
  170.       @ 5,1 PROMPT ' Print '       && PROMPTs, if desired
  171.       @ 6,1 PROMPT ' Quit  '
  172.     CASE menu_number = 2
  173.       * Edit:
  174.       @ 2,6,6,14 BOX double
  175.       @ 3,7 PROMPT ' Copy  '
  176.       @ 4,7 PROMPT ' Paste '
  177.       @ 5,7 PROMPT ' Erase '
  178.     CASE menu_number = 3
  179.       * Reports:
  180.       @ 2,12,7,22 BOX double
  181.       @ 3,13 PROMPT ' Weekly  '
  182.       @ 4,13 PROMPT ' Monthly '
  183.       @ 5,13 PROMPT ' Summary '
  184.       @ 6,13 PROMPT ' Regions '
  185.     CASE menu_number = 4
  186.       * Utilities:
  187.       @ 2,21,8,31 BOX double
  188.       @ 3,22 PROMPT ' Date    '
  189.       @ 4,22 PROMPT ' Reindex '
  190.       @ 5,22 PROMPT ' Purge   '
  191.       @ 6,22 PROMPT ' Backup  '
  192.       @ 7,22 PROMPT ' Space   '
  193.   ENDCASE
  194.  
  195.   * assign to cursor keys procedures for shifting right and left:
  196.   SET KEY 19 TO Left_Arrow
  197.   SET KEY 4 TO Right_Arrow
  198.   *
  199.   MENU TO item_id
  200.   *
  201.   * release left and right arrow keys:
  202.   SET KEY 19 TO
  203.   SET KEY 4 TO
  204.   *
  205.   RETURN
  206. *ENDPROC: Sub_Menu
  207. **************************************
  208. PROCEDURE Left_Arrow
  209.   PARAMETER pn, pl, rv
  210.   * esc, up arrow, return:
  211.   KEYBOARD CHR(27) + CHR(5) + CHR(13)
  212.   RETURN
  213. *ENDPROC: Left_Arrow
  214. **************************************
  215. PROCEDURE Right_Arrow
  216.   PARAMETER pn, pl, rv
  217.   * esc, right arrow, return:
  218.   KEYBOARD CHR(27) + CHR(4) + CHR(13)
  219.   RETURN
  220. *ENDPROC: Right_Arrow
  221. **************************************
  222. * End-of-File
  223.