home *** CD-ROM | disk | FTP | other *** search
/ Point Programming 1 / PPROG1.ISO / pascal / swag / menu.swg / 0001_MENUDEMO.PAS.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  2.2 KB  |  84 lines
  1. Program Menu; Uses Crt;
  2.  
  3. Const
  4.   MenuChoice : Array[1..3] of String[9] = ('Choice #1', 'Choice #2',
  5.                                             'Choice #3');
  6.   MenuPosX = 35;  MenuPosY = 10;
  7.   NumberChoices = 3;
  8.  
  9. Type
  10.   keys = (ReturnKey,Up,Down,Escape);
  11.  
  12. Var
  13.   Key : keys;
  14.   fk : Boolean;
  15.   ch : Char;
  16.   x, y, CurrentChoice : Integer;
  17.  
  18. Procedure SetChoiceColor(back,Fore : Integer);
  19. begin
  20.   TextBackGround(back);
  21.   TextColor(Fore);
  22. end;
  23.  
  24. Procedure GetKey;
  25. begin
  26.   fk := False;
  27.   ch := ReadKey;
  28.   if ch = #0 then
  29.     begin
  30.       fk := True;
  31.       ch := ReadKey;
  32.     end;
  33.   if fk then
  34.     begin
  35.       Case ord(ch) of
  36.         72 : key := Up;
  37.         80 : key := Down;
  38.       end; end;
  39.       if not fk then
  40.         begin
  41.           Case ord(ch) of
  42.             13 : key := ReturnKey;
  43.             27 : key := Escape;
  44.           end;
  45.         end;
  46.     end;
  47.  
  48. begin
  49.   SetChoiceColor(7,0);                  {.. reverse vid black on white }
  50.   For x := 1 to NumberChoices do
  51.     begin                               {.. Write menu options }
  52.       GotoXY(MenuPosX,MenuPosY+x-1);
  53.       if x > 1 then SetChoiceColor(0,7);  {..turn reverse off after }
  54.         Write(MenuChoice[x]);               {  first option written   }
  55.     end;
  56.   GotoXY(MenuPosX,MenuPosY);            {..position curosr on 1st option }
  57.   CurrentChoice := 1;
  58.  
  59.   Repeat
  60.     GetKey;                               {..wait For a key to be pressed }
  61.     SetChoiceColor(0,7);                  {..reverse vid white on black }
  62.     Write(MenuChoice[CurrentChoice]);     {..un-highlight current option }
  63.  
  64.     Case key of
  65.       Up   : if CurrentChoice > 1 then dec(CurrentChoice)
  66.                else CurrentChoice := NumberChoices;
  67.       Down : if CurrentChoice < 3 then inc(CurrentChoice)
  68.                else CurrentChoice := 1;
  69.       end;
  70.  
  71.     SetChoiceColor(7,0);                        {..reverse vid black/white }
  72.     GotoXY(MenuPosX,MenuPosY+CurrentChoice-1);
  73.     Write(MenuChoice[CurrentChoice]);           {..highlight new option }
  74.     GotoXY(MenuPosX,MenuPosY+CurrentChoice-1);
  75.     Until (Key = ReturnKey) or (Key = Escape);
  76.  
  77.     SetChoiceColor(0,7);
  78.  
  79.     Case CurrentChoice of
  80.       1 : Writeln('Helloo 1');
  81.     end;
  82.  
  83. end.
  84.