[Back to MENU SWAG index] [Back to Main SWAG index] [Original]
unit menu;
{ Note: Specify target pascal version - or USE_STRING if unsure }
{$DEFINE USE_STRING}
{*DEFINE USE_PCHAR}
interface
{$IFDEF USE_PCHAR}
uses llist,crt,strings;
{$ELSE}
uses llist,crt;
{$ENDIF}
{ Change these for a different color scheme }
const selected=15+(2 shl 4);
normal=10;
corner=10;
border=2;
{$IFDEF USE_STRING}
{ Maximum width of a menu item - this can save memory }
maxwidth=80;
{$ENDIF}
{ TMenuItem object - based on TItem
by Emil Mikulic }
type PMenuItem=^TMenuItem;
TMenuItem=object(TItem)
{$IFDEF USE_PCHAR}
caption:PChar;
len:word;
{$ELSE}
caption:string[maxwidth];
{$ENDIF}
value:integer;
constructor init(x:string; v:integer; nxt:PMenuItem);
procedure custom; virtual;
procedure foreach; virtual;
function get:integer; virtual;
destructor done;
end;
{ TMenu object - Menu handler
by Emil Mikulic }
type PMenu=^TMenu;
TMenu=object
menuitems:PMenuItem;
current,number:integer;
x,y,w:integer;
constructor init(xx,yy,ww:integer);
procedure additem(s:string; i:integer);
procedure draw;
function getchoice:integer;
function getcurrent:integer;
destructor done;
end;
implementation
constructor TMenuItem.init(x:string; v:integer; nxt:PMenuItem);
begin
{$IFDEF USE_PCHAR}
{ Get the length }
len:=length(x);
{ Allocate memory }
getmem(caption,len+1);
{ Set the string }
StrPCopy(caption,x);
{$ELSE}
caption:=x;
{$ENDIF}
{ Set the integer }
value:=v;
{ Initialise the TItem }
inherited init(nxt);
end;
procedure TMenuItem.custom;
begin
writeln(caption);
end;
procedure TMenuItem.foreach;
begin
custom;
if next<>nil then next^.foreach;
end;
function TMenuItem.get:integer;
begin
get:=value;
end;
destructor TMenuItem.done;
begin
{$IFDEF USE_PCHAR}
{ Free up the string }
freemem(caption,len+1);
{$ENDIF}
{ Just pass it on to TItem }
inherited done;
end;
constructor TMenu.init(xx,yy,ww:integer);
begin
number:=0;
current:=1;
menuitems:=nil;
x:=xx;
y:=yy;
w:=ww;
end;
procedure TMenu.additem(s:string; i:integer);
begin
if menuitems=nil then menuitems:=new(PMenuItem,init(s,i,nil))
else menuitems^.add( new(PMenuItem,init(s,i,nil)) );
number:=number+1;
end;
procedure TMenu.draw;
var i,j:integer;
tmp:PItem;
begin
textattr:=corner;
gotoxy(x,y);
write(#218);
textattr:=border;
for i:=1 to w do write(#196);
textattr:=corner;
write(#191);
textattr:=border;
for i:=1 to number do begin
gotoxy(x,y+i);
write(#179);
gotoxy(x+w+1,y+i);
write(#179);
end;
textattr:=corner;
gotoxy(x,y+number+1);
write(#192);
textattr:=border;
for i:=1 to w do write(#196);
textattr:=corner;
write(#217);
i:=1;
tmp:=menuitems;
while (tmp<>nil) do begin
gotoxy(x+1,y+i);
if i=current then textattr:=selected else textattr:=normal;
for j:=1 to w do write(' ');
gotoxy(x+1,y+i);
tmp^.custom;
tmp:=tmp^.next;
i:=i+1;
end;
textattr:=7;
end;
function TMenu.getcurrent:integer;
var i:integer;
tmp:PItem;
begin
if current=1 then getcurrent:=menuitems^.get else
begin
tmp:=menuitems;
for i:=2 to current do tmp:=tmp^.next;
getcurrent:=tmp^.get;
end;
end;
CONST
KEnter = $000D; KEsc = $001B;
KLeft = $4B00; KRight = $4D00;
KDown = $5000; KUp = $4800;
function TMenu.getchoice:integer;
var
ok:Boolean;
inc:char;
inw:word;
begin
ok:=false;
repeat
draw;
inc:=readkey;
if (inc=#0) and keypressed then begin
inc:=readkey;
inw:=word(inc) shl 8;
end
else
inw:=ord(inc);
case inw OF
KLeft, KUp : if current>1 then current:=current-1;
KRight, KDown: if current<number then current:=current+1;
KEsc : begin
ok:=true;
getchoice:= 0;
end;
KEnter : begin
ok:=true;
getchoice:=getcurrent;
end;
end;
until ok;
end;
destructor TMenu.done;
begin
dispose(menuitems,done);
end;
{
var x:PMenu;
begin
x:=new(PMenu,init(5,5,10));
x^.additem('1st',1);
x^.additem('2nd',2);
x^.additem('3rd',3);
x^.additem('4th',5);
clrscr;
writeln(x^.getchoice);
dispose(x,done);}
end.
{ ---------------------------------CUT------------------------------- }
MENU
Unit Documentation
by Emil Mikulic
I won't go into the details of this unit, instead I'll just show you
basically how to use it. If you want to know how it works, just look
through the code.
Here's a commented example (which you can cut out and compile!):
--- CUT --- CUT --- CUT --- CUT --- CUT --- CUT --- CUT --- CUT ---
uses crt,menu;
{ Set up a variable to use as the menu }
var x:PMenu;
begin
{ Allocate it on the heap - the syntax for PMenu.init is:
PMenu.Init(x,y,width)
X is the X coordinate of the upper-left corner
Y is the Y coordinate of the upper-left corner
Width is the width of the menu (make sure the width is at least
1 bigger than the longest MenuItem string or you get weird results)
}
x:=new(PMenu,init(5,5,10));
{ Add items to its linked list. The syntax is:
PMenu.AddItem(s:string; i:integer);
S is the string that will be displayed
I is the value that will be returned if the item is picked
}
x^.additem('1st',1);
x^.additem('2nd',2);
x^.additem('3rd',3);
x^.additem('4th',4);
clrscr;
{ PMenu.GetChoice displays the menu and waits for the user to pick
an item. The user can use the arrow-keys, Escape and Enter.
Enter makes GetChoice return the value of the selected
item and Escape makes GetChoice return 0 }
writeln(x^.getchoice);
{ Dismantle the menu, not only does it take up memory but you
may get strange results and maybe a system crash if you fail
to do this }
dispose(x,done);
end.
--- CUT --- CUT --- CUT --- CUT --- CUT --- CUT --- CUT --- CUT ---
And that's about it!
Just one last thing -
MENU comes in two different versions
in the same file. If you have Borland Pascal or your
Pascal compiler supports the STRINGS unit then use the
{$DEFINE USE_PCHAR} because it's more memory-efficient.
If you're not sure or have Turbo Pascal 6.0 or 7.0 then
use {$DEFINE USE_STRING} and make sure that only one has the $
and the other one has a {*DEFINE ...} If you have another
pascal compiler or you're not sure then USE_STRING. :)
Emil Mikulic, 1997.
[Back to MENU SWAG index] [Back to Main SWAG index] [Original]