Programmer 7500/MAX_PROGRAMMERS.iso/INFO/TURBOPAS/BOXMENU.ZIP/BOXMENU.BOX

Text File | 1985-09-17 | 22.8 KB | 608 lines

{----------------------------------------------------------------------}
{           BOXMENU.BOX   ---  Menu Routines for Turbo Pascal          }
{----------------------------------------------------------------------}
{                                                                      }
{  What these routines do:                                             }
{                                                                      }
{    These routines provide a straight-forward  vertical  selection    }
{    facility.  A  pop-up  window  holds  the  menu.  The  menu  is    }
{    contained in a frame.  The  items  are  displayed  within  the    }
{    frame.  The  currently selected item is highlighted.  You move    }
{    up and down in the list of menu items by using the up and down    }
{    arrow keys,  or the space bar.  To make a selection,  hit  the    }
{    Enter  (Return)  key.  The  First  non-blank character in each    }
{    entry, or a Function Key.                                         }
{                                                                      }
{    Note that code for stacked windows is available here.  You may    }
{    want to modify this to  use  compile-time  window  spaces,  or    }
{    remove the current push-down stack structure.                     }
{                                                                      }
{    NOTES: The include files "SCRNDEF.BOX",  "SCRNSAVE.BOX",  and     }
{           "KBDCHAR.BOX"  must  be  placed in front of this source    }
{           code.                                                      }
{                                                                      }
{    Before  Using any procedures or functions in this box,  a Call    }
{    to the procedure "Set_Screen_Address" must be made  this  will    }
{    initialize  a  data  variable with the address of the color or    }
{    monochrome screen memory.                                         }
{                                                                      }
{----------------------------------------------------------------------}

Const
   Max_Mnu_Items   =  10;   { Maximum number of menu choices }


                   { Menu Types }
Type
  Mnu_Str  = String[40]  { Matches any string for parameter passing };



{----------------------------------------------------------------------}
{                Draw_Mnu_Frame --- Draw a Frame                       }
{----------------------------------------------------------------------}
procedure Draw_Mnu_Frame( X1,  Y1,
                          Width,  NoOfLines : byte;
                          FC, BC : byte );
{----------------------------------------------------------------------}
{     Purpose:    Draws a titled frame using PC graphics characters    }
{----------------------------------------------------------------------}
Type
  ConstStrType = string[80];

{----------------------------------------------------------------------}
{     ConstStr returns a string with N characters of value C           }
{----------------------------------------------------------------------}
  function ConstStr( C : char;
                     N : byte ) : ConStStrType;
  Var
    S : string[80];
  begin
    if N < 0 then N := 0;
    S[0] := Chr(N);
    FillChar(S[1],N,C);
    ConstStr := S;
  end;


Var
   i  : integer;

begin { Draw_Mnu_Frame }
  TextColor( FC );
  TextBackground( BC );

  GotoXY( X1, Y1 );
  Write( '┌' ); Write( ConstStr( '─', Width-2 ) ); Write( '┐' );

  GotoXY( X1, Y1+1 ); Write( '│' );
  GotoXY( X1+Width-1, Y1+1 ); Write( '│' );

  GotoXY( X1, Y1+2 );
  Write( '├' ); Write( ConstStr( '─', Width-2 ) ); Write( '┤' );

  for i := Y1+3  to NoOfLines+Y1+2 do begin
    GotoXY( X1, i ); Write( '│' );
    GotoXY( X1+Width-1, i ); Write( '│' );
  end;

  GotoXY( X1, Y1+NoOfLines+3 );
  Write( '└' ); Write( ConstStr( '─', Width-2 ) ); Write( '┘' );

end;   { Draw_Mnu_Frame }


{----------------------------------------------------------------------}
{                Center --- Center the String on the menu line         }
{----------------------------------------------------------------------}
procedure Mnu_Center( L       : integer;
                      Str     : Mnu_Str;
                      Width   : byte   );
