home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / hacking / phreak_utils_pc / menus.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-01  |  2.7 KB  |  90 lines
  1. unit menus;
  2. interface
  3. uses windows,crt;
  4. var menuitem  :array[1..23] of string[80];
  5.     menucount :integer;
  6. function menu(lux,luy,def:integer):integer;
  7. function nbmenu(lux,luy,def:integer):integer;
  8. implementation
  9.  
  10.  
  11. procedure vmemwrite(x,y:integer;str:string;color:byte);
  12. var i:word;
  13. begin
  14.   for i:=1 to length(str) do mem[$B800:2*((y-1)*80+(x-1)+i)]:=ord(str[i]);
  15.   for i:=1 to length(str) do mem[$B800:2*((y-1)*80+(x-1)+i)+1]:=color;
  16. end;
  17.  
  18. function menu(lux,luy,def:integer):integer;
  19. var x,wide,pos,lastpos :byte;
  20.     ch                 :char;
  21. begin
  22.   lux:=lux+1;
  23.   luy:=luy+1;
  24.   wide:=0;
  25.   for x:=1 to menucount do
  26.     if length(menuitem[x])>wide then wide:=length(menuitem[x]);
  27.   for x:=1 to menucount do
  28.     vmemwrite(lux+2,luy+x,menuitem[x],blue*16+yellow);
  29.   lastpos:=def;
  30.   pos:=def;
  31.   repeat
  32.     vmemwrite(lux+1,luy+lastpos,' '+menuitem[lastpos],blue*16+yellow);
  33.     for x:=lux+2+length(menuitem[lastpos]) to lux+wide+2 do
  34.       vmemwrite(x,luy+lastpos,' ',blue*16+yellow);
  35.     vmemwrite(lux+1,luy+pos,' '+menuitem[pos],yellow);
  36.     for x:=lux+2+length(menuitem[pos]) to lux+wide+2 do
  37.       vmemwrite(x,luy+pos,' ',yellow);
  38.     lastpos:=pos;
  39.     repeat ch:=readkey until ch in [#0,#13,#27];
  40.     if not(ch in [#13,#27]) then ch:=readkey;
  41.     case ch of
  42.       'H':if pos>1 then dec(pos) else pos:=menucount;
  43.       'P':if pos<menucount then inc(pos) else pos:=1;
  44.       'I':pos:=1;
  45.       'Q':pos:=menucount;
  46.       'G':pos:=1;
  47.       'O':pos:=menucount;
  48.     end;
  49.   until ch in [#27,#13];
  50.   menu:=pos;
  51.   if ch=#27 then menu:=0;
  52. end;
  53.  
  54. function nbmenu(lux,luy,def:integer):integer;
  55. var x,wide,pos,lastpos :byte;
  56.     ch                 :char;
  57. begin
  58.   luy:=luy+1;
  59.   lux:=lux+1;
  60.   wide:=0;
  61.   for x:=1 to menucount do
  62.     if length(menuitem[x])>wide then wide:=length(menuitem[x]);
  63.   for x:=1 to menucount do
  64.     vmemwrite(lux+2,luy+x,menuitem[x],cyan);
  65.   lastpos:=def;
  66.   pos:=def;
  67.   repeat
  68.     vmemwrite(lux+1,luy+lastpos,' '+menuitem[lastpos],cyan);
  69.     for x:=lux+2+length(menuitem[lastpos]) to lux+wide+2 do
  70.       vmemwrite(x,luy+lastpos,' ',cyan);
  71.     vmemwrite(lux+1,luy+pos,' '+menuitem[pos],blue*16+white);
  72.     for x:=lux+2+length(menuitem[pos]) to lux+wide+2 do
  73.       vmemwrite(x,luy+pos,' ',blue*16+white);
  74.     lastpos:=pos;
  75.     repeat ch:=readkey until ch in [#0,#13,#27];
  76.     if not(ch in [#13,#27]) then ch:=readkey;
  77.     case ch of
  78.       'H':if pos>1 then dec(pos) else pos:=menucount;
  79.       'P':if pos<menucount then inc(pos) else pos:=1;
  80.       'I':pos:=1;
  81.       'Q':pos:=menucount;
  82.       'G':pos:=1;
  83.       'O':pos:=menucount;
  84.     end;
  85.   until ch in [#27,#13];
  86.   nbmenu:=pos;
  87.   if ch=#27 then nbmenu:=0;
  88. end;
  89. end.2  ,
  90.