Category : Pascal Source Code
Archive   : PULLMENU.ZIP
Filename : PULLMENU.PAS

{$A+,B-,D-,E-,F+,G+,I-,L-,N-,O+,R-,S-,V-,X+}
(* ^- need to change to G- to run on pre-80286 machines *)
Unit PullMenu;

Interface

Uses CRT,DOS;

Const maxchoices=13; { Change this to suit your needs }

Type pulldownrec=record
NumChoices:Byte; { Number of choices on pulldowns }
Header :String[35]; { Header on pulldowns }
Choice :Array [1..MaxChoices] of String[35]; { Choices }
AddPrefix :Boolean; { Add # prefix before choice }
End;

function pulldowns(menu:pulldownrec):byte;

implementation

function pulldowns(menu:pulldownrec):byte;

procedure writealot(ch:char; num:integer); { I did not use a more direct }
var s:string[50]; { method for fear it would }
begin { interfere w/ multitasking }
fillchar(s,51,ch);
s[0]:=chr(num);
write(s);
end;

function valu(q:string):integer;
var s,pu:integer; r:real;
begin
valu:=0;
if not (length(q) in [1..5]) then exit;
val (q,r,s);
if s<>0 then exit;
if (r<=32767.0) and (r>=-32767.0) then valu:=round(r)
end;

function strr (n:integer):string;
var q:string;
begin
str (n,q);
strr:=q
end;

Var x,oogz,agga,doot,lastbar,powitetrash:byte; k,eegletz:char;
lame:string[2];

function bioskey:char;
var r:registers;
begin
r.ah:=0;
intr ($16,r);
if r.al=0
then bioskey:=chr(r.ah+128)
else bioskey:=chr(r.al)
end;

Procedure Bar(zZz:byte);
Begin
if LastBar=ZzZ then exit;
GoToXy(20,lastbar+9);
TextBackGround(7);
writealot(' ',9);
if menu.addprefix then begin
textcolor(9);
write(lastbar);
textcolor(12);
write(' - ');
End;
TextColor(1);
write(Menu.Choice[lastbar]);
writealot(' ',25-length(menu.choice[lastbar]));
GoToXy(23,zZz+9);
textbackground(1);
writealot(' ',6);
if menu.addprefix then begin
textcolor(9);
write(zZz);
textcolor(12);
write(' - ');
End;
TextColor(15);
write(Menu.Choice[zZz]);
writealot(' ',23-length(menu.choice[zzz]));
lastbar:=zZz;
GoToXy(23,zZz+9);
End;

Procedure ReserveSpace;
Begin
TextColor(7); TextBackGround(0);
gotoxy(20,WhereY);
writealot('Û',41); TextColor(8); write('ÛÛ'#10#13);
End;

Begin
TextBackGround(0);
lastbar:=menu.numchoices;
ClrScr;
writealot(#10,5); write(#13);
writealot(' ',19); TextColor(15); TextBackGround(7);
writealot('ß',41); TextBackGround(0); GoToXy(20,WhereY+1);
oogz:=menu.numchoices+3;
if menu.header<>'' then inc(oogz);
For X:=1 to oogz do reservespace;
PoWiteTrash:=WhereY;
GoToXy(20,WhereY-oogz+1);
TextColor(3); TextBackGround(7);
writealot(' ',Trunc((40-Length(Menu.Header))/2)-4);
write(Menu.Header);
TextBackGround(7);
agga:=WhereY+2;
For X:=1 to Menu.NumChoices do begin
GoToXy(29,agga);

if menu.addprefix then begin
textcolor(9);
write(x);
textcolor(12);
write(' - ');
end;

TextColor(1); write(Menu.Choice[x]);
inc(agga);
End;

GoToXy(1,PoWiteTrash);
TextBackGround(0);
TextColor(7);
writealot(' ',19);
write('ßß'); TextBackGround(7); TextColor(8);
writealot('Ü',39); TextBackGround(0); write('ÛÛ'#10#13);
writealot(' ',21); TextColor(8);
writealot('ß',41);
Bar(1);
lame:=strr(menu.numchoices);
eegletz:=lame[1];
Repeat
K:=BiosKey;
if ((K in ['1'..eegletz]) and (Menu.NumChoices<10) and (Menu.AddPrefix))
then Bar(Valu(K)) else
Case K of
#201,#199:Bar(1);
#209,#27,#207:Bar(Menu.NumChoices);
#200,#8:if lastbar=1 then Bar(menu.numchoices) else Bar(lastbar-1);
#208,#32:if lastbar=menu.numchoices then Bar(1) else Bar(lastbar+1);
#27:Bar(Menu.NumChoices);
End;
Until K=#13;

TextBackGround(0);
ClrScr;
pulldowns:=lastbar;
End;

Begin
End.