begin  {  Mnu_Center  }
    If Ord(Str[0]) > Width-2 then Str[0] := Chr( Width-2 );
    GotoXY( ( ( Width-Length( Str ) ) div 2 ) + 1, L );
    Write( Str );
end;   {  Mnu_Center  }


{----------------------------------------------------------------------}
{                Mnu_Turn_On --- Highlight Menu Choice                 }
{----------------------------------------------------------------------}

procedure Mnu_Turn_On( Num       : byte;     { Line number for item    }
                       Str       : Mnu_Str;  { Item In String Format   }
                       Width     : byte;     { Width of Menu Area      }
                       ForeColor : byte;     { Foreground Color        }
                       HiLite    : byte;     { The highlight amount    }
                       BackColor : byte );   { Background color        }

{----------------------------------------------------------------------}
{  When the field is high lighted, the foreground color is the normal  }
{  foreground color plus the High Light amount ( ForeColor+HiLite ).   }
{  This allows fine control of the menu colors.                        }
{  If the Map Background color is black,the background is set to       }
{  white(lightgray).  Any other color will use a black background.     }
{----------------------------------------------------------------------}


begin  {  Mnu_Turn_On  }
  if BackColor = Black
    then TextBackground( LightGray )
    else TextBackground( Black );
  TextColor( ForeColor + HiLite );
  Mnu_Center( Num, Str, Width );

end;   {  Mnu_Turn_On  }


{----------------------------------------------------------------------}
{                Mnu_Turn_Off --- UnHighlight Menu Choice              }
{----------------------------------------------------------------------}

procedure Mnu_Turn_Off( Num       : byte;
                        Str       : Mnu_Str;
                        Width     : byte;
                        ForeColor : byte;
                        HiLite    : byte;
                        BackColor : byte );

begin  {  Mnu_Turn_Off  }
  TextBackground( BackColor );
  TextColor( ForeColor );
  Mnu_Center( Num, Str, Width );
end;   {  Mnu_Turn_Off  }


{----------------------------------------------------------------------}
{                BoxMenuDisplay --- Display Blank Menu                 }
{----------------------------------------------------------------------}

