Programmer 7500/MAX_PROGRAMMERS.iso/PASCAL/MADTRB15.ZIP/MENUMOD.INC

Text File | 1986-01-21 | 11.8 KB | 374 lines

{MenuMod.inc:  A module to insert into your programs to supply highlighted
               menu selections.  The function "Menu" which begins on line
               162 of this listing is the main routine calling the others in
               the listing.  Before calling "Menu" you must initialize the
               array "Menu_Selections" to be the prompts you wish to use.
               "Menu" will return an integer corresponding to the subscript
               of the prompt which was chosen.  The last item in the array
               must be the null string.
               }
Type
  Menu_Item       = String[76];
  Menu_Selections = Array[1..15] of Menu_Item;
  Long_String     = String[255];


Function Upper_Left_X : Integer;       {* These four routines allow a       *}
                                       {* routine to adjust its output      *}
Begin                                  {* according to what size window it  *}
  Upper_Left_X := Mem[Dseg:$156] + 1;  {* is operating in.  They are        *}
End;                                   {* compatible only with Turbo Pascal *}
                                       {* version 2.0 on an IBM PC or       *}
Function Upper_Left_Y : Integer;       {* compatible                        *}
Begin
  Upper_Left_Y := Mem[Dseg:$157] + 1;
End;

Var
  Lower_Right_X : Byte Absolute Cseg:$16A;
  Lower_Right_Y : Byte Absolute Cseg:$16B;


Procedure RvsOn;                       {*  These two routines turn on and
                                           off Reverse video on the IBM PC  *}
Begin
  TextColor(0);
  TextBackGround(7);
End;


Procedure RvsOff;
Begin
  LowVideo;
End;


Procedure Inc(                     {* Increment argument by One             *}
          Var I : Integer);
Begin
  I := I + 1;
End;


Function Lower (S : Long_String)    {* Convert string S to lowercase        *}
               : Long_String;       {* Return lowercase string              *}
Var
  I : Integer;
  ucase : Set of Char;

Begin
  ucase := ['A'..'Z'];
  For I := 1 to Length(S) do
    If S[I] in ucase then S[I] := Char(Ord(S[I]) + 32);
  lower := S;
End;


Procedure Click;                       { Makes a clicking noise }
var f,n : integer;

Begin
  Sound(2000);
  Delay(10);
  NoSound;
End;


Function Replicate (                          {* Repeat a character         *}
                     Count : Integer;         {* Number of Repititions      *}
                     Ascii : Char             {* Character to be repeated   *}
                    )      : Long_String;     {* String containing repeated *}
                                              {* character                  *
 * This function takes the character in 'Ascii', repeats it 'Count' times   *
 * and returns the resulting string as a 'Long_String'                      *}

Var
  Temp : Long_String;  {Used to hold the incomplete result}
  I    : Byte;         {For Counter}

Begin
  Temp := '';
  For I := 1 to Count do
    Temp := Temp + Ascii;
  Replicate := Temp;
End; {Replicate}



Function Center (                              {* Centers a string in field *}
                  Field_Width   : Byte;        {* Width of field for center *}
                  Center_String : Long_String  {* String to Center          *}
                )               : Long_String; {* Return the string         *}
{************************************************                           *
 * This functions takes the string 'Center_String' and centers it in a      *
 * field 'Field_Width' Spaces long.  It returns a 'Long_String' with a      *
 * length equal to 'Field_Width'.  If the 'Center_String' is longer than    *
 * field width, it is truncated on the right end and is not centered.       *}

Var
  Temp   : Long_String;
  Middle : Byte;

Begin
  Middle := Field_Width div 2;
  If Length(Center_String) > Field_Width then
    Center := Copy(Center_String,1,Field_Width) {Truncate and return}
  Else
    Begin
    Temp := Replicate(Middle - (Length(Center_String) div 2),' ') +
            Center_String +
            Replicate(Middle - (Length(Center_String) div 2) + 1,' ');
    Center := Copy(Temp, 1, Field_Width)  {Truncate to Field_Width Characters}
    End {Else}
 End; {Center}



