home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0126_Pickable Litebar Menu.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  3.6 KB  |  120 lines
  1. {
  2. >Here's some neat lightbars that I made.  REALLY easy to use, pretty
  3. >simple.
  4. >Feel free to use it, like I care.. Just don't yell at me fer what it
  5. >does. }
  6.  
  7. Program lite;
  8.  
  9. Uses crt;
  10.  
  11. Type
  12.  
  13.  literec = Record   {Litebar config rec}
  14.               choices: Integer;
  15.               menu: Array [1..25] Of String;
  16.               othercolor, barcolor: Integer;
  17.             End;
  18.  
  19. Function litebar (lite: literec): Integer;
  20. Procedure HideCursor; Assembler;
  21. Asm
  22.   MOV   AX, $0100         {Hides cursor}
  23.   MOV   CX, $2607
  24.   Int   $10
  25. End;
  26. Procedure ShowCursor; Assembler;
  27. Asm
  28.   MOV   AX, $0100
  29.   MOV   CX, $0506         {Unhides cursor}
  30.   Int   $10
  31. End;
  32. Label ack, stop;
  33. Var
  34.   on: Integer;
  35.   X, Y: Integer;
  36.   key: Char;          {Various vars}
  37.   okey: Byte;
  38.   lastone: Integer;
  39.   litesize: Integer;
  40.  
  41. Begin
  42.   hidecursor;
  43.   X := WhereX;   {Record starting positions}
  44.   Y := WhereY;
  45.   TextColor (lite. othercolor);  {Change color}
  46.   TextBackground (0);            {Change background}
  47.   litesize := 0;
  48.   For on := 1 To lite. choices Do Begin  {This for loop writes the options.}
  49.     GotoXY (X, Y + on - 1);
  50.     WriteLn (lite. menu [on] );
  51.     If Length (lite. menu [on] ) > litesize Then litesize := Length
  52. (lite. menu [on] );
  53.   End;
  54.  
  55.   For on := 1 To lite. choices Do Begin  {This for loop makes the >lightbar}
  56.     If Length (lite. menu [on] ) < litesize Then Begin {the same >length}
  57.       Repeat
  58.         lite. menu [on] := lite. menu [on] + ' ';
  59.       Until Length (lite. menu [on] ) >= litesize;
  60.     End;
  61.   End;
  62.   on := 1;
  63.   lastone := 999;
  64.   Repeat   {Main loop}
  65.     If lastone <> 999 Then Begin  {redraw last option (reset background}
  66.     GotoXY (X, Y + lastone - 1);
  67.       TextBackground (0);
  68.       WriteLn (lite. menu [lastone] );
  69.     End;
  70.     GotoXY (X, Y + on - 1);         {go to option}
  71.     TextBackground (lite. barcolor); {change color}
  72.     WriteLn (lite. menu [on] );  {rewrite current option (background)}
  73.     ack: Repeat key := ReadKey Until key In [#13, #0];  {get a key}
  74.     If key = #0 Then Begin  {was it extended? process it.}
  75.       okey := Ord (ReadKey);
  76.       If (okey = 72) Then Begin  {up}
  77.         If on = 1 Then Begin lastone := on; on := lite. choices End
  78. Else If on <> 1 Then Begin lastone := on; Dec (on); End;
  79.       End
  80.       Else If (okey = 80) Then Begin {down}
  81.         If on = lite. choices Then Begin lastone := on; on := 1 End
  82. Else If (on < lite. choices) Then Begin lastone := on;
  83.           Inc (on);
  84.         End;
  85.       End Else Goto ack;
  86.       Continue;
  87.     End Else
  88.       If key = #13 Then Goto stop Else  {enter}
  89.         If key = ' ' Then If on = lite. choices Then on := 1 Else If
  90. on < lite. choices Then Dec (on) Else
  91.           Goto ack;
  92.   Until 5 < 4; {loop.}
  93.   stop:  {end it}
  94.   litebar := on;  {tell us what they picked}
  95.   ShowCursor;  {turn cursor back on}
  96. End;
  97.  
  98. Var picked: Integer;
  99.     litecfg: literec;
  100. Begin
  101.   TextBackground (0); {Reset backround}
  102.   ClrScr;
  103.   GotoXY (4, 4); {where is menu going to be?}
  104.   litecfg. choices := 4;  {set choices}
  105.   litecfg. menu [1] := 'Player Editor';     {--\               }
  106.   litecfg. menu [2] := 'Software Editor';   {  |____set choices}
  107.   litecfg. menu [3] := 'CPU Editor';        {  |               }
  108.   litecfg. menu [4] := 'Quit';              {--/               }
  109.   litecfg. othercolor := 3;  {Set foreground color}
  110.   litecfg. barcolor := 1;    {Set background color}
  111.   picked := litebar (litecfg);  {Run the lightbars!}
  112.   TextBackground (0);   {change background back (req'd)}
  113.   ClrScr; {clear it}
  114.   WriteLn ('You picked number ', picked, ', which is ', litecfg. menu
  115. [picked], '.');
  116.   {/\   Tell them what they did   /\}
  117. End.
  118.  
  119.  
  120.