home *** CD-ROM | disk | FTP | other *** search
- {**********************************************************************}
- {* M E N U . 2 0 0 Menu Management Routines *}
- {* *}
- {* Separate Out into File Menu.200 *}
- {**********************************************************************}
- {----------------------------------------------------------------------}
- { Max : Find Max of A or B }
- {----------------------------------------------------------------------}
- Function Max (A,B :integer ) :Integer ;
- Begin { Max };
- If A > B then Max := A
- else Max := B
- End; { Max }
- {----------------------------------------------------------------------}
- { Min : Find Min of A or B }
- {----------------------------------------------------------------------}
- Function Min (A,B :integer ) :Integer ;
- Begin { Min };
- If A < B then Min := A
- else Min := B
- End; { Min }
-
- {----------------------------------------------------------------------}
- { Keyin : Key input from keyboard }
- {----------------------------------------------------------------------}
- Function Keyin: Byte; { Single-Key Input Routine (MSDOS/PCDOS) }
- Const
- Esc = #27; { Esc key }
- Var
- Ch :char;
- Begin
- Read(Kbd,Ch);
- if (Ch = Esc) and keypressed then
- begin { If extended key type get }
- Read(kbd,Ch); { get next key in }
- end;
- Keyin := Ord(Ch) ; { Assign input to Output }
- End;
- {----------------------------------------------------------------------}
- { B e e p : S o u n d t h e H o r n }
- {----------------------------------------------------------------------}
- Procedure Beep(N :integer); {------------------------------------------}
- Begin { This routine sounds a tone of frequency }
- Sound(n); { N for approximately 100 ms }
- Delay(100); {------------------------------------------}
- Sound(n div 2);
- Delay(100);
- Nosound;
- End {Beep} ;
- {----------------------------------------------------------------------}
- { P a u s e : Write Message and wait for keyboard }
- {----------------------------------------------------------------------}
- Procedure Pause (Msg: ParmString);
- Var
- Ch :char;
- Begin
- Beep(600);
- Writeln(Msg);
- Writeln(' Press a Key...');
- Ch := Char(Keyin);
- End;
-
- {----------------------------------------------------------------------}
- { M e n u : Generate Menu Display }
- {----------------------------------------------------------------------}
-
- Function Menu( Input_Items: integer; var Data): integer;
-
- Const
- {Max_Items must be specified maximum number items in menu array }
-
- Maxnumber= 40; { Max Menu size }
- Downlist = 80; { Down_arrow = Esc + 80 }
- Uplist = 72; { Up arrow = Esc + 72 }
- Select = 13; { Enter/Return key }
- Cancel = 27; { ESC key + nothing else }
-
- Last_Selected :integer = 1; { Remember the last selection}
-
- Type
- Listtype=Array[1..maxnumber] Of String[Max_String];
-
- Var
- Item_List: Listtype absolute Data;
-
- Item,
- Xposn,
- Yposn,I : Integer; { Selection Position }
- Chval :byte;
- x,y :integer;
-
- Begin { Menu }
-
- ClrScr;
- Xposn := 4;
- Yposn := 1;
- For I := 1 to Input_Items do
- Begin
- GotoXY(Xposn,Yposn+I);
- writeln(Item_List[I]);
- end;
- writeln;
-
- GotoXY(Xposn,Yposn+I+2); { Display Instructions }
- writeln('Select Option with Arrow keys then press Enter');
- GotoXY(Xposn,Yposn+I+4);
- writeln('- The Hunters Helper - INSTX 2.10');
-
- Item := Last_Selected; { Position to Previous Selection}
- Yposn:= 1; { Pick menu }
- Repeat
- GotoXY(Xposn,Yposn+Item); { Position to current choice }
- Get_Abs_Attr(Attr); { Get Current Text Attributes }
- TextColor((Attr and $0F) or $08);{ Turn Bright Attr on }
- Textbackground(Black);
- write(Item_List[Item]); { Write Current Choice }
- { Get Keyboard and clear current pick }
- Chval := Keyin;
- If Chval <> Select Then { Set current line to normal attr}
- begin
- GotoXY(Xposn,Yposn+Item);
- TextColor(Attr and $0F);
- Textbackground(Attr Shr 4);
- write(Item_List[Item]);
- end;
- Case Chval of { Determine new Pick }
- Select : Begin { Set and remember this selection}
- Menu := Item;
- Last_Selected := Item;
- end;
- Cancel : Menu := 0;
- DownList: Item := Item Mod Input_Items +1 ;
- Uplist : Begin
- Item :=(Item-1) Mod Input_Items ;
- If (Item=0) then Item := Input_Items;
- end;
- end;
-
- Until (Chval = Select) Or (Chval = Cancel)
- End;
- {......................................................................}