procedure Frame(                      {* Frame the section of screen within *}
                UpperLeftX,           {* these bounds                       *}
                UpperLeftY,
                LowerRightX,
                LowerRightY: Integer);
  var
    i: Integer;

begin
  GotoXY(UpperLeftX,UpperLeftY);
  Write(Chr(218));
  GotoXY(UpperLeftX,LowerRightY);
  Write(Chr(192));
  GotoXY(LowerRightX,UpperLeftY);
  Write(Chr(191));
  GotoXY(LowerRightX,LowerRightY);
  Write(Chr(217));
  For I := UpperLeftX + 1 to LowerRightX - 1 do
    Begin
    GotoXY(I,UpperLeftY);
    Write(Chr(196));
    GotoXY(I,LowerRightY);
    Write(Chr(196));
    End;
  For I := UpperLeftY + 1 to LowerRightY - 1 do
    Begin
    GotoXY(UpperLeftX,I);
    Write(Chr(179));
    GotoXY(LowerRightX,I);
    Write(Chr(179));
    End;
end;  { Frame }


{****************************************************************************}
Function Menu (                               {* Display a Menu             *}
                Item_List  : Menu_Selections; {* List of Options on Menu    *}
                                              {* Last Item must be Null     *}
                                              {* String for proper operation*}
                                              {* No more than 14 items per  *}
                Menu_X     : Integer;         {* X Location of Menu         *}
                                              {* If Menu_X = 0 then the     *}
                                              {* Menu is centered on the    *}
                                              {* Screen                     *}
                Menu_Y     : Integer;         {* Y Location of Menu         *}
                Menu_Title : Menu_Item;       {* Title of Menu              *}
                Title_X    : Integer;         {* X Location of Title        *}
                                              {* If Title_X = 0 then the    *}
                                              {* Title is centered on the   *}
                                              {* screen                     *}
                Title_Y    : Integer;         {* Y Location of Title        *}
                Default    : Integer          {* Default Selection          *}
              )            : Integer;         {* Return the index of the    *}
                                              {* item selected by the user  *}
                                              {*                            *}
{***********************************************                            *
* This Routine Displays a Menu on the screen at the location specified by   *
* Menu_X and Menu_Y.  The Menu Title is displayed in Reverse Video at the   *
* Location specified by Title_X and Title_Y.  The User selects an item from *
* the menu by using <CTRL>-E to move a reverse video cursor bar up and      *
* <CTRL>-X to move it down.  After the cursor is on the item desired by the *
* user, he must press return.  At this point the routine returns the item   *
* number of the selection.                                                  *
*****************************************************************************}

Const
  CR = #13;
  Up = #5;
  Dn = #24;

Var
  Inchar         : char;
  Menu_Pointer   : 1..15;
  Menu_Length    : 1..15;
  Last           : Integer;
  Width          : Integer;
  Len            : Integer;
  X1,X2,Y1,Y2    : Integer;
  I,j,k          : integer;
  instr          : long_string;

