[Back to EXEC SWAG index] [Back to Main SWAG index] [Original]
{
GG> Could somebody post a message with the Pascal 6.0 source for some
GG> sort of a scrolling menu system? I do NOT want TurboVision. I
GG> HATE OOP. I don't mind records and arrays, but i don't want OOP.
GG> I've done some programming for one myself....
}
UNIT MPMENU;
{
Written and designed by Michael Perry, (c) 1990 Progressive Computer Serv.
A basic, flexible, user-definable menu system using only the most basic
functions in Turbo Pascal. This unit is easily integratable into your
applications and gives you more versatility than most "pull down"-type
menu interfaces.
License: This unit should NOT be modified and redistributed in source
or object/TPU form. You can modify and use this in any non-
commercial program free-of-charge provided that "Mike Perry"
if credited either in the program or documentation. Use of
these routines in a commercially-sold package requires a
one-time registration fee of $30 to be sent to:
Progressive Computer Services
P.O. Box 7638
Metairie, LA 70010
Non-commercial users are also invited to register the code.
This insures that updates and future revisions are made
available and users are kept informed via mail.
Usage: Implementing menus using the MPMENU unit involves just a
few basic steps. At any point in your program, add code
to perform the following actions:
1. Define the menu by assigning values to the MENU_DATA
record.
2. Call the procedure MENU(MENU_DATA,RETURNCODE);
3. Implement a routine to evaluate the value of
RETURNCODE and act accordingly. The values of
RETURNCODE are as follows:
0 = ESC pressed (menu aborted)
1-x = The appropriate option was selected, with 1
being the first menu choice, 2 the second,
etc.
Example: Here is a sample main menu using the MENU procedure:
-----------------------------------------------------------------------------
Program DontDoMuch;
Uses Crt,MPMenu;
CONST HELL_FREEZES_OVER=FALSE;
VAR CHOICE:BYTE;
Begin
REPEAT
With Menu_Data Do Begin
Menu_Choices[1]:='1 - First Option '; - define menu choice onscreen
Row[1]:=10; Column[1]:=30; - where on screen displayed
Menu_Choices[2]:='2 - Second Option'; - same thing for 2nd choice
Row[2]:=12; Column[2]:=30; .
Menu_Choices[3]:='X - Exit Program '; .
Row[3]:=14; Column[3]:=30; .
Onekey:=TRUE; - enable 1-key execution
Num_Choices:=3; - number of menu choices
HiLighted:=112; - highlighted attribute
Normal:=7; - normal attribute
End;
MENU(MENU_DATA,CHOICE); - call the menu now and wait for user
Case Choice Of - evaluate user response and act
0:Halt; - ESC pressed
3:Halt; - option 3, Exit, selected
1:Begin
- put code here to do menu option 1
End;
2:Begin
- put code here to do menu option 2
End;
End
UNTIL HELL_FREEZES_OVER; - infinite loop - back to main menu
End.
-----------------------------------------------------------------------------
}
INTERFACE
USES Crt;
CONST
MAX_CHOICES = 10; { MAX_CHOICES can be changed
depending upon the highest
number of options you will
have on any given menu }
TYPE
MENU_ARRAY = RECORD { record structure for menu }
MENU_CHOICES : ARRAY[1..MAX_CHOICES] OF STRING[50]; { displayed option }
COLUMN : ARRAY[1..MAX_CHOICES] OF BYTE; { column location }
ROW : ARRAY[1..MAX_CHOICES] OF BYTE; { row location }
NUM_CHOICES : BYTE; { # choices on menu }
HILIGHTED : WORD; { attribute for hilight }
NORMAL : WORD; { attributed for normal }
ONEKEY : BOOLEAN; { TRUE for 1-key execution
}
END;
VAR
MENU_DATA : MENU_ARRAY; { global menu variable }
{
NOTE: You can define many menu variables simultaneously, but since you
can generally use only one menu at a time, you can conserve
memory and program space by re-defining this one MENU_DATA record
each time a menu is to be displayed.
}
{ internal procedures }
PROCEDURE SHOW_MENU(MENU_DATA:MENU_ARRAY);
PROCEDURE HILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);
PROCEDURE UNHILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);
FUNCTION GETKEY(VAR FUNCTIONKEY:BOOLEAN):CHAR;
FUNCTION FOUND_CHOICE(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE;CH:CHAR):BOOLEAN;
{ basically, the ONE callable procedure }
PROCEDURE MENU(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE);
IMPLEMENTATION
(*===========================================================================*)
PROCEDURE SHOW_MENU(MENU_DATA:MENU_ARRAY);
{ display defined menu array }
VAR I:BYTE;
BEGIN
TEXTATTR:=MENU_DATA.NORMAL;
FOR I:=0 TO (MENU_DATA.NUM_CHOICES-1) DO BEGIN
GOTOXY(MENU_DATA.COLUMN[I+1],MENU_DATA.ROW[I+1]);
WRITE(MENU_DATA.MENU_CHOICES[I+1]);
END;
END;
(*===========================================================================*)
PROCEDURE HILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);
{ highlight the appropriate menu choice }
BEGIN
GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);
TEXTATTR:=MENU_DATA.HILIGHTED;
WRITE(MENU_DATA.MENU_CHOICES[CHOICENUM]);
{ below needed if direct screen writing not done }
GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);
END;
(*===========================================================================*)
PROCEDURE UNHILIGHT_CHOICE(MENU_DATA:MENU_ARRAY;CHOICENUM:BYTE);
{ highlight the appropriate menu choice }
BEGIN
GOTOXY(MENU_DATA.COLUMN[CHOICENUM],MENU_DATA.ROW[CHOICENUM]);
TEXTATTR:=MENU_DATA.NORMAL;
WRITE(MENU_DATA.MENU_CHOICES[CHOICENUM]);
END;
(*===========================================================================*)
FUNCTION GETKEY(VAR FUNCTIONKEY:BOOLEAN):CHAR;
{ read keyboard and return character/function key }
VAR CH: CHAR;
BEGIN
CH:=ReadKey;
IF (CH=#0) THEN
BEGIN
CH:=ReadKey;
FUNCTIONKEY:=TRUE;
END
ELSE FUNCTIONKEY:=FALSE;
GETKEY:=CH;
END;
(*===========================================================================*)
FUNCTION FOUND_CHOICE(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE;CH:CHAR):BOOLEAN;
{ locate next occurance of menu choice starting with char CH }
VAR I:BYTE; TEMP:STRING;
BEGIN
CH:=UPCASE(CH);
IF EXITCODE=MENU_DATA.NUM_CHOICES THEN BEGIN
TEMP:=MENU_DATA.MENU_CHOICES[1];
IF UPCASE(TEMP[1])=CH THEN BEGIN
UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
EXITCODE:=1;
HILIGHT_CHOICE(MENU_DATA,EXITCODE);
FOUND_CHOICE:=TRUE;
EXIT;
END;
END;
FOR I:=EXITCODE+1 TO MENU_DATA.NUM_CHOICES DO BEGIN
TEMP:=MENU_DATA.MENU_CHOICES[I];
IF UPCASE(TEMP[1])=CH THEN BEGIN
UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
EXITCODE:=I;
HILIGHT_CHOICE(MENU_DATA,EXITCODE);
FOUND_CHOICE:=TRUE;
EXIT;
END;
END;
IF EXITCODE<>1 THEN BEGIN { KILLER RECURSION }
UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
EXITCODE:=1;
IF FOUND_CHOICE(MENU_DATA,EXITCODE,CH) THEN BEGIN
HILIGHT_CHOICE(MENU_DATA,EXITCODE);
FOUND_CHOICE:=TRUE;
EXIT;
END ELSE HILIGHT_CHOICE(MENU_DATA,EXITCODE);
END ELSE BEGIN
TEMP:=MENU_DATA.MENU_CHOICES[1];
IF UPCASE(TEMP[1])=CH THEN BEGIN
FOUND_CHOICE:=TRUE;
EXIT;
END;
END;
FOUND_CHOICE:=FALSE;
END;
(*===========================================================================*)
PROCEDURE MENU(MENU_DATA:MENU_ARRAY;VAR EXITCODE:BYTE);
{ display menu and return user's response:
0 = ESC pressed
1-x = appropriate choice selected
during operation, variable EXITCODE holds number of currently-selected
menu choice.
}
VAR
FNC:BOOLEAN; TEMPATTR:WORD;
CH:CHAR;
BEGIN
TEMPATTR:=TEXTATTR;
IF (EXITCODE=0) OR (EXITCODE>MENU_DATA.NUM_CHOICES) THEN
EXITCODE:=1;
SHOW_MENU(MENU_DATA);
HILIGHT_CHOICE(MENU_DATA,EXITCODE);
REPEAT
CH:=GETKEY(FNC);
IF FNC THEN BEGIN
IF CH=#77 THEN CH:=#80 ELSE
IF CH=#75 THEN CH:=#72;
CASE CH OF
#72:IF EXITCODE>1 THEN BEGIN { UP }
UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
EXITCODE:=EXITCODE-1;
END;
#80:IF EXITCODE<MENU_DATA.NUM_CHOICES THEN BEGIN { DOWN }
UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
EXITCODE:=EXITCODE+1;
END;
#71:IF EXITCODE<>1 THEN BEGIN { HOME }
UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
EXITCODE:=1;
END;
#79:IF EXITCODE<MENU_DATA.NUM_CHOICES THEN BEGIN { END }
UNHILIGHT_CHOICE(MENU_DATA,EXITCODE);
EXITCODE:=MENU_DATA.NUM_CHOICES;
END;
END; { functionkey CASE }
HILIGHT_CHOICE(MENU_DATA,EXITCODE);
END { if FNC }
ELSE
CASE CH OF
#27:BEGIN
EXITCODE:=0;
TEXTATTR:=TEMPATTR;
EXIT;
END;
#13:BEGIN
TEXTATTR:=TEMPATTR;
EXIT;
END;
ELSE
IF FOUND_CHOICE(MENU_DATA,EXITCODE,CH) THEN
IF (MENU_DATA.ONEKEY) THEN BEGIN
TEXTATTR:=TEMPATTR;
EXIT;
END ELSE { nothing }
ELSE
{ BEGIN
GOTOXY(1,20); used for debugging
WRITELN('FNC=',FNC,' KEYVAL=',ORD(CH));
END;
}
END; {case}
UNTIL FALSE;
END;
(*===========================================================================*)
END. { of unit MPMENU }
[Back to EXEC SWAG index] [Back to Main SWAG index] [Original]