home *** CD-ROM | disk | FTP | other *** search
/ Media Share 9 / MEDIASHARE_09.ISO / clarion / pulldn1.zip / ONEMENU.CLA < prev    next >
Text File  |  1989-02-27  |  15KB  |  415 lines
  1.          MEMBER('PullDown')
  2.  
  3.  !*****************************************************************************
  4.  !* To modify this procedure for any desired layout:
  5.  !*
  6.  !* Modify Screen fOneMenu and Windows wTopic1, wTopic2, wTopic3 & wTopic4.
  7.  !*   Windows wTopic1, wTopic2, wTopic3 & wTopic4 MUST exist even
  8.  !*    if not used, unless program modifications are done.
  9.  !*   I would recommend keeping the window names generic.  Minimizes
  10.  !*    required changes when adapting for different purposes.
  11.  !*
  12.  !* Modify Routines SetMenu (for menu names), EnterKey (for menu actions).
  13.  !*
  14.  !* Modify ibNbrTopics declaration (Minimum = 2, Maximum = 5 as set up.
  15.  !*
  16.  !* Topic 'Quit' (or 'Exit' or whatever) must be the LAST topic.
  17.  !*   'LAST topic' does not mean Nbr 5 - just the last non-nulled topic.
  18.  !*
  19.  !* If screen color scheme changed then color declarations must also be
  20.  !*   changed in the variable section.
  21.  !*
  22.  !* Modified & Uploaded by Bill Mueller of Mueller's PC Consulting.
  23.  !*
  24.  !*****************************************************************************
  25.  
  26.  !***************************************************** Procedure OneMenu *****
  27. OneMenu         PROCEDURE
  28.  
  29. fOneMenu     SCREEN      PRE(Scr),HUE(6,0,0)
  30.  OMIT('**-END-**')
  31. ╔══════════════════════════════════════════════════════════════════════════════╗
  32. ║   ■■■■■■■■■■■■   ■■■■■■■■■■■■      ■■■■■■■■■■■■     ■■■■■■■■■■■■    ■■■■■■■■■■■■   ║
  33. ╠══════════════════════════════════════════════════════════════════════════════╣
  34. ║                                           ║
  35. ║                                           ║
  36. ║                                           ║
  37. ║            ██          ██                           ║
  38. ║            ██          ██                           ║
  39. ║            ██          ██                           ║
  40. ║            ██          ██   ████████████                       ║
  41. ║            ███         ███    ██                       ║
  42. ║              ███  ███        ██      ████████████               ║
  43. ║            ████        ██      ██                   ║
  44. ║                    ██      ██                   ║
  45. ║                    ██      ████████████               ║
  46. ║                    ██            ██               ║
  47. ║                                ██               ║
  48. ║                          ████████████               ║
  49. ║                                           ║
  50. ║              The Vacation Tracking System                   ║
  51. ║                                           ║
  52. ║                                           ║
  53. ║    Ver 1.1  Copyright 1987  Barrington Systems, Inc.    ALL RIGHTS RESERVED    ║
  54. ╚══════════════════════════════════════════════════════════════════════════════╝
  55. ■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■■
  56. **-END-**
  57.  
  58.            ROW(1,1)      STRING('╔═{78}╗'),HUE(3,0)
  59.            ROW(2,1)      STRING('║<0{78}>║'),HUE(3,0)
  60.            ROW(3,1)      STRING('╠═{78}╣'),HUE(3,0)
  61.            ROW(4,1)      REPEAT(20);STRING('║<0{78}>║'),HUE(3,0) .
  62.            ROW(24,1)  STRING('╚═{78}╝'),HUE(3,0)
  63.            ROW(7,21)  REPEAT(3);STRING('██<0{8}>██'),HUE(11,1) .
  64.            ROW(10,21) STRING('██<0{8}>██<0{3}>█{12}'),HUE(11,1)
  65.            ROW(11,21) STRING('███<0{6}>███<0{8}>██'),HUE(11,1)
  66.            ROW(12,23) STRING('███<0,0>███<0{10}>██<0{8}>█{12}'),HUE(11,1)
  67.            ROW(13,25) STRING('████<0{12}>██<0{8}>██'),HUE(11,1)
  68.            ROW(14,41) STRING('██<0{8}>██'),HUE(11,1)
  69.            ROW(15,41) STRING('██<0{8}>█{12}'),HUE(11,1)
  70.            ROW(16,41) STRING('██<0{18}>██'),HUE(11,1)
  71.            ROW(17,61) STRING('██'),HUE(11,1)
  72.            ROW(18,51) STRING('█{12}'),HUE(11,1)
  73.            ROW(20,27) STRING('The Vacation Tracking System'),HUE(13,0)
  74.            ROW(23,6)  STRING('Ver 1.1  Copyright 1987  Barrington Systems,'|
  75.                 & ' Inc.  ALL RIGHTS RESERVED')
  76. ssMenu1           ROW(2,5)      STRING(12),HUE(7,0)
  77. ssMenu2         COL(20)  STRING(12),HUE(7,0)
  78. ssMenu3         COL(35)  STRING(12),HUE(7,0)
  79. ssMenu4         COL(50)  STRING(12),HUE(7,0)
  80. ssMenu5         COL(65)  STRING(12),HUE(7,0)
  81. ssMsg           ROW(25,1)  STRING(80),ENH
  82.          .
  83.  
  84.               !************************ Screen wTopic1 *****
  85. wTopic1         SCREEN      WINDOW(11,17),AT(IBWINROW,IBWINCOL),HUE(6,0)
  86.  OMIT('**-END-**')
  87.                  ╗         ╔
  88.                  ║         ║
  89.                  ║  Request Vac     ║
  90.                  ║         ║
  91.                  ║  Cancel Vac     ║
  92.                  ║         ║
  93.                  ║  Vac Inquiry     ║
  94.                  ║         ║
  95.                  ║  Post Vacs     ║
  96.                  ║         ║
  97.                  ╚═══════════════╝
  98. **-END-**
  99.  
  100.            ROW(1,1)      STRING('╗<0{15}>╔'),HUE(3,0)
  101.            ROW(2,1)      REPEAT(9);STRING('║<0{15}>║'),HUE(3,0) .
  102.            ROW(11,1)  STRING('╚═{15}╝'),HUE(3,0)
  103.            ROW(1,1)      MENU,REQ
  104.            ROW(3,4)        STRING('Request Vac')
  105.            ROW(5,4)        STRING('Cancel Vac')
  106.            ROW(7,4)        STRING('Vac Inquiry')
  107.            ROW(9,4)        STRING('Post Vacs')
  108.          .          .
  109.  
  110.               !************************** Screen wTopic2 *****
  111. wTopic2         SCREEN      WINDOW(15,17),AT(IBWINROW,IBWINCOL),HUE(6,0)
  112.  OMIT('**-END-**')
  113.                 ╗        ╔
  114.                 ║        ║
  115.                 ║ Calendar    ║
  116.                 ║        ║
  117.                 ║ Day Info    ║
  118.                 ║        ║
  119.                 ║ Status Report ║
  120.                 ║        ║
  121.                 ║ Employee List ║
  122.                 ║        ║
  123.                 ║ Mail Labels    ║
  124.                 ║        ║
  125.                 ║ Excess Days    ║
  126.                 ║        ║
  127.                 ╚═══════════════╝
  128. **-END-**
  129.  
  130.            ROW(1,1)      STRING('╗<0{15}>╔'),HUE(3,0)
  131.            ROW(2,1)      REPEAT(13);STRING('║<0{15}>║'),HUE(3,0) .
  132.            ROW(15,1)  STRING('╚═{15}╝'),HUE(3,0)
  133.            ROW(1,1)      MENU,REQ
  134.            ROW(3,3)        STRING('Calendar')
  135.            ROW(5,3)        STRING('Day Info')
  136.            ROW(7,3)        STRING('Status Report')
  137.            ROW(9,3)        STRING('Employee List')
  138.            ROW(11,3)    STRING('Mail Labels')
  139.            ROW(13,3)    STRING('Excess Days')
  140.          .          .
  141.  
  142.               !************************ Screen wTopic3 *****
  143. wTopic3         SCREEN      WINDOW(9,17),AT(IBWINROW,IBWINCOL),HUE(6,0)
  144.  OMIT('**-END-**')
  145.                   ╗          ╔
  146.                   ║          ║
  147.                   ║    Add      ║
  148.                   ║          ║
  149.                   ║    Change      ║
  150.                   ║          ║
  151.                   ║    Delete      ║
  152.                   ║          ║
  153.                   ╚═══════════════╝
  154. **-END-**
  155.  
  156.            ROW(1,1)      STRING('╗<0{15}>╔'),HUE(3,0)
  157.            ROW(2,1)      REPEAT(7);STRING('║<0{15}>║'),HUE(3,0) .
  158.            ROW(9,1)      STRING('╚═{15}╝'),HUE(3,0)
  159.            ROW(1,1)      MENU,REQ
  160.            ROW(3,6)        STRING('Add')
  161.            ROW(5,6)        STRING('Change')
  162.            ROW(7,6)        STRING('Delete')
  163.          .          .
  164.  
  165.               !************************ Screen wTopic4 *****
  166. wTopic4         SCREEN      WINDOW(19,17),AT(IBWINROW,IBWINCOL),HUE(6,0)
  167.  OMIT('**-END-**')
  168.                 ╗        ╔
  169.                 ║        ║
  170.                 ║ Back Up Files ║
  171.                 ║        ║
  172.                 ║ Restore Files ║
  173.                 ║        ║
  174.                 ║ Rbld Employee ║
  175.                 ║        ║
  176.                 ║ Rbld Vacation ║
  177.                 ║        ║
  178.                 ║ Change Dept    ║
  179.                 ║        ║
  180.                 ║ Chng Holidays ║
  181.                 ║        ║
  182.                 ║ Change Year    ║
  183.                 ║        ║
  184.                 ║ DOS Shell    ║
  185.                 ║        ║
  186.                 ╚═══════════════╝
  187. **-END-**
  188.  
  189.            ROW(1,1)      STRING('╗<0{15}>╔'),HUE(3,0)
  190.            ROW(2,1)      REPEAT(17);STRING('║<0{15}>║'),HUE(3,0) .
  191.            ROW(19,1)  STRING('╚═{15}╝'),HUE(3,0)
  192.            ROW(1,1)      MENU,REQ
  193.            ROW(3,3)        STRING('Back Up Files')
  194.            ROW(5,3)        STRING('Restore Files')
  195.            ROW(7,3)        STRING('Rbld Employee')
  196.            ROW(9,3)        STRING('Rbld Vacation')
  197.            ROW(11,3)    STRING('Change Dept')
  198.            ROW(13,3)    STRING('Chng Holidays')
  199.            ROW(15,3)    STRING('Change Year')
  200.            ROW(17,3)    STRING('DOS Shell')
  201.          .          .
  202.  
  203.               !************************* Vars for OneMenu *****
  204. ibBackColor  BYTE(0)          !* Background color
  205. ibCol         BYTE          !* Column current topic starts in.
  206. ibForeOn     BYTE(15)          !* Foreground when on topic
  207. ibForeOff    BYTE(7)          !* Foreground when off topic
  208. ibForeQuit   BYTE(22)          !* Foreground for 'Quit' option
  209. ibNbrTopics  BYTE(5)          !* Number of non-null topics
  210. ibRow         BYTE          !* Topic row.
  211. ibTopicPos   BYTE          !* Current Topic position
  212. ibWinCol     BYTE          !* Column of current topic window.
  213. ibWinRow     BYTE          !* Row of current topic window.
  214. s12TopicMsg  STRING(12)          !* Topic menu choice
  215.  
  216.            CODE      !************************* Code for OneMenu *****
  217.   OPEN(fOneMenu)
  218.   DO Show_Msg                   !* Show line 25 help.
  219.   DO MenuAlerts                   !* Turn on alert keys for menu
  220.   DO SetMenu                   !* Display main menu line.
  221.   ibRow = ROW(ssMenu1)               !* Row of main menu line.
  222.   ibWinRow = ibRow + 1               !* Row for topic option windows.
  223.   ibCol = COL(ssMenu1)               !* Column for first topic.
  224.   ibWinCol = ibCol - 2               !* Column for first topic window.
  225.   ibTopicPos = 1               !* Set to first topic.
  226.   s12TopicMsg = ssMenu1               !* Set to first topic choice.
  227.   DO TopicOn                   !* Display topic in ibForeOn color.
  228.   DO OpenTopic                   !* Open topic window.
  229.   LOOP                       !* Main LOOP
  230.     ACCEPT                   !* Get a key
  231.     IF ibTopicPos = ibNbrTopics AND KEYCODE() = Enter_Key
  232.       BREAK                   !***** EXITS PROCEDURE *****
  233.     END
  234.     CASE KEYCODE()               !* Check what key was pressed.
  235.     OF Left_Key
  236.       DO LeftKey               !* Do LeftKey processing.
  237.     OF Right_Key
  238.       DO RightKey               !* DO RightKey processing.
  239.     OF Esc_Key
  240.       DO EscKey                   !* Do EscKey processing.
  241.     OF Enter_Key
  242.       DO CloseTopic               !* Close Topic window.
  243.       ssMsg = ''               !* Clear line 25 help.
  244.       DO EnterKey               !* Do EnterKey processing.
  245.       DO Show_Msg               !* Display line 25 help.
  246.       DO SetMenu               !* Display Main menu line.
  247.       DO TopicOn               !* Highlight topic.
  248.       DO OpenTopic               !* Open Topic window.
  249.       DO MenuAlerts               !* Turn on alert keys for menu
  250.     ELSE
  251.       BEEP()
  252.     END           !** CASE KEYCODE() **
  253.   END           !** Main LOOP **
  254.  
  255.               !********************* ROUTINEs for OneMenu *****
  256. Show_Msg     ROUTINE      !************************* Routine Show_Msg *****
  257.   ssMsg = CENTER('<<F1> = Help,  <26> to choose Subject,   to choose' &    |
  258.     ' Topic, <<Esc> selects Quit.',SIZE(ssMsg))
  259.  
  260. SetMenu         ROUTINE      !************************** Routine SetMenu *****
  261.   ssMenu1 = CENTER('Vacations',SIZE(ssMenu1))
  262.   ssMenu2 = CENTER('Reports',SIZE(ssMenu2))
  263.   ssMenu3 = CENTER('Employees',SIZE(ssMenu3))
  264.   ssMenu4 = CENTER('Utilities',SIZE(ssMenu4))
  265.   ssMenu5 = CENTER('Quit',SIZE(ssMenu5))
  266.     !** EXAMPLE of changing the topic layout **
  267.     !**      To remove the utilities topic, change last 2 lines to **
  268.       !* ssMenu4 = CENTER('Quit',SIZE(ssMenu4))
  269.       !* ssMenu5 = CENTER('',SIZE(ssMenu5))
  270.     !**      And change declaration for ibNbrTopics in Var section above **
  271.       !* ibNbrTopics  BYTE(4)  !* Number of topics
  272.     !***** 'Quit' must be the last topic *****
  273.  
  274. SetCol         ROUTINE      !*************************** Routine SetCol *****
  275.   CASE ibTopicPos      !* Check what topic we're on - set Column & Msg.
  276.   OF 1; ibCol = COL(ssMenu1); s12TopicMsg = ssMenu1
  277.   OF 2; ibCol = COL(ssMenu2); s12TopicMsg = ssMenu2
  278.   OF 3; ibCol = COL(ssMenu3); s12TopicMsg = ssMenu3
  279.   OF 4; ibCol = COL(ssMenu4); s12TopicMsg = ssMenu4
  280.   OF 5; ibCol = COL(ssMenu5); s12TopicMsg = ssMenu5
  281.   END           !** CASE ibTopicPos **
  282.   ibWinCol = ibCol - 2               !* Set window column position.
  283.  
  284. OpenTopic    ROUTINE      !************************ Routine OpenTopic *****
  285.   CASE ibTopicPos      !* Check what topic we're on & open window
  286.   OF 1; OPEN(wTopic1)
  287.   OF 2; OPEN(wTopic2)
  288.   OF 3; OPEN(wTopic3)
  289.   OF 4; OPEN(wTopic4)
  290.   END           !** CASE ibTopicPos **
  291.  
  292. CloseTopic   ROUTINE      !*********************** Routine CloseTopic *****
  293.   CASE ibTopicPos      !* Check what topic we're on & close window
  294.   OF 1; CLOSE(wTopic1)
  295.   OF 2; CLOSE(wTopic2)
  296.   OF 3; CLOSE(wTopic3)
  297.   OF 4; CLOSE(wTopic4)
  298.   END           !** CASE ibTopicPos **
  299.  
  300. LeftKey         ROUTINE      !************************** Routine LeftKey *****
  301.          !* Left Arrow processing routine
  302.   IF ibTopicPos <> ibNbrTopics THEN DO CloseTopic; END
  303.   DO TopicOff
  304.   ibTopicPos -= 1
  305.   IF ibTopicPos = 0 THEN ibTopicPos = ibNbrTopics; END
  306.   DO SetCol
  307.   DO TopicOn
  308.   IF ibTopicPos = ibNbrTopics           !* Topic 'Quit'
  309.     DO BadKey
  310.   ELSE                       !* Other Topics
  311.     DO OpenTopic
  312.   END           !** IF ibTopicPos = ibNbrTopics **
  313.  
  314. RightKey     ROUTINE      !************************* Routine RightKey *****
  315.          !* Right Arrow processing routine
  316.   IF ibTopicPos <> ibNbrTopics THEN DO CloseTopic; END
  317.   DO TopicOff
  318.   ibTopicPos += 1
  319.   IF ibTopicPos > ibNbrTopics THEN ibTopicPos = 1; END
  320.   DO SetCol
  321.   DO TopicOn
  322.   IF ibTopicPos = ibNbrTopics           !* Topic 'Quit'
  323.     DO BadKey
  324.   ELSE                       !* Other Topics
  325.     DO OpenTopic
  326.   END           !** IF ibTopicPos = ibNbrTopics **
  327.  
  328. EscKey         ROUTINE      !*************************** Routine EscKey *****
  329.          !* Escape key processing routine
  330.   IF ibTopicPos <> ibNbrTopics
  331.     DO CloseTopic
  332.     DO TopicOff
  333.     ibTopicPos = ibNbrTopics           !* Set topic to 'Quit'.
  334.     DO SetCol
  335.     DO TopicOn
  336.   END
  337.   LOOP
  338.     ASK                       !* Get a key
  339.     IF KEYCODE() = Enter_Key OR KEYCODE() = Right_Key OR KEYCODE() = Left_Key
  340.       BREAK
  341.     ELSE BEEP()
  342.     END
  343.   END
  344.  
  345. EnterKey     ROUTINE      !************************* Routine EnterKey *****
  346.          !* Enter key processing routine
  347.   CASE ibTopicPos               !* Check what topic we're on
  348.   OF 1                       !* First Topic
  349.     EXECUTE CHOICE()               !* Run menu choice
  350.  !    REQUEST                   !*   Vacation request
  351.  !    INQUIRY(1)               !*   Cancel
  352.  !    INQUIRY(0)               !*   Inquiry
  353.  !    POST_VACS                   !*   Post Vacations
  354.     END           !** EXECUTE CHOICE() for Topic 1 **
  355.   OF 2                       !* Second Topic.
  356.     EXECUTE CHOICE()
  357.  !    CALENDAR
  358.  !    DAY_REPT
  359.  !    STAT_REPT
  360.  !    EMP_REPT
  361.  !    LABELS
  362.  !    EXCESS
  363.     END           !** EXECUTE CHOICE() for Topic 2 **
  364.   OF 3                       !* Third Topic.
  365.     EXECUTE CHOICE()
  366.  !    EMP_PROCESS
  367.  !    EMP_PROCESS
  368.  !    EMP_PROCESS
  369.     END           !** EXECUTE CHOICE() for Topic 3 **
  370.   OF 4                       !* Forth Topic.
  371.     EXECUTE CHOICE()
  372.  !    BACK_UP
  373.  !    REPLACE
  374.  !    EMP_FIX
  375.  !    VAC_FIX
  376.  !    DEPTMAINT
  377.  !    HOLMAINT
  378.  !    NEW_YEAR
  379.  !    DOS_RUN
  380.     END           !** EXECUTE CHOICE() for Topic 4 **
  381.     !* Next line needed if the procedures above are based on
  382.     !*   screens rather than windows as are Topics 1, 2 & 3.
  383.     OPEN(fOneMenu)
  384.   END           !** CASE ibTopicPos **
  385.  
  386. BadKey         ROUTINE      !*************************** Routine BadKey *****
  387.   LOOP
  388.     ASK                       !* Get a key.
  389.     IF KEYCODE() = Left_Key OR KEYCODE() = Right_Key OR KEYCODE() = Enter_Key
  390.       BREAK
  391.     ELSE BEEP()
  392.     END
  393.   END
  394.  
  395. MenuAlerts   ROUTINE      !*********************** Routine MenuAlerts *****
  396.   ALERT()
  397.   ALERT(Left_Key)
  398.   ALERT(Right_Key)
  399.   ALERT(Esc_Key)
  400.  
  401. TopicOff     ROUTINE      !************************* Routine TopicOff *****
  402.   SETHUE(ibForeOff,ibBackColor)           !* Sets color for off topic
  403.   SHOW(ibRow,ibCol,s12TopicMsg)
  404.   SETHUE(); NORMAL               !* Restores color to default
  405.  
  406. TopicOn         ROUTINE      !************************** Routine TopicOn *****
  407.   IF ibTopicPos = ibNbrTopics
  408.     SETHUE(ibForeQuit,ibBackColor)     !* Sets color for 'Quit' topic
  409.     REVERSE
  410.   ELSE
  411.     SETHUE(ibForeOn,ibBackColor)       !* Sets color for on topic
  412.   END
  413.   SHOW(ibRow,ibCol,s12TopicMsg)
  414.   SETHUE(); NORMAL               !* Restores color to default
  415.