Begin {Menu}

  instr := '';

  Width := Lower_Right_X - Upper_Left_X + 1;   {Calculate Window Size}
  Len   := Lower_Right_Y - Upper_Left_Y + 1;

  If Title_X <> 0 then       {position for the title}
    GotoXY(Title_X,Title_Y)
  Else
    GotoXY(1,Title_Y);

  RvsOn;

  If Title_X = 0 Then                 {Write the title}
    Write(Center(Width,Menu_Title))
  Else
    Write(Menu_Title);

  RvsOff;

  If Width > 38 then        {If there is enough room, write out instructions}
    Begin                   {otherwise, they is out a luck}
    Frame(1,Len-3,Width-1,Len);
    GotoXY((Width div 2) - 6,Len-3);
    Write(#17);
    RvsOn;
    Write('Instructions');
    RvsOff;
    Write(#16);
    TextColor(15);
    GotoXY(2,Len-2);
    Write(Center(Width-3,'Use '+#24+' and '+#25+' to Highlight a Selection'));
    GotoXY(2,Len-1);
    Write(Center(Width-3,' And <CR> to make the Selection'));
    TextColor(7);
    End;

  Inchar := ' ';               {Initialize variables}
  Menu_Pointer := 1;

  {Display the actual menu selections and determine how many selections
   are available}

  While (Menu_pointer <=15) and (length(Item_list[Menu_pointer]) > 0) do

    Begin
    If Menu_X <> 0 then
      Begin
      GotoXY(Menu_X,Menu_Y - 1 + Menu_Pointer);
      Write(Item_List[Menu_Pointer])
      End {If}
    Else
      Begin
      GotoXY(1,Menu_Y - 1 + Menu_Pointer);
      Write(Center(Width-1,Item_List[Menu_Pointer]))
      End; {Else}
    Menu_Pointer := Menu_Pointer + 1;
    End;  {While}

  Menu_Length := Menu_Pointer - 1;
  Menu_Pointer := Default;

  While inchar <> CR do          {Main loop}

    Begin
    If Menu_X <> 0 then
      Begin
      GotoXY(Menu_X,Menu_Pointer - 1 + Menu_Y); {Highlight the current menu}
      RvsOn;                                    {item}
      Write(Item_List[Menu_Pointer]);
      RvsOff;
      End {If}
    Else
      Begin
      GotoXY(1,Menu_Pointer - 1 + Menu_Y);
      RvsOn;
      Write(Center(Width-1,Item_List[Menu_Pointer]));
      RvsOff;
      End; {Else}

    Read(Kbd,Inchar);    {get a character from the user}
    Click;

    Last := Menu_Pointer;

    If Not (Inchar in [^[,Up,Dn,Cr]) then

      Begin

      if inchar = #127 then
        instr := ''
      else

        if inchar = ^H then
          delete(instr,length(instr),1)
        else
          instr := instr + inchar;

      j := 0;
      k := 0;

      for i := 1 to Menu_Length do

        if lower(instr) = lower(copy(item_list[i],1,length(instr))) then

          begin
          inc(j);

          if k = 0 then
            k := i;

          end;

      if k <> 0 then
        menu_pointer := k;

      if (j = 1) or (j = 0) then
        instr := '';

      end;

    If (Inchar = ^[) and KeyPressed then   {get the escape code}
      Read(Kbd, Inchar);

    If Inchar = ';' Then
      Begin
      X1 := Upper_Left_X;
      Y1 := Upper_Left_Y;
      X2 := Lower_Right_X;
      Y2 := Lower_Right_Y;
      {Help;}
      Window(X1,Y1,X2,Y2);
      End;

    If (Inchar = Up) Or (Inchar = 'H') then
      Begin                                    {They hit up arrow}
      Menu_Pointer := Menu_Pointer - 1;
      If Menu_Pointer < 1 then
        Menu_Pointer := Menu_Length;
      instr := '';
      End;  {If}

    If (Inchar = Dn) Or (Inchar = 'P') then
      Begin                                    {They hit down arrow}
      Menu_Pointer := Menu_Pointer + 1;
      if Menu_Pointer > Menu_Length then
        Menu_Pointer := 1;
      instr := '';
      end;  {If}

    If Menu_X <> 0 then                        {UnHighlight the old selection}
      Begin
      GotoXY(Menu_X, Last - 1 + Menu_Y);
      Write(Item_List[Last]);
      End {If}
    Else
      Begin
      GotoXY(1, Last - 1 + Menu_Y);
      Write(Center(Width-1,Item_List[Last]));
      End; {Else}

    End; {While};                           {They made a selection, beep once}
  Menu := Menu_Pointer;                     {to confirm}

end; {Menu}