home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / TURBOPAS / EBMENU.ZIP / EBMENU.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1985-05-28  |  11.9 KB  |  265 lines
  1. { ******************* Start of EBMenu Function *************************}
  2.  
  3. {EBMenu function: this function will do a menu in the form common to many
  4.                   of the better spreadsheet packages where a line in displayed
  5.                   and the user is allowed to select an item from that line
  6.                   by either using the left and right arrow keys followed by
  7.                   pressing the <Enter> key or may alternately press any
  8.                   character that matches the first letter of one of the words
  9.                   in the menu line (case does not matter). The function
  10.                   returns a byte argument that corresponds to the number
  11.                   of the field selected. There may be from 1 to 10 fields.
  12.  
  13.                   Special features to make it even easier for your users
  14.                   are that the space-bar and tab act just like the
  15.                   right arrow. The backspace and reverse-tab act just
  16.                   like the left arrow. Home, Up and PgUp jump to
  17.                   beginning of the list and End, Down and PgDn jump to the
  18.                   end of the list.
  19.  
  20.                   You may set options that either end the menu if the user
  21.                   presses the Escape key or, alternately, you may trap the
  22.                   Funtion keys (unshifted f1 thru f10 only).
  23.  
  24.                   If Escape is allowed, the pressing Escape returns a zero,
  25.                   if function keys are allowed, the number returned is from
  26.                   59 thry 68 for f1 thru f10 respectively.
  27.  
  28.                   To test this program, compile and run the EBMDEMO.PAS
  29.                   program that should have been distributed with this
  30.                   function.
  31.                                    }
  32. { Author: Ed Bachmann              5/28/85 version 1.00
  33.           9421 Mellenbrook Rd.
  34.           Columbia,Md. , 21045
  35.           Please send comments and suggestions to me on one
  36.           of the following remote bulletin board systems:
  37.             Elkridge-All-Purpose    (301) 796-1223
  38.             Capital PC Stat SIG     (301) 596-3569
  39.             Forbin Project          (319) 266-8086
  40.                                                                           }
  41.  
  42. { My Apoligies, but the arguments for the functions get kind of complicated:
  43.     Code     = Byte   : Special code that defines and allows for special
  44.                         keys to terminate the menu.
  45.                         1 = End if user selects a field and also
  46.                             if user presses the <ESCape> key.
  47.                         2 = End only when user selects a field. Does not
  48.                             recognize Escape key or function keys.
  49.                         3 = End if user selects a field and also end if the
  50.                             user presses the Escape key or any of the 10
  51.                             function keys.
  52.                         4 = Like 3 above but Escape is not recognized.
  53.                         Note: if an invalid number is passed, the default is 1.
  54.     Line1    = Byte   : The screen line # (1-25) that the menu will use to
  55.                         display the 1st line (menu line) on.
  56.     Line2    = Byte   : The screen line # (0-25) that the explanation line
  57.                         will be displayed on. If 0, then no 2nd line used.
  58.     Forgrnd  = byte   : the forground color (0-15)
  59.     Bkgrnd   = byte   : the background color (0-7)
  60.                         Note: if Forground and background are the same (or
  61.                         obvious illegal combos) the NormVideo and LowVideo
  62.                         commands will be used instead of the TextColor and
  63.                         TextBackground commands.
  64.     Start    = byte   : the number of the menu item you want highlighted when
  65.                         the menu is first brought up.
  66.     ItemCtr  = byte   : the number of menu items to use  (1-10). Max of ten.
  67.     Header   = String : Max length 78 : The non-menu portion of the 1st line.
  68.     TxtMenu  = String : Max length 78 : The menu portion of the 1st line,
  69.                         a menu item is a word with one or more spaces before
  70.                         or behind it. The ItemCtr (above) must be equal or
  71.                         less than the number of words in the string.
  72.                         The total length of Header and TxtMenu really ought
  73.                         to be less than or equal to 79.
  74.     ExpN : Explanation fields Exp1 thru Exp10
  75.              = String : Max length 79 characters :
  76.                         These fields hold the descriptions or whatever you
  77.                         want displayed when the menu word is high-lighted.
  78.                         All of these strings must be passed to the function,
  79.                         this is true even if you don't want to use this field.
  80.                         Just use 2 single quotes or something to define a null
  81.                         field. If Line2 (above) is 0 or if the MenuCtr is less
  82.                         than the ExpN position, this line will not be
  83.                         displayed.
  84. }
  85.  
  86. { usage:   ByteVar:=EBMenu(Code,Line1,Line2,Forgrnd,Backgrnd,
  87.                            Start,NumberItems,
  88.                            Header,TextMenu,
  89.                            Exp1,Exp2,Exp3,Exp4,Exp5,
  90.                            Exp6,Exp7,Exp8,Exp9,Exp10);
  91. }
  92.  
  93. { example: RetCode:=EBMenu(1,1,2,White,Black,
  94.                            RetCode,8,
  95.                            'Header: ','1st  2nd  3rd  4th  5th  6th  7th  8th',
  96.                            'Do the 1st thing','Do the 2nd thing',
  97.                            'Do the 3rd thing','Do the 4th thing',
  98.                            'Do the 5th thing','Do the 6th thing',
  99.                            'Do the 7th thing','Do the 8th thing',
  100.                            '','');
  101. }
  102.  
  103.  
  104. type
  105.   EBMstring80      = String[80];
  106.  
  107. function EBMenu(Code,Line1,Line2,Forgrnd,Bkgrnd,
  108.                 StartAt,MenuCtr:Byte;
  109.                 Header,TxtMenu,
  110.                 Exp1,Exp2,Exp3,Exp4,Exp5,
  111.                 Exp6,Exp7,Exp8,Exp9,Exp10:
  112.                 EBMstring80):byte;
  113.  
  114.   var
  115.     MI1,MI2,SIndx              : byte;
  116.     RevForgrnd,Revbkgrnd : byte;
  117.     Ch1,Ch2                    : char;
  118.     ExitMenu                   : boolean;
  119.     Choices                    : Array [1..10] of char;
  120.     ChoiceStart,ChoiceEnd      : array [1..10] of byte;
  121.  
  122. begin
  123.    if StartAt=0 then StartAt:=1;
  124.    if MenuCtr < 1  then MenuCtr:=1;  {validate counter}
  125.    if MenuCtr > 10 then MenuCtr:=10;
  126.    RevForgrnd:=(Bkgrnd + 8);         {make reverse video forgound bright}
  127.    Revbkgrnd:=(Forgrnd mod 8);       {set rev video background color}
  128.    if (Forgrnd=Bkgrnd) or (RevForgrnd=RevBkgrnd) then
  129.      NormVideo         {if colors are invalid then use normal video}
  130.    else
  131.      begin
  132.        TextColor(Forgrnd);
  133.        TextBackground(Bkgrnd);
  134.      end;
  135.    GotoXY(1,Line1);                  {clear the 2 lines to default colors}
  136.    Write(Header);
  137.    Write(TxtMenu);
  138.    ClrEol;
  139.    For MI1:=1 to 10 do                 {clear the choices table}
  140.    begin
  141.       Choices[MI1]:=' ';
  142.       ChoiceStart[MI1]:=0;
  143.       ChoiceEnd[MI1]:=0;
  144.    end;
  145.    MI1:=1;
  146.    MI2:=0;
  147.    while (MI2<MenuCtr) do         {save the choices in a table}
  148.    begin                             {by finding 1st character in each word}
  149.      while (MI1<ord(TxtMenu[0])) and (TxtMenu[MI1]=' ') do
  150.           MI1:=MI1+1;
  151.      if (MI1<ord(TxtMenu[0])) then
  152.        begin
  153.          Choices[MI2+1]:=UpCase(TxtMenu[MI1]);
  154.          ChoiceStart[MI2+1]:=MI1;
  155.          while (MI1<ord(TxtMenu[0])+1) and (TxtMenu[MI1]<>' ') do
  156.               MI1:=MI1+1;
  157.          ChoiceEnd[MI2+1]:=MI1-1;
  158.        end;
  159.      MI2:=MI2+1;
  160.    end;
  161.    MenuCtr:=MI2;
  162.    MI1:=StartAt;
  163.    ExitMenu:=False;
  164.    Ch1:=chr(221);     {set to pass thru on the 1st time for display}
  165.    while not ExitMenu do
  166.    begin
  167.      while Ch1=chr(222) do
  168.      begin
  169.        if keypressed then
  170.          begin
  171.            read(Kbd,Ch1);
  172.            Ch1:=UpCase(Ch1);
  173.            case ord(Ch1) of
  174.              08      : MI1:=MI1-1;         {backspace}
  175.              09,32   : MI1:=MI1+1;         {tab, space}
  176.              13      : ExitMenu:=True;     {enter key - select current value}
  177.              27      : if keypressed then
  178.                          begin
  179.                            read(Kbd,Ch2);
  180.                            Case ord(Ch2) of
  181.                              71,72,73 : MI1:=1;          {Home, Up, PgUp keys}
  182.                              75,15    : MI1:=MI1-1;      {left  arrow, rev-tab}
  183.                              77       : MI1:=MI1+1;      {right arrow}
  184.                              79,80,81 : MI1:=MenuCtr; {End, down, PgDn keys}
  185.                              59..68   : if (Code=3) or (Code=4) then
  186.                                           begin
  187.                                             MI1:=ord(ch2);
  188.                                             ExitMenu:=True;
  189.                                           end;
  190.                            end;  {end of case}
  191.                          end
  192.                        else       {if not keypressed - i.e. ESCape key}
  193.                          if (Code<>2) and (Code<>4) then
  194.                            begin
  195.                               MI1:=0;
  196.                               ExitMenu:=True;
  197.                            end;
  198.              33..125 : for MI2:=1 to MenuCtr do   {check to see if in table}
  199.                            if Ch1=Choices[MI2] then
  200.                              begin
  201.                                MI1:=MI2;             {if found then select & end}
  202.                                ExitMenu:=True;
  203.                              end;
  204.              end;   {end of case}
  205.          end;
  206.      end;
  207.      EBMenu:=MI1;
  208.      if (MI1<>0) or not ExitMenu then      {display the choices line & description}
  209.        begin
  210.          if (Forgrnd=Bkgrnd) or (RevForgrnd=RevBkgrnd) then
  211.            NormVideo         {if colors are invalid then use normal video}
  212.          else
  213.            begin
  214.              TextColor(Forgrnd);
  215.              TextBackground(Bkgrnd);
  216.            end;
  217.          GotoXY(1+ord(Header[0]),Line1);
  218.          Write(TxtMenu);
  219.          ClrEol;
  220.          if MI1<1          then MI1:=MenuCtr;
  221.          if MI1>MenuCtr then MI1:=1;
  222.          if Line2>0 then                {description is skipped if line = 0 }
  223.            begin
  224.              GotoXY(1,Line2);
  225.              case MI1 of
  226.                1  : Write(Exp1);
  227.                2  : Write(Exp2);
  228.                3  : Write(Exp3);
  229.                4  : Write(Exp4);
  230.                5  : Write(Exp5);
  231.                6  : Write(Exp6);
  232.                7  : Write(Exp7);
  233.                8  : Write(Exp8);
  234.                9  : Write(Exp9);
  235.                10 : Write(Exp10);
  236.              end;   {end of case}
  237.              ClrEol;
  238.            end;     {end of if}
  239.          if (Forgrnd=Bkgrnd) or (RevForgrnd=RevBkgrnd) then
  240.            LowVideo         {if colors are invalid then use low video}
  241.          else
  242.            begin
  243.              TextColor(RevForgrnd);      {reverse the colors for highlighting}
  244.              TextBackground(RevBkgrnd);
  245.            end;
  246.          if (ChoiceStart[MI1]>0) then    {display the currently selected word}
  247.            begin
  248.              GotoXY(ChoiceStart[MI1]+ord(Header[0]),Line1);
  249.              for MI2:=ChoiceStart[MI1] to ChoiceEnd[MI1] do Write(TxtMenu[MI2]);
  250.              GotoXY(ChoiceStart[MI1]+ord(Header[0]),Line1);
  251.            end;
  252.        end;        {end of if MI1<>0}
  253.      if (Forgrnd=Bkgrnd) or (RevForgrnd=RevBkgrnd) then
  254.        NormVideo         {if colors are invalid then use normal video}
  255.      else
  256.        begin
  257.          TextColor(Forgrnd);          {reset colors back to default colors}
  258.          TextBackground(Bkgrnd);
  259.        end;
  260.      Ch1:=chr(222);                      {reset character for keyboard loop}
  261.    end;  {end of while not exitmenu}
  262. end;
  263.  
  264. { ******************* End of EBMenu Function ***************************}
  265.