Program MyMenu;

(*     Copyright(c) : 1997 JERMiC Sw
 *         Coded by : Laat (Laat@4u.net)
 *
 *        Hi, All!
 *
 *    Some time ago in my mind grew up one idea which found its
 *  implementation in following peace of code. The main idea is
 *  simple as 2by2is4 - processing menu.
 *    After looking at this source you maight find yourself
 *  wondering - what's up with this Laat, why's he doing all the
 *  things so complicated? Well, my answer is - you can
 *  cut/change/combinate this prog till you feel good and
 *  statisfied. Anyway, i made this version of program for
 *  myself, not even for use, just for seeing how these things
 *  look like meanwhile writing program.
 *    So, it is slightly possible that i will post some new (well,
 *  that depends on how to look at this topic) source with simplified
 *  version of menu rocessing.
 *
 *              As Yours as you want me to be,
 *                                        Laat
 *
 *                                              15/11/97
 *)
Uses
  Crt;

Type
  tItem = record
    x, y                : Word;
    HotKey              : Char;
    Data                : String;
  End;

(* The same as UpCase applied to string-type *)
Function UpCaseS ( S : String ): String;
Var   i            : Integer;
      Swaps        : String;
Begin
  Swaps:='';
  If S<>'' then
    For i:=1 to Length(S) do Swaps:=Swaps+UpCase(S[i]);
  UpCaseS:=Swaps;
End;

Procedure CursorOff;assembler; (* Hides cursor *)
Asm
  mov AH,$01
  mov CH,$20
  mov CL,$0
  int $10
End;

Procedure CursorOn; assembler; (* Shows cursor *)
Asm
  mov AH,$01
  mov CH,$3
  mov CL,$4
  int $10
End;

(*   Procedure used to make this program shorter (tired of writing TextColor
 * and TextBackGround together all the time).
 *)
Procedure Col ( _Fc, _Bc: Byte );
Begin
  TextColor(_Fc); TextBackGround(_Bc);
End;

(*   Function which executes given menu.
 *   Requires:
 *     _Arr       - Array of TItem type (see Type section);
 *     _Fg, _Bg   - Text and background colors of unselected items;
 *     _Fg1, _Bg1 - Text and background colors of selected items;
 *     Pos        - Start position of cursor in the menu by default;
 *     _N         - How much items there are in you menu.
 *   Returns:
 *     Number of chosen menu or value '0' if Esc has been pressed.
 *
 *)
Function ExecuteMenu ( _Arr: Array of tItem; _Fg, _Bg, _Fg1, _Bg1: Byte; _Pos: Byte; _N: Byte ): Byte;
Var
(*  _N,*) _J, _J1                       : Integer;
  _TheEnd, _Ext, _Esc, _Found           : Boolean;
  _Ch                                   : Char;
Procedure Draw; (* Draws Menu _Arr *)
Var
  _i                                    : Integer;
Begin
  For _i:=0 to _N-1 do Begin
    If _Arr[_I].Y+_i>50-_Arr[_I].Y then Break;
    GotoXY(_Arr[_I].X, _Arr[_I].Y);
    If _i+1<>_Pos then Begin
      Col(_Fg, _Bg); Write(' '+_Arr[_i].Data+' '); Col(4, _Bg);
    End Else Begin
      Col(_Fg1, _Bg1); Write(' '+_Arr[_i].Data+' '); Col( 4, _Bg1);
    End;
    GotoXY(_Arr[_i].x+Pos(UpCase(_Arr[_i].HotKey), UpCaseS(_Arr[_i].Data)),_Arr[_i].y);
    If Pos(UpCase(_Arr[_i].HotKey), UpCaseS(_Arr[_i].Data))<>0 then
      Write(_Arr[_i].Data[Pos(UpCase(_Arr[_i].HotKey),UpCaseS(_Arr[_i].Data))]);
  End;
End;
Begin
(*  _N:=SizeOf(_Arr) div 255; - this was useful till we got menu items
 *                              defined in Const section (such arrays
 *                              have fixed size, as you already know of
 *                              course).
 *)
  _Esc:=False; _TheEnd:=False; _Found:=False;
  Repeat
    Draw; _Ch:=UpCase(ReadKey);
    Case _Ch of
      #000    : Begin (* Extended keystroke is got *)
                  _Ext:=True; _Ch:=ReadKey;
                  Case _Ch of
     (* UpArr *)    #72, #75  : If _Pos>1 then Dec(_Pos) Else _Pos:=_N;
     (* DnArr *)    #80, #77  : If _Pos<_N then Inc(_Pos) Else _Pos:=1;
     (*   End *)    #79       : _Pos:=_N;
     (*  Home *)    #71       : _Pos:=1;
                  End;
                End;
(*Esc*)#027   : Begin _TheEnd:=True; _Esc:=True; End;
(*Ent*)#013   : _TheEnd:=True;
(*Other*)  Else Begin
                  _J:=_Pos-1; _J1:=_J; Inc(_J);
                  Repeat
                   If _J>=_N then _J:=0;
                   If _J=_J1 then Break;
                   If UpCase(_Arr[_J].HotKey)=_Ch then Begin _Pos:=_J+1; Break; End
                                                  else Inc(_J);
                   Until _Found;

        End;
      End
  Until _TheEnd;
  If _Esc then ExecuteMenu:=0 Else ExecuteMenu:=_Pos;
End;

Const
  (*   Menu to execute
   *   Thought it is hard to define in const, you could use your
   * brain and write your own procedure which adds given menu item
   * to a given array, for example, header of such a procedure maight
   * look like :
   *    Procedure AddItem ( var ArrayToAddIn: Array of TItem;
   *                        ItemToAdd: TItem;
   *                        ToWhichPosition: Byte );
   *)
  Arr : Array[1..10]of tItem=((X:10; Y: 5; HotKey:'F'; Data:'First  '),
                              (X:10; Y: 6; HotKey:'S'; Data:'Second '),
                              (X:10; Y: 7; HotKey:'T'; Data:'Third  '),
                              (X:10; Y: 8; HotKey:'F'; Data:'Fourth '),
                              (X:10; Y: 9; HotKey:'I'; Data:'Fifth  '),
                              (X:10; Y:10; HotKey:'S'; Data:'Sixth  '),
                              (X:10; Y:11; HotKey:'H'; Data:'Seventh'),
                              (X:10; Y:12; HotKey:'E'; Data:'Eighth '),
                              (X:10; Y:13; HotKey:'N'; Data:'Ninth  '),
                              (X:10; Y:14; HotKey:'T'; Data:'Tenth  '));
Var
  n                             : Integer;

Begin
  Col(07, 00); ClrScr; CursorOff;
  GotoXY(01, 25); WriteLn(#24','#25','#27','#26',Home,End,Esc');

  n:=ExecuteMenu(Arr ,00, 07, 15, 01, 02, 10);

  Col(07, 00); ClrScr; CursorOn;
  If n<>0 then WriteLn('Your choice was: ', Arr[n].Data)
          else WriteLn('Where is your choice?');
End.