home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / MENU.SWG / 0001_Re: Lightbar routine..pas next >
Encoding:
Pascal/Delphi Source File  |  1996-02-21  |  2.1 KB  |  75 lines
  1. {
  2.  TL>   Could someone please give me a good routine or sample for a
  3.  TL> scrolling lightbar menu. Mine always trun out ka-putz.
  4. }
  5.  
  6. Procedure TestMenu;
  7. VAR choices : ARRAY[1..6] of STRING[15];
  8.     current : BYTE;
  9.     c       : CHAR;
  10.     done    : BOOLEAN;
  11.  
  12. BEGIN
  13. done:=FALSE;
  14. clrscr;
  15. choices[1]:='Menu Option #1';
  16. choices[2]:='Menu Option #2';
  17. choices[3]:='Menu Option #3';
  18. choices[4]:='Menu Option #4';
  19. choices[5]:='Menu Option #5';
  20. choices[6]:='Menu Option #6';
  21. textcolor(7);
  22. textbackground(0);
  23. for current:=1 to 6 do begin
  24.         gotoxy(2,current+1);
  25.         write(choices[current]);
  26. end;
  27. current:=1;
  28. repeat
  29. { highlight current option }
  30. gotoxy(2,current+1);
  31. textcolor(15);
  32. textbackground(1);
  33. write(choices[current]);
  34. { process input }
  35. while not(keypressed) do begin end;
  36. c:=readkey;
  37. case c of
  38.         #0:begin
  39.                 c:=readkey;
  40.                 case c of
  41.                         #72:begin
  42.                                 gotoxy(2,current+1);
  43.                                 textcolor(7);
  44.                                 textbackground(0);
  45.                                 write(choices[current]);
  46.                                 dec(current);
  47.                                 if (current=0) then current:=6;
  48.                             end;
  49.                         #80:begin
  50.                                 gotoxy(2,current+1);
  51.                                 textcolor(7);
  52.                                 textbackground(0);
  53.                                 write(choices[current]);
  54.                                 inc(current);
  55.                                 if (current=7) then current:=1;
  56.                             end;
  57.                 end;
  58.            end;
  59.        #13:begin
  60.                 case current of
  61.                         { process actions based on the current option # }
  62.                         1:begin
  63.                           end;
  64.                         2:begin
  65.                           end;
  66.                         { etc. }
  67.                 end;
  68.            end;
  69.        #27:begin
  70.                 done:=TRUE;
  71.            end;
  72. end;
  73. until (done);
  74. end;
  75.