home *** CD-ROM | disk | FTP | other *** search
/ The Unsorted BBS Collection / thegreatunsorted.tar / thegreatunsorted / hacking / phreak_utils_pc / grmenus.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-04-01  |  4.5 KB  |  131 lines
  1. unit grmenus;
  2. interface
  3. uses grwins,crt,mouseio,video,extras,bbp_vars;
  4. var menuitem  :array[1..23] of string[80];
  5.     menuinfo  :array[1..23] of string[80];
  6.     menucount :integer;
  7.     skip      :boolean;
  8.     curpos    :byte;
  9. function menu(lux,luy,def:integer;shadow,save,usedesc,enskip,boxed:boolean):integer;
  10. implementation
  11.  
  12. function menu(lux,luy,def:integer;shadow,save,usedesc,enskip,boxed:boolean):integer;
  13. var x,wide,pos,lastpos :byte;
  14.     ch                 :char;
  15.     saveatt            :byte;
  16.     clickposx,clickposy:integer;
  17. begin
  18.   skip:=false;
  19.   wide:=0;
  20.   for x:=1 to menucount do
  21.     if length(menuitem[x])>wide then wide:=length(menuitem[x]);
  22.   if boxed then openbox(99,lux,luy,lux+wide+5,luy+menucount+1,shadow,false,false);
  23.   if not save then ignbox(99);
  24.   for x:=1 to menucount do
  25.     if x<>def then
  26.     vmemwrite(lux+1,luy+x,'  '+menuitem[x]+charlot(' ',wide-length(menuitem[x])+2),colors.win_item);
  27.   lastpos:=0;
  28.   pos:=def;
  29.   repeat
  30.     if usedesc then begin
  31.       saveatt:=textattr;
  32.       textattr:=colors.infoline;
  33.       gotoxy(1,25);
  34.       write(' ',menuinfo[pos]);
  35.       clreol;
  36.       textattr:=saveatt;
  37.     end;
  38.     if (lastpos<>0) and (lastpos<>pos) then begin
  39.       vmemwrite(lux+1,luy+lastpos,'  '+menuitem[lastpos],colors.win_item);
  40.       for x:=lux+2+length(menuitem[lastpos]) to lux+wide+3 do
  41.         vmemwrite(x+1,luy+lastpos,' ',colors.win_item);
  42.     end;
  43.     vmemwrite(lux+2,luy+pos,' '+menuitem[pos],colors.win_hilight);
  44.     for x:=lux+2+length(menuitem[pos]) to lux+wide+2 do
  45.       vmemwrite(x+1,luy+pos,' ',colors.win_hilight);
  46.     vmemwrite(lux+1,luy+pos,'',colors.win_arrows);
  47.     vmemwrite(lux+wide+4,luy+pos,'',colors.win_arrows);
  48.     lastpos:=pos;
  49.     if mousepresent then mouseon;
  50.     if mousepresent then
  51.     repeat until keypressed or (mouseleftclicked
  52.       and (((mousey>luy) and (mousex>lux) and (mousex<lux+wide+5) and (mousey<luy+menucount+1)) or (mousey=2)))
  53.       or mouserightclicked
  54.     else repeat until keypressed;
  55.     if mousepresent then mouseoff;
  56.     if mousepresent then if mouserightclicked then begin
  57.       repeat until not(mouserightclicked);
  58.       ch:=#27;
  59.     end;
  60.     if mousepresent then if enskip then if mouseleftclicked then if mousey=2 then begin
  61.       clickposx:=mousex;
  62.       clickposy:=mousey;
  63.       curpos:=((clickposx-3) div 15)+1;
  64.       if curpos<1 then curpos:=1;
  65.       if curpos>5 then curpos:=5;
  66.       skip:=true;
  67.       pos:=0;
  68.       mouseon;
  69.       repeat until not(mouseleftclicked);
  70.       mouseoff;
  71.       if save then closebox(99);
  72.       menu:=0;
  73.       exit;
  74.     end;
  75.     if mousepresent and mouseleftclicked then begin
  76.       x:=mousey;
  77.       if x-luy>0 then begin
  78.         pos:=x-luy;
  79.         if lastpos<>0 then begin
  80.           vmemwrite(lux+1,luy+lastpos,'  '+menuitem[lastpos],colors.win_item);
  81.           for x:=lux+2+length(menuitem[lastpos]) to lux+wide+3 do
  82.             vmemwrite(x+1,luy+lastpos,' ',colors.win_item);
  83.         end;
  84.         vmemwrite(lux+2,luy+pos,' '+menuitem[pos],colors.win_hilight);
  85.         for x:=lux+2+length(menuitem[pos]) to lux+wide+2 do
  86.           vmemwrite(x+1,luy+pos,' ',colors.win_hilight);
  87.         vmemwrite(lux+1,luy+pos,'',colors.win_arrows);
  88.         vmemwrite(lux+wide+4,luy+pos,'',colors.win_arrows);
  89.         if usedesc then begin
  90.           saveatt:=textattr;
  91.           textattr:=colors.infoline;
  92.           gotoxy(1,25);
  93.           write(' ',menuinfo[pos]);
  94.           clreol;
  95.           textattr:=saveatt;
  96.         end;
  97.         mouseon;
  98.         repeat until not(mouseleftclicked);
  99.         menu:=pos;
  100.         mouseoff;
  101.         if save and boxed then closebox(99);
  102.         exit;
  103.       end;
  104.     end;
  105.     if keypressed then ch:=readkey;
  106.     if ch=#0 then ch:=readkey;
  107.     case ch of
  108.       'H':if pos>1 then dec(pos) else pos:=menucount;
  109.       'P':if pos<menucount then inc(pos) else pos:=1;
  110.       'I':pos:=1;
  111.       'Q':pos:=menucount;
  112.       'G':pos:=1;
  113.       'O':pos:=menucount;
  114.       'K':if enskip then begin if curpos>1 then dec(curpos) else curpos:=5; skip:=true; pos:=0; end;
  115.       'M':if enskip then begin if curpos<5 then inc(curpos) else curpos:=1; skip:=true; pos:=0; end;
  116.     end;
  117.   until (ch in [#27,#13]) xor (skip);
  118.   menu:=pos;
  119.   if ch=#27 then menu:=0;
  120.   if save and boxed then closebox(99);
  121. end;
  122.  
  123. begin
  124.   if paramstr(1)='/(C)' then begin
  125.     writeln('GRMENUS.PAS  v1.60  Green-Shaded Menu Routines w/Mouse Support');
  126.     writeln('             Copyright (C) 1993 by Onkel Dittmeyer / S.L.A.M');
  127.     writeln;
  128.     readln;
  129.   end;
  130. end.
  131.