home *** CD-ROM | disk | FTP | other *** search
/ Piper's Pit BBS/FTP: ibm 0020 - 0029 / ibm0020-0029 / ibm0028.tar / ibm0028 / VGATOOLS.ZIP / USEROO.ZIP / MENU.PAS next >
Encoding:
Pascal/Delphi Source File  |  1989-12-29  |  20.4 KB  |  637 lines
  1. {----------------------------------------------------------------------------}
  2. {                                                                            }
  3. {      Menu System  -  by Marcos Della       12/15/89                        }
  4. {                                                                            }
  5. {                      D&M Enterprises                                       }
  6. {                      c/o Marcos R. Della                                   }
  7. {                      PO Box 4251                                           }
  8. {                      Santa Rosa, CA 95402                                  }
  9. {                                                                            }
  10. { -------------------------------------------------------------------------- }
  11. {                                                                            }
  12. {    (c) Copyright D&M Enterprises, a general parternership, This program    }
  13. {      is CONFIDENTIAL, unpublished work of authorship created in 1989.      }
  14. {  IT IS A TRADE SECRET WHICH IS THE PROPERTY OF D&M ENTERPRISES, a general  }
  15. {   partnership.  ALL USE, DISCLOSURE, AND/OR REPRODUCTION NOT SPECIFICALLY  }
  16. {   AUTHORIZED BY D&M ENTERPRISES IS PROHIBITED.  This program may also be   }
  17. {       protected under copyright and similar laws of other countries.       }
  18. {                            All rights reserved.                            }
  19. {                                                                            }
  20. { -------------------------------------------------------------------------- }
  21. {                                                                            }
  22. {     You have two different styles of menus available with this unit. They  }
  23. {     are a standard selection box (like you see under the F in File when    }
  24. {     in the turbo editor) and a bar system with attached selection boxes.   }
  25. {                                                                            }
  26. {     These routines were designed to be VERY easy to use and implement in   }
  27. {     your own programs.  To use them, you can define your menus as static   }
  28. {     variables or dynamic for usage throughout your program...              }
  29. {                                                                            }
  30. {     VAR   m_menu : menuptr;                                                }
  31. {     BEGIN                                                                  }
  32. {        NEW(m_menu,init(15,10,'Test menu');                                 }
  33. {        m_menu^.add_option('/Load/Pick/Save/Write to/Directory');           }
  34. {        m_menu^.add_option('/Change Dir/OS shell/Quit');                    }
  35. {                                                                            }
  36. {        ch := m_menu^.menuselect(TRUE);                                     }
  37. {        DISPOSE(m_menu,done);                                               }
  38. {                                                                            }
  39. {     Thats the basics... There are a bunch of things that you can do to     }
  40. {     make life easier on you... Just check out the demo                     }
  41. {                                                                            }
  42. { -------------------------------------------------------------------------- }
  43.  
  44. {$V-}
  45.  
  46. Unit Menu;
  47.  
  48. Interface
  49.  
  50. Uses Dos, Crt, Windows;
  51.  
  52.  
  53. TYPE  colorset = ARRAY[1..6] OF BYTE;
  54.       barset   = ARRAY[1..9] OF BYTE;
  55.       c_set    = SET OF CHAR;
  56.  
  57. CONST max_items = 20;
  58.  
  59.   {-------------------------------------------------------------------}
  60.   { The following defaults are set for the standard menu and for the  }
  61.   { drop down menu system... These can be changed by the user program }
  62.   { just by specifying new values!                                    }
  63.  
  64.       def_color_set : colorset = ($0B,$0A,$0C,$6F,$78,$0B);
  65.       def_bar_set   : barset   = ($07,$1F,$1B,$70,$07,$00,$1F,$1B,$70);
  66.       toggle_char   : CHAR     = '/';
  67.  
  68.   {- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -}
  69.  
  70.       cskip     = ^@;
  71.       chome     = ^A;
  72.       cright    = ^D;
  73.       cprev     = ^E;
  74.       cend      = ^F;
  75.       cdel      = ^G;
  76.       cback     = ^H;
  77.       csave     = ^J;
  78.       center    = ^M;
  79.       cundo     = ^R;
  80.       cleft     = ^S;
  81.       cins      = ^V;
  82.       cnext     = ^X;
  83.       cesc      = ^[;
  84.  
  85. TYPE  itemptr   = ^menuitem;
  86.       menuitem  = OBJECT(node)
  87.                      keyrtn : CHAR;
  88.                      active : BOOLEAN;
  89.                      option : ^STRING;
  90.                   END;
  91.  
  92.       menuptr   = ^menuobj;
  93.       menuobj   = OBJECT(nodelist)
  94.                      xpos     : BYTE;
  95.                      ypos     : BYTE;
  96.                      width    : BYTE;
  97.                      barposn  : itemptr;
  98.                      clrset   : colorset;
  99.                      visible  : BOOLEAN;
  100.                      titleptr : ^STRING;
  101. {                    menulist : nodelist;}
  102.                      termchar : c_set;
  103.                      CONSTRUCTOR initmenu(x,y : BYTE; title : line);
  104.                      DESTRUCTOR done; VIRTUAL;
  105.                      PROCEDURE add_option(option : STRING);
  106.                      PROCEDURE changecolorset(clrs : colorset);
  107.                      PROCEDURE changetermchar(s_ch : c_set);
  108.                      PROCEDURE changeposn(x,y : BYTE);
  109.                      PROCEDURE option_flag(option : bstr; o_active : BOOLEAN); VIRTUAL;
  110.                      FUNCTION  menuselect(clearmenu : BOOLEAN) : CHAR; VIRTUAL;
  111.                      PROCEDURE closemenu;
  112.                   END;
  113.  
  114.       barmenuptr= ^barmenu;
  115.       barmenu   = OBJECT(node)
  116.                      xpos   : BYTE;
  117.                      keyrtn : CHAR;
  118.                      header : ^STRING;
  119.                      menu   : ^menuobj;
  120.                   END;
  121.  
  122.       barptr    = ^barobj;
  123.       barobj    = OBJECT(nodelist)
  124.                      ypos     : BYTE;
  125.                      barposn  : barmenuptr;
  126.                      bclrset  : barset;
  127.                      menus    : BOOLEAN;
  128.                      visible  : BOOLEAN;
  129.                      clrset   : barset;
  130.                      CONSTRUCTOR initbar(y : BYTE; topline : line);
  131.                      DESTRUCTOR done; VIRTUAL;
  132.                      PROCEDURE display_bar; VIRTUAL;
  133.                      PROCEDURE add_option(option : STRING);
  134.                      PROCEDURE option_flag(option : bstr; o_active : BOOLEAN); VIRTUAL;
  135.                      FUNCTION  barselect : WORD; VIRTUAL;
  136.                   END;
  137.  
  138. FUNCTION  readchar : CHAR;
  139.  
  140. VAR   extendkey : BOOLEAN;
  141.  
  142. Implementation
  143.  
  144. VAR   reg : REGISTERS;
  145.  
  146. { -------------------------------------------------------------------------- }
  147.  
  148. FUNCTION readchar : CHAR;
  149. VAR   ch : CHAR;
  150. BEGIN
  151.    extendkey := FALSE;
  152.    ch := READKEY;
  153.    IF ch = #0 THEN
  154.       BEGIN
  155.          extendkey := TRUE;
  156.          CASE READKEY OF
  157.             #15, #72 : ch := cprev;         { Shift-Tab, Up }
  158.             #68      : ch := csave;         { F10 }
  159.             #71      : ch := chome;         { Home }
  160.             #75      : ch := cleft;         { Left }
  161.             #77      : ch := cright;        { Right }
  162.             #79      : ch := cend;          { End }
  163.             #80      : ch := cnext;         { Down }
  164.             #82      : ch := cins;          { Ins }
  165.             #83      : ch := cdel;          { Del }
  166.             ELSE       ch := #0
  167.          END
  168.       END
  169.    ELSE
  170.       IF ch = #9 THEN                 { Tab }
  171.          ch := cnext;
  172.    readchar := ch
  173. END;
  174.  
  175. { -------------------------------------------------------------------------- }
  176.  
  177. PROCEDURE display_menu(VAR mnu : menuobj);
  178. VAR   p : itemptr;
  179.       i : BYTE;
  180. BEGIN
  181.    hidecursor;
  182.    p := itemptr(mnu.first);
  183.    i := 0;
  184.    WHILE p <> NIL DO BEGIN
  185.       INC(i);
  186.       p := itemptr(mnu.next(p))
  187.    END;
  188.    IF NOT mnu.visible THEN
  189.       WITH mnu DO
  190.          openwindow(xpos,ypos,xpos + width + 3,ypos + i + 1,clrset[2],TRUE,
  191.                     std_border,clrset[1],titleptr^,clrset[6]);
  192.    mnu.visible := TRUE;
  193.  
  194.    p := itemptr(mnu.first);
  195.    i := 0;
  196.    WHILE p <> NIL DO BEGIN
  197.       INC(i);
  198.       IF NOT p^.active THEN
  199.          setfieldatrstr(1,i,mnu.width + 2,mnu.clrset[5],' ' + p^.option^)
  200.       ELSE
  201.          IF p = mnu.barposn THEN
  202.             setfieldatrstr(1,i,mnu.width + 2,mnu.clrset[4],' ' + p^.option^)
  203.          ELSE
  204.             WITH mnu DO BEGIN
  205.                setfieldatrstr(1,i,mnu.width + 2,clrset[2], ' ' + p^.option^);
  206.                writech(xpos + 2,ypos + i,p^.option^[1],clrset[3])
  207.             END;
  208.       p := itemptr(mnu.next(p))
  209.    END
  210. END;
  211.  
  212. { -------------------------------------------------------------------------- }
  213.  
  214. FUNCTION nextitem(VAR option : STRING) : line;
  215. VAR   tstr : line;
  216. BEGIN
  217.    IF POS(toggle_char,option) > 0 THEN
  218.       BEGIN
  219.          tstr := COPY(option,POS(toggle_char,option) + 1,255);
  220.          IF POS(toggle_char,tstr) > 0 THEN
  221.             option := COPY(tstr,POS(toggle_char,tstr),255)
  222.          ELSE
  223.             option := '';
  224.          tstr := tstr + toggle_char;
  225.          tstr := COPY(tstr,1,POS(toggle_char,tstr + toggle_char) - 1)
  226.       END
  227.    ELSE
  228.       BEGIN
  229.          tstr := option;
  230.          option := ''
  231.       END;
  232.    nextitem := tstr
  233. END;
  234.  
  235. { -------------------------------------------------------------------------- }
  236.  
  237. CONSTRUCTOR menuobj.initmenu;
  238. BEGIN
  239.    xpos := x;
  240.    ypos := y;
  241.    width := LENGTH(title);
  242.    barposn := NIL;
  243.    visible := FALSE;
  244.    clrset := def_color_set;
  245.    GETMEM(titleptr,LENGTH(title) + 1);
  246.    titleptr^ := title;
  247.    initlist;
  248.    termchar := [center,cesc];
  249. END;
  250.  
  251. { -------------------------------------------------------------------------- }
  252.  
  253. DESTRUCTOR menuobj.done;
  254. VAR   p : itemptr;
  255. BEGIN
  256.    p := itemptr(first);
  257.    WHILE p <> NIL DO BEGIN
  258.       FREEMEM(p^.option,LENGTH(p^.option^) + 1);
  259.       DISPOSE(p);
  260.       p := itemptr(next(p))
  261.    END;
  262.    FREEMEM(titleptr,LENGTH(titleptr^) + 1);
  263.    IF visible THEN
  264.       closewindow
  265. END;
  266.  
  267. { -------------------------------------------------------------------------- }
  268.  
  269. PROCEDURE menuobj.add_option;
  270. VAR   tstr : STRING;
  271.       p    : itemptr;
  272.       i    : BYTE;
  273. BEGIN
  274.    p := itemptr(first);
  275.    i := 0;
  276.    WHILE p <> NIL DO BEGIN
  277.       INC(i);
  278.       p := itemptr(next(p))
  279.    END;
  280.  
  281.    WHILE (i < max_items) AND (POS(toggle_char,option) > 0) DO BEGIN
  282.       INC(i);
  283.       tstr := nextitem(option);
  284.       NEW(p);
  285.       inserttail(p);
  286.       p^.keyrtn := tstr[1];
  287.       p^.active := TRUE;
  288.       IF tstr[2] = '|' THEN
  289.          DELETE(tstr,1,2);
  290.       GETMEM(p^.option,LENGTH(tstr) + 1);
  291.       p^.option^ := tstr;
  292.       IF LENGTH(tstr) > width THEN
  293.          width := LENGTH(tstr);
  294.       IF barposn = NIL THEN
  295.          barposn := p
  296.    END
  297. END;
  298.  
  299. { -------------------------------------------------------------------------- }
  300.  
  301. PROCEDURE menuobj.changecolorset;
  302. BEGIN
  303.    clrset := clrs;
  304.    IF visible THEN
  305.       BEGIN
  306.          closewindow;
  307.          display_menu(self)
  308.       END
  309. END;
  310.  
  311. { -------------------------------------------------------------------------- }
  312.  
  313. PROCEDURE menuobj.option_flag;
  314. VAR   p : itemptr;
  315.       i : BYTE;
  316. BEGIN
  317.    IF (LENGTH(option) > 0) AND NOT empty THEN
  318.       FOR i := 1 TO LENGTH(option) DO BEGIN
  319.          p := itemptr(first);
  320.          WHILE p <> NIL DO BEGIN
  321.             IF option[i] = p^.keyrtn THEN
  322.                p^.active := o_active;
  323.             p := itemptr(next(p))
  324.          END
  325.       END
  326. END;
  327.  
  328. { -------------------------------------------------------------------------- }
  329.  
  330. PROCEDURE menuobj.changetermchar;
  331. BEGIN
  332.    termchar := s_ch
  333. END;
  334.  
  335. { -------------------------------------------------------------------------- }
  336.  
  337. PROCEDURE menuobj.changeposn;
  338. BEGIN
  339.    xpos := x;
  340.    ypos := y
  341. END;
  342.  
  343. { -------------------------------------------------------------------------- }
  344.  
  345. FUNCTION menuobj.menuselect;
  346. VAR   i      : BYTE;
  347.       p      : itemptr;
  348.       ch     : CHAR;
  349.       hotstr : STRING[max_items];
  350. BEGIN
  351.    menuselect := #255;
  352.    p := barposn;
  353.    WHILE NOT barposn^.active DO BEGIN               {Insure there is a active}
  354.       barposn := itemptr(next_wrap(barposn));       {option in the menu!     }
  355.       IF barposn = p THEN                           {Return #$FF if any error}
  356.          EXIT
  357.    END;
  358.  
  359.    hotstr := '';
  360.    p := itemptr(first);                             {Create a list of hotkeys}
  361.    WHILE p <> NIL DO BEGIN
  362.       IF p^.active THEN
  363.          hotstr := hotstr + UPCASE(p^.option^[1]);
  364.       p := itemptr(next(p))
  365.    END;
  366. (*
  367.    IF menuitem + ypos + HI(windmin) + 2 > 25 THEN   {Make sure the menu isn't}
  368.       EXIT;                                         {bigger than the screen! }
  369.    menuselect := #0;
  370. *)
  371.    display_menu(self);
  372.    REPEAT
  373.       p := itemptr(first);
  374.       i := 0;
  375.       WHILE p <> NIL DO BEGIN
  376.          INC(i);
  377.          IF p^.active THEN
  378.             IF p = barposn THEN
  379.                setfieldatrstr(1,i,width + 2,clrset[4],' ' + p^.option^)
  380.             ELSE
  381.                BEGIN
  382.                   setfieldatrstr(1,i,width + 2,clrset[2], ' ' + p^.option^);
  383.                   writech(xpos + 2,ypos + i,p^.option^[1],clrset[3])
  384.                END;
  385.          p := itemptr(next(p))
  386.       END;
  387.       ch := UPCASE(readchar);
  388.       CASE ch OF
  389.          cnext : REPEAT
  390.                     barposn := itemptr(next_wrap(barposn))
  391.                  UNTIL barposn^.active;
  392.          cprev : REPEAT
  393.                     barposn := itemptr(prev_wrap(barposn))
  394.                  UNTIL barposn^.active;
  395.          chome : BEGIN
  396.                     barposn := itemptr(first);
  397.                     WHILE NOT barposn^.active DO
  398.                        barposn := itemptr(next(barposn))
  399.                  END;
  400.          cend  : BEGIN
  401.                     barposn := itemptr(tail);
  402.                     WHILE NOT barposn^.active DO
  403.                        barposn := itemptr(prev(barposn))
  404.                  END
  405.       END;
  406.       i := POS(ch,hotstr);
  407.    UNTIL (ch IN termchar) OR (i > 0);
  408.    IF i > 0 THEN
  409.       REPEAT
  410.          barposn := itemptr(next_wrap(barposn))
  411.       UNTIL UPCASE(barposn^.option^[1]) = ch;
  412.    display_menu(self);
  413.    IF ch = cesc THEN
  414.       menuselect := #0
  415.    ELSE
  416.       IF (ch = center) OR (i > 0) THEN
  417.          menuselect := barposn^.keyrtn
  418.       ELSE
  419.          menuselect := ch;
  420.    IF clearmenu THEN
  421.       BEGIN
  422.          visible := FALSE;
  423.          closewindow
  424.       END
  425. END;
  426.  
  427. { -------------------------------------------------------------------------- }
  428.  
  429. PROCEDURE menuobj.closemenu;
  430. BEGIN
  431.    IF visible THEN
  432.       closewindow;
  433.    visible := FALSE
  434. END;
  435.  
  436. { -------------------------------------------------------------------------- }
  437.  
  438. PROCEDURE barobj.display_bar;
  439. VAR   p : barmenuptr;
  440.       i : BYTE;
  441. BEGIN
  442.    IF visible THEN
  443.       setfieldatrstr(barposn^.xpos - 1,ypos,LENGTH(barposn^.header^) + 2,
  444.                      bclrset[9],' ' + barposn^.header^ + ' ')
  445.    ELSE
  446.       BEGIN
  447.          visible := TRUE;
  448.          FOR i := LO(windmin) TO LO(windmax) DO
  449.             writech(i + 1,HI(windmin) + 1,' ',bclrset[7]);
  450.          p := barmenuptr(first);
  451.          WHILE p <> NIL DO BEGIN
  452.             setfieldatrstr(p^.xpos,ypos,LENGTH(p^.header^),bclrset[7],p^.header^);
  453.             writech(p^.xpos + LO(windmin),ypos + HI(windmin),p^.header^[1],bclrset[8]);
  454.             p := barmenuptr(next(p))
  455.          END;
  456.          display_bar
  457.       END
  458. END;
  459.  
  460. { -------------------------------------------------------------------------- }
  461.  
  462. CONSTRUCTOR barobj.initbar;
  463. VAR   p    : barmenuptr;
  464.       tstr : line;
  465.       posn : BYTE;
  466. BEGIN
  467.    ypos := y;
  468.    posn := 4;
  469.    barposn := NIL;
  470.    bclrset := def_bar_set;
  471.    visible := FALSE;
  472.    menus := FALSE;
  473.    initlist;
  474.    WHILE LENGTH(topline) > 0 DO BEGIN
  475.       tstr := nextitem(topline);
  476.       NEW(p);
  477.       inserttail(p);
  478.       IF (tstr[2] = '|') AND (LENGTH(tstr) > 2) THEN
  479.          BEGIN
  480.             p^.keyrtn := tstr[1];
  481.             DELETE(tstr,1,2)
  482.          END
  483.       ELSE
  484.          p^.keyrtn := UPCASE(tstr[1]);
  485.       GETMEM(p^.header,LENGTH(tstr) + 1);
  486.       p^.header^ := tstr;
  487.       p^.menu := NIL;
  488.       p^.xpos := posn;
  489.       INC(posn,4 + LENGTH(tstr));
  490.       IF barposn = NIL THEN
  491.          barposn := p
  492.    END
  493. END;
  494.  
  495. { -------------------------------------------------------------------------- }
  496.  
  497. DESTRUCTOR barobj.done;
  498. VAR   p : barmenuptr;
  499. BEGIN
  500.    p := barmenuptr(first);
  501.    WHILE p <> NIL DO BEGIN
  502.       IF p^.menu <> NIL THEN
  503.          DISPOSE(p^.menu,done);
  504.       FREEMEM(p^.header,LENGTH(p^.header^) + 1);
  505.       DISPOSE(p);
  506.       p := barmenuptr(next(p))
  507.    END;
  508.    IF visible THEN
  509.       closewindow
  510. END;
  511.  
  512. { -------------------------------------------------------------------------- }
  513.  
  514. PROCEDURE barobj.add_option;
  515. VAR   s,p  : barmenuptr;
  516.       fchr : line;
  517.       clrs : colorset;
  518. BEGIN
  519.    IF LENGTH(option) < 4 THEN
  520.       EXIT;
  521.    fchr := nextitem(option);
  522.    p := barmenuptr(first);
  523.    s := barmenuptr(prev_wrap(p));
  524.    WHILE (p^.keyrtn <> fchr[1]) AND (s <> p) DO
  525.       p := barmenuptr(next_wrap(p));
  526.    IF p^.keyrtn <> fchr[1] THEN
  527.       EXIT;
  528.    IF p^.menu = NIL THEN
  529.       BEGIN
  530.          MOVE(bclrset,clrs,SIZEOF(clrs));
  531.          NEW(p^.menu,initmenu(p^.xpos - 2 + LO(windmin),ypos + 1 + HI(windmin),''));
  532.          p^.menu^.changetermchar([center,cesc,cleft,cright]);
  533.          p^.menu^.changecolorset(clrs);
  534.       END;
  535.    p^.menu^.add_option(option)
  536. END;
  537.  
  538. { -------------------------------------------------------------------------- }
  539.  
  540. PROCEDURE barobj.option_flag;
  541. VAR   fstr : bstr;
  542.       p    : barmenuptr;
  543. BEGIN
  544.    fstr := nextitem(option);
  545.    IF (LENGTH(fstr) = 1) AND (LENGTH(option) > 1) THEN
  546.       BEGIN
  547.          DELETE(option,1,1);
  548.          p := barmenuptr(first);
  549.          WHILE (p <> NIL) AND (p^.keyrtn <> fstr[1]) DO
  550.             p := barmenuptr(next(p));
  551.          IF p^.keyrtn = fstr[1] THEN
  552.             p^.menu^.option_flag(option,o_active)
  553.       END
  554. END;
  555.  
  556. { -------------------------------------------------------------------------- }
  557.  
  558. FUNCTION barobj.barselect;
  559. LABEL proc_done;
  560. VAR   p      : barmenuptr;
  561.       ch     : CHAR;
  562.       chsub  : CHAR;
  563.       hotkey : bstr;
  564. BEGIN
  565.    hidecursor;
  566.    p := barmenuptr(first);
  567.    hotkey := '';
  568.    barselect := $FFFF;
  569.    WHILE p <> NIL DO BEGIN
  570.       hotkey := hotkey + UPCASE(p^.header^[1]);
  571.       p^.menu^.changeposn(p^.xpos - 2 + LO(windmin),ypos + 1 + HI(windmin));
  572.       p := barmenuptr(next(p))
  573.    END;
  574.    IF LENGTH(hotkey) = 0 THEN
  575.       EXIT;
  576.    barselect := $0000;
  577.    display_bar;
  578.    REPEAT
  579.       ch := #0;
  580.       chsub := #0;
  581.       IF menus AND (barposn^.menu <> NIL) THEN
  582.          BEGIN
  583.             chsub := barposn^.menu^.menuselect(TRUE);
  584.             CASE chsub OF
  585.                cleft,
  586.                cright : ch := chsub;
  587.                #0     : ch := cesc;
  588.                #$FF   : {?-?-?-?-?-?-?};
  589.                ELSE     ch := center
  590.             END
  591.          END
  592.       ELSE
  593.          BEGIN
  594.             ch := UPCASE(readchar);
  595.             IF POS(ch,hotkey) > 0 THEN
  596.                BEGIN
  597.                   REPEAT
  598.                      barposn := barmenuptr(next_wrap(barposn))
  599.                   UNTIL barposn^.header^[1] = ch;
  600.                   ch := center
  601.                END
  602.             ELSE
  603.                IF NOT (ch IN [center,cleft,cright,cnext,cesc]) THEN
  604.                   ch := #0
  605.          END;
  606.       IF (ch IN [cleft,cright]) OR
  607.          ((ch = center) AND (menus OR (barposn^.menu = NIL))) THEN
  608.          BEGIN
  609.             setfieldatrstr(barposn^.xpos - 1,ypos,LENGTH(barposn^.header^) + 2,
  610.                            bclrset[7],' ' + barposn^.header^ + ' ');
  611.             writech(barposn^.xpos + LO(windmin),ypos + HI(windmin),barposn^.header^[1],bclrset[8])
  612.          END;
  613.       CASE ch OF
  614.          cleft  : barposn := barmenuptr(prev_wrap(barposn));
  615.          cright : barposn := barmenuptr(next_wrap(barposn));
  616.          cnext  : IF barposn^.menu <> NIL THEN
  617.                      menus := TRUE;
  618.          center : IF NOT menus AND (barposn^.menu <> NIL) THEN
  619.                      BEGIN
  620.                         menus := TRUE;
  621.                         ch := #0
  622.                      END;
  623.          cesc   : ;
  624.       END;
  625.       IF (ch <> center) AND (ch <> cesc) THEN
  626.          display_bar
  627.    UNTIL (ch IN [center,cesc]);
  628.  
  629.    IF ch <> cesc THEN
  630.       barselect := ORD(barposn^.keyrtn) * 256 + ORD(chsub);
  631.    menus := FALSE;
  632.    visible := FALSE
  633. END;
  634.  
  635. { -------------------------------------------------------------------------- }
  636.  
  637. END.