home *** CD-ROM | disk | FTP | other *** search
/ ftp.barnyard.co.uk / 2015.02.ftp.barnyard.co.uk.tar / ftp.barnyard.co.uk / cpm / walnut-creek-CDROM / CPM / MODEMS / MODEM / PC-PSUIT.LBR / MENU.PQS / MENU.PAS
Pascal/Delphi Source File  |  2000-06-30  |  4KB  |  97 lines
  1.  
  2. { Used by Menu procedure to highlight menu choice. }
  3.  
  4. Procedure Select(x,y : Integer; choice : Str80);
  5.   Begin
  6.     GotoXY(x,y); NormVideo; InVideo(1);
  7.     Write(choice);
  8.   End;
  9.  
  10. { Used by Menu procedure to un-highlight menu choice. }
  11.  
  12. Procedure DeSelect(x,y : Integer; choice : Str80);
  13.   Begin
  14.     GotoXY(x,y); InVideo(0); LowVideo;
  15.     Write(choice);
  16.   End;
  17.  
  18. { Pass this function a number equal to the number of menu choices you
  19.   want and an array of strings of 40 or less characters each.  It will
  20.   clear the screen and build the menu for you.  Each choice is highlighted
  21.   as you move down the menu with the space bar, up with the back-space.
  22.   Pressing the first letter of a menu choice moves you to the first choice
  23.   that starts with the same letter.  Uses the above four procedures to
  24.   put instructions in status line.
  25.  
  26.   example:     const maxlines = 5;
  27.                      lines: Array[0..maxlines] Of String[40] =
  28.                             (' General Business Menu', <-- menu title
  29.                          /   ' Accounts Payable',      <-- first choice
  30.                          |   ' Accounts Recievable ',  <-- second choice
  31.     (Note leading space)-|   ' Payroll',          ^    <-- third choice
  32.                          |   ' General Ledger',   |    <-- fourth choice
  33.                          \   ' Exit Program');    |    <-- fifth choice
  34.            var  Choice : Integer;                 |
  35.              begin                                +------- trailing space
  36.                Choice := menu(maxlines,lines);  <-- Choice will equal 1 -> 5
  37.              end. }
  38.  
  39. Function menu (number : Integer; Var data) : Integer;
  40.   Type   listtype  = Array[0..16] Of String[40];
  41.   Var    list      : listtype Absolute data;
  42.          total_len, ave_len, max_len, col, cur_choice, i : Byte;
  43.          chr       : Char;
  44.          Top       : integer;
  45.   Begin
  46.     total_len := 0; max_len := 0;
  47.     For i := 1 To number Do
  48.     Begin
  49.       If Length(list[i]) > max_len then max_len := Length(list[i])
  50.     End;
  51.     col := (80 - max_len + 2) Div 2;
  52.     For i := 1 To number Do
  53.     Begin
  54.       list[i] := list[i] + copy(Spaces,1,max_len - Length(list[i]));
  55.     End;
  56.     Top := (21 - number) div 2;
  57.     ClrScr; Draw_Status_Border;
  58.     Write_Status('(Space) = Down, (Back-Space) = Up, (First Letter) to Find, (Return) to Select');
  59.     GotoXY(((80 - Length(list[0])) Div 2),Top); Write(list[0]); LowVideo;
  60.     For i := 1 To number Do
  61.     Begin
  62.       GotoXY(col,i + Top + 1); Write(list[i]);
  63.     End;
  64.     GotoXY(col,Top + 2); NormVideo; InVideo(1);
  65.     cur_choice := 1; Write(list[1]);
  66.     repeat
  67.       Read(Kbd,Chr);
  68.       Case Chr Of
  69.         #08 : Begin
  70.                 DeSelect(col, Top + 1 + cur_choice, list[cur_choice]);
  71.                 cur_choice := cur_Choice - 1;
  72.                 If cur_choice = 0 Then cur_choice := number;
  73.                 Select(col, Top + 1 + cur_choice, list[cur_choice]);
  74.               End;
  75.         #32 : Begin
  76.                 DeSelect(col, Top + 1 + cur_choice, list[cur_choice]);
  77.                 cur_choice := cur_choice + 1;
  78.                 If cur_choice > number Then cur_choice := 1;
  79.                 Select(col, Top + 1 + cur_choice, list[cur_choice]);
  80.               End;
  81.         #13 : menu := cur_choice;
  82.         Else  Begin
  83.                  DeSelect(col, Top + 1 + cur_choice, list[cur_choice]);
  84.                  i := cur_choice;
  85.                  chr := UpCase(chr);
  86.                  Repeat
  87.                    i := succ(i);
  88.                    If i > number Then i := 1
  89.                  Until (i = cur_choice) Or (chr = UpCase(Copy(list[i],2,1)));
  90.                  cur_choice:=i;
  91.                  Select(col, Top + 1 + cur_choice, list[cur_choice]);
  92.                End;
  93.       End;
  94.     until Chr = #13;
  95.     InVideo(0); Cursor_on;
  96.   End;
  97.