procedure BoxMenuDisplay(
                                             { ULC = Upper Left Corner }
                      Mnu_Column   : byte;   { Pos for ULC of menu     }
                      Mnu_Line     : byte;   { Line # for ULC of menu  }
                      Mnu_Width    : integer;{ Width of menu           }

                      Mnu_ItemCtr  : byte;   { No. of items in menu    }

                      Mnu_ForeColor: integer;{ Foreground text color   }
                      Mnu_BackColor: integer );{ BackGround color      }

{----------------------------------------------------------------------}
{  This Procedure DOES NOT SAVE OR RESTORE THE SCREEN!!!!!!!           }
{  It MAY be used externally to create menus that are not              }
{  standard menus.                                                     }
{----------------------------------------------------------------------}


begin { BoxMenuDisplay }

{ Create Window For Menu  }
  Mnu_Window( Mnu_Column, Mnu_Line,
              Mnu_Column+Mnu_Width, Mnu_Line+Mnu_ItemCtr+3 );

  TextColor( Mnu_ForeColor );
  TextBackground( Mnu_BackColor );
  ClrScr;

{ Reset Window }
  Mnu_Window( 1, 1, 80, 25 );

{ Draw the Menu Frame }
  Draw_Mnu_Frame( Mnu_Column, Mnu_Line,
                  Mnu_Width, Mnu_ItemCtr,
                  Mnu_ForeColor, Mnu_BackColor );

{ Create Window For Menu  }
  Mnu_Window( Mnu_Column, Mnu_Line,
              Mnu_Column+Mnu_Width, Mnu_Line+Mnu_ItemCtr+4 );

End   { BoxMenuDisplay };



{----------------------------------------------------------------------}
{                Cursor Control --- Alter Cursor Appearance            }
{----------------------------------------------------------------------}

procedure CursorSelect( a, b : integer );

Var
   Regs : Record       { 8088 registers }
             Ax, Bx, Cx, Dx, Bp, Si, Di, Ds, Es, Flags : integer
          End;

begin   {  CursorSelect  }
  if ( a in [0..8] ) and ( b in [0..7] ) then begin
    Regs.Ax:= $0100;            { ah = set cursor type in high        }
                                {      order byte of the register     }
    Regs.Cx := ( a shl 8 ) + b; { set cursor                }
    Intr( 16, Regs );           { issue interupt for        }
                                { video_io                  }
  end;
end;  {  CursorSelect  }


procedure NoCursor;
begin  {  NoCursor  }
  CursorSelect( 8, 0 )
end;   {  NoCursor  }

procedure NormCursor;
begin  {  NormCursor  }
  CursorSelect( 6, 7 )
end;   {  NormCursor  }


{----------------------------------------------------------------------}
{                BoxStringRead --- Get Menu String                     }
{----------------------------------------------------------------------}

function BoxStringRead(
{ ULC = Upper Left Corner }
{ Pos for ULC of menu     }     Mnu_Column   : byte;
{ Line # for ULC of menu  }     Mnu_Line     : byte;
{ Width of menu           }     Mnu_Width    : byte;

{ Number of Lines in Box    }   Mnu_ItemCtr  : byte;

{ Foreground text color     }   Mnu_ForeColor: byte;
{ BackGround color          }   Mnu_BackColor: byte;
{ Color for the Menu Fields }   Mnu_FldColor : byte;
{ the menu title            }   Mnu_Title    : Mnu_Str;
{ Default value for String  }   Mnu_Default  : Mnu_Str;
{ Force Upper Case on String}   Mnu_Case     : Char;
{ start of field /position  }   Mnu_InPos    : byte;
{ Line for Input Field      }   Mnu_InLine   : byte;
{ Length of Input Field     }   Mnu_Buflen   : byte  )  : Mnu_Str;

Var
   Done,
   Initial : boolean;
   Ch      : char;
   WorkStr : Mnu_Str;
   i       : integer;
begin  {  BoxStringRead  }
  Done := false;  Initial := true;
  Mnu_Case := UpCase( Mnu_Case );
  FillChar(WorkStr, SizeOf(WorkStr), 0 );
{ Create Window For Menu  }
  Mnu_Window( Mnu_Column, Mnu_Line,
              Mnu_Column+Mnu_Width, Mnu_Line+Mnu_InLine+3 );

  Mnu_Center( 2, Mnu_Title, Mnu_Width );

  TextColor( Mnu_FldColor );
  GotoXY( Mnu_InPos, Mnu_InLine+3 );
  if Mnu_Case = 'U'
    then for i := 1 to Length( Mnu_Default ) do
    Mnu_Default[i] := UpCase( Mnu_Default[i] );
  Write( Mnu_Default );

  GotoXY( Mnu_InPos, Mnu_InLine+3 );
  repeat
    Read( kbd, Ch );
    Case Ch of
      CtrlBreak: begin
                   Read( kbd, Ch );
                   if Ch = CtrlBreak then Halt;
                 end;
      BackSpace: if Length( WorkStr ) > 0 then begin
                   Delete( WorkStr, Length( WorkStr ), 1 );
                   Write( BackSpace, ' ', BackSpace );
                 end
                 else Write( Bell );

      Escape   : if ( Length( WorkStr ) > 0 ) and not KeyPressed
                   then WorkStr := ''
                 else begin
                   Done := true;
                   BoxStringRead := WorkStr;
                 end;
      Return   : begin
                   if Initial then WorkStr := Mnu_Default;
                   Done := true;
                 end;
      ' '..'~' : begin
                   if Initial then begin
                     Initial := false;
                     Write( ' ' : Mnu_Buflen-1 );
                     GotoXY( Mnu_InPos, Mnu_InLine+3 );
                   end;
                   if Length( WorkStr ) < Mnu_Buflen then begin
                     if Mnu_Case = 'U' then Ch := UpCase( Ch );
                     WorkStr := WorkStr + Ch;
                     Write( Ch );
                   end;
                 end;

    else Write( ^G );
    end;  {  Case Ch of  }
  until Done;
  BoxStringRead := WorkStr;
end;   {  BoxStringRead  }



{----------------------------------------------------------------------}
{                BoxMenuSelect --- Get Menu Choice                     }
{----------------------------------------------------------------------}

function BoxMenuSelect(
{ ULC = Upper Left Corner }
{ Pos for ULC of menu     }     Mnu_Column   : byte;
{ Line # for ULC of menu  }     Mnu_Line     : byte;
{ Width of menu           }     Mnu_Width    : byte;

{ No. of items in menu    }     Mnu_ItemCtr  : byte;

{ Foreground text color     }   Mnu_ForeColor: byte;
{ BackGround color          }   Mnu_BackColor: byte;

{ Color for the Menu Fields }   Mnu_FldColor : byte;
{ HighLight Field Increment }   Mnu_HiLite   : byte;
{ the menu title            }   Mnu_Title    : Mnu_Str;
{ Code for keys accepted    }   Mnu_Code     : byte;

{ Field Initially Selected  }   Mnu_Select   : byte;
{ Fields Exp1 thru Exp10 }      Exp1         : Mnu_Str;
                                Exp2         : Mnu_Str;
                                Exp3         : Mnu_Str;
                                Exp4         : Mnu_Str;
                                Exp5         : Mnu_Str;
                                Exp6         : Mnu_Str;
                                Exp7         : Mnu_Str;
                                Exp8         : Mnu_Str;
                                Exp9         : Mnu_Str;
                                Exp10        : Mnu_Str )  : integer;
{                                                                      }
{ Remarks:                                                             }
{ The current menu item is highlighted.                                }
{                                                                      }
{   The Menu item value returned may be chosen by:                     }
{     1. Hitting the return key.                                       }
{                                                                      }
{     2. Move to a different item with the Up/Left and                 }
{        Down/Right cursor keys, then hit return key.                  }
{                                                                      }
{     3. Type first character in menu item (case doesn't matter).      }
{                                                                      }
{     4. Type function key for item number in list.                    }
{                                                                      }

Var
   Done    : boolean;
   i, j    : byte;
   WorkStr : Array [1..10] of Mnu_Str;
   Choices : Array [ 1..10 ] of Char;
   Ch, ECh : Char;
   Int     : integer;
   Old_Select : byte;

begin  {  BoxMenuSelect  }
  NoCursor;
  Done := false;
  FillChar( Choices, SizeOf( Choices ), 0 );

{ Create Window For Menu  }
  Mnu_Window( Mnu_Column, Mnu_Line,
              Mnu_Column+Mnu_Width, Mnu_Line+Mnu_ItemCtr+4 );

  Mnu_Center( 2, Mnu_Title, Mnu_Width );
  TextColor( Mnu_FldColor );
  for i := 1 to Mnu_ItemCtr do begin
    Case i of
      1 : WorkStr[i] := Exp1;      2 : WorkStr[i] := Exp2;
      3 : WorkStr[i] := Exp3;      4 : WorkStr[i] := Exp4;
      5 : WorkStr[i] := Exp5;      6 : WorkStr[i] := Exp6;
      7 : WorkStr[i] := Exp7;      8 : WorkStr[i] := Exp8;
      9 : WorkStr[i] := Exp9;      10: WorkStr[i] := Exp10;
    end;

    j := 1;  {  Find first non-blank character in menu item  }
    while ( WorkStr[i] [j] = ' ') and ( j <= Length( WorkStr[i] ) ) do
    j := j + 1;
    if j < Length( WorkStr[i] )
      then Choices[i] := UpCase( WorkStr[i] [j] );
    Mnu_Center( i+3, WorkStr[i], Mnu_Width );
  end;  {  for i := 1 to Mnu_ItemCtr  }

  if ( Mnu_Select < 1 )
  or ( Mnu_Select > Mnu_ItemCtr )
    then Mnu_Select := 1;

  Repeat  { Loop until return key hit }

    Mnu_Turn_On( Mnu_Select+3, WorkStr[Mnu_Select], Mnu_Width,
                 Mnu_FldColor, Mnu_HiLite, Mnu_BackColor );
    Ch := Chr(00);
    ECh := Chr(00);
    Read( kbd , Ch );
    Sound(3000);  { make a short sound }
    NoSound;
    if ( Ch = ^[ {Esc} ) and KeyPressed then Read( kbd, ECh );

    Mnu_Turn_Off( Mnu_Select+3, WorkStr[Mnu_Select], Mnu_Width,
                  Mnu_FldColor, Mnu_HiLite, Mnu_BackColor );

    if ( Ch = Chr( 27 ) )  and  ( Ech <> Chr( 0 ) ) then begin
      Case Ord(Ech) of
        f1..f10 : if (Mnu_Code=3) or (Mnu_Code=4) then begin
                    if (Ord( Ech )-58) <= Mnu_ItemCtr then begin
                      BoxMenuSelect := Ord( ECh );
                      Done:= true;
                    end
                    else Write( Bell );
                  end
                  else Write( Bell );
        CurHome : Mnu_Select := 1;
        CurUp   : begin
                    Mnu_Select := Mnu_Select-1;
                    if Mnu_Select < 1 then Mnu_Select := Mnu_ItemCtr;
                  end;
        CurEnd  : Mnu_Select := Mnu_ItemCtr;
        CurDn   : begin
                    Mnu_Select := Mnu_Select+1;
                    if Mnu_Select > Mnu_ItemCtr then Mnu_Select := 1;
                  end;
      end;  {  Case Ord(Ech) of  }

    end
    else begin
      Ch := UpCase( Ch );
      Case  Ch  of
        CtrlBreak  : begin
                       Read( kbd, Ch );
                       if Ch = CtrlBreak then Halt;
                     end;
        BackSpace  : begin
                       Mnu_Select := Mnu_Select-1;
                       if Mnu_Select < 1 then Mnu_Select := Mnu_ItemCtr;
                     end;
        ForwardTab,
        SpaceBar   : begin
                       Mnu_Select := Mnu_Select+1;
                       if Mnu_Select > Mnu_ItemCtr then Mnu_Select := 1;
                     end;
        Escape     : if (Mnu_Code=1) or (Mnu_Code=3) then begin
                       Done := true;
                       BoxMenuSelect := 0;
                     end
                     else Write( Bell );
        Return     : begin
                       Done := true;
                       BoxMenuSelect := Mnu_Select;
                     end;
        'A'..'Z',
        '0'..'9'   : begin
                       i := 1;
                       while ( i < Mnu_ItemCtr ) and ( Choices[i] <> Ch ) do
                       i := i+1;
                       if i <= Mnu_ItemCtr then begin
                         Done:= true;
                         BoxMenuSelect := i;
                       end
                       else Write( Bell );
                     end;
      end;  {  Case  Ch   }
    end;

  Until Done;


  NormCursor;
end;   {  BoxMenuSelect  }






{----------------------------------------------------------------------}
{           BoxMenu --- Display and Select Menu Choice                 }
{----------------------------------------------------------------------}

function BoxMenu(
{ ULC = Upper Left Corner }
{ Pos for ULC of menu     }     Mnu_Column   : byte;
{ Line # for ULC of menu  }     Mnu_Line     : byte;
{ Width of menu           }     Mnu_Width    : byte;

{ No. of items in menu    }     Mnu_ItemCtr  : byte;

{ Foreground text color     }   Mnu_ForeColor: byte;
{ BackGround color          }   Mnu_BackColor: byte;

{ Color for the Menu Fields }   Mnu_FldColor : byte;
{ HighLight Field Increment }   Mnu_HiLite   : byte;
{ the menu title            }   Mnu_Title    : Mnu_Str;
{ Code for keys accepted    }   Mnu_Code     : byte;

{ Field Initially Selected  }   Mnu_Select   : byte;
{ Fields Exp1 thru Exp10 }      Exp1         : Mnu_Str;
                                Exp2         : Mnu_Str;
                                Exp3         : Mnu_Str;
                                Exp4         : Mnu_Str;
                                Exp5         : Mnu_Str;
                                Exp6         : Mnu_Str;
                                Exp7         : Mnu_Str;
                                Exp8         : Mnu_Str;
                                Exp9         : Mnu_Str;
                                Exp10        : Mnu_Str )  : integer;
{  See the Remarks section of procedure BoxMenuSelect for details        }
begin  {  BoxMenu  }

{  Save current screen image }
  Push_Screen( Screen_Stack_Top );

{  Display the BoxMenu  }
  BoxMenuDisplay(  Mnu_Column, Mnu_Line, Mnu_Width,
                   Mnu_ItemCtr, Mnu_ForeColor, Mnu_BackColor );

  BoxMenu := BoxMenuSelect( Mnu_Column, Mnu_Line, Mnu_Width,
                            Mnu_ItemCtr,
                            Mnu_ForeColor, Mnu_BackColor,
                            Mnu_FldColor, Mnu_HiLite,
                            Mnu_Title, Mnu_Code, Mnu_Select,
                            Exp1, Exp2, Exp3, Exp4, Exp5,
                            Exp6, Exp7, Exp8, Exp9, Exp10 );

{  Restore current screen image  }
  Pop_Screen( Screen_Stack_Top );

end;   {  BoxMenu  }




{----------------------------------------------------------------------}
{           BoxString --- Display and Select Menu Choice               }
{----------------------------------------------------------------------}

function BoxString(
{ ULC = Upper Left Corner }
{ Pos for ULC of menu     }     Mnu_Column   : byte;
{ Line # for ULC of menu  }     Mnu_Line     : byte;
{ Width of menu           }     Mnu_Width    : byte;

{ No. of lines in menu    }     Mnu_ItemCtr  : byte;

{ Foreground text color     }   Mnu_ForeColor: byte;
{ BackGround color          }   Mnu_BackColor: byte;

{ Color for the Menu Fields }   Mnu_FldColor : byte;
{ the menu title            }   Mnu_Title    : Mnu_Str;

{ String Passed to Routine  }   Mnu_Default  : Mnu_Str;
{ force Upper Case          }   Mnu_Case     : Char;

{ Position for Prompt       }   Mnu_InPos    : byte;
{ Number for Prompt         }   Mnu_InLine   : byte;
{ Length of Input           }   Mnu_BufLen   : byte  )  : Mnu_Str;

begin  {  BoxString  }

{  Save current screen image }
  Push_Screen( Screen_Stack_Top );

{  Display the BoxString  }
  BoxMenuDisplay(  Mnu_Column, Mnu_Line, Mnu_Width,
                   Mnu_ItemCtr, Mnu_ForeColor, Mnu_BackColor );

  BoxString := BoxStringRead( Mnu_Column, Mnu_Line, Mnu_Width,
                            Mnu_ItemCtr,
                            Mnu_ForeColor, Mnu_BackColor,
                            Mnu_FldColor,
                            Mnu_Title,
                            Mnu_Default,
                            Mnu_Case,
                            Mnu_InPos, Mnu_InLine,Mnu_Buflen );

{  Restore current screen image  }
  Pop_Screen( Screen_Stack_Top );

end;   {  BoxString  }