KURSOV~1 / MENU

unit menu;
interface
uses crt,dos,mouse;
const
enter=13;esc=27;up=72;down=80;right=77;left=75;f1=59;
f2=60;f3=61;f4=62;f5=63;on=1;off=2;
kol=9;
var mouse_on,b:boolean;r:registers;
type
mc=array[1..9] of string[16];
FUNCTION mouse_state:byte;
FUNCTION mouse_pos(var x,y:integer):boolean;
FUNCTION getkey:byte;
PROCEDURE make_menu(x0,y0,dx,dy,n:byte;mas:mc);
PROCEDURE extra(x,y:byte;st:string);
PROCEDURE norma(x,y:byte;st:string);
FUNCTION punkt_menu(x0,y0,dx,dy,n:byte;mas:mc):byte;
PROCEDURE TIMER;

implementation
procedure Timer;
 var H, M, S, MS:word;
    x, y:integer;
    AT:byte;
 begin
  x:=WhereX;
  y:=WhereY;
  GetTime(H, M, S, MS);
  GotoXY(74, 25);
  AT:=$02;
  TextAttr:=AT;
  textcolor(0);
  Write(H,':');
  if M<10 then Write('0',M) else Write(M);
  GotoXY(x, y);
  AT:=$15;
  TextAttr:=AT;
 end;

FUNCTION mouse_state:byte;
var i:integer;
begin
mouse_on:=false;r.ax:=0;intr($33,r);i:=r.ax;
if i=-1 then mouse_on:=true;
mouse_state:=r.bx;end;
FUNCTION mouse_pos(var x,y:integer):boolean;
begin
r.ax:=3;
intr($33,r);
x:=r.cx;y:=r.dx;
if r.bx>0 then mouse_pos:=true else mouse_pos:=false;end;


FUNCTION punkt_menu(x0,y0,dx,dy,n:byte;mas:mc):byte;
var i,p,m,pr,key:byte;

FUNCTION punkt_con:byte;
var p:byte;
begin
p:=m;
key:=getkey;
case key of
left,up: if p>1 then p:=p-1 else p:=n;
right, down: if p<n then p:=p+1 else p:=1;
enter:pr:=0;
esc:begin p:=0;pr:=0;end;end;
punkt_con:=p;
end;

FUNCTION punkt_mouse:byte;
var p:byte;len:byte;x,y,pm,xp,yp:integer;b:boolean;
begin
len:=length(mas[1]);
p:=0;pm:=0;b:=mouse_pos(x,y);
x:=(x div 8)+1;y:=(y div 8) +1;
xp:=x0+(pm-1)*dx;
yp:=y0+(pm-1)*dy;
if (x>=xp) and (x<=xp+len) and (y=yp) then p:=pm;
if (p>0) and b then pr:=0;
punkt_mouse:=p;
end;

begin
make_menu(x0,y0,dx,dy,n,mas);
p:=1;extra(x0,y0,mas[p]);pr:=1;
mouse_state;
repeat
m:=p;p:=0;
if mouse_on then mouse_show(on);
if mouse_on then repeat
p:=punkt_mouse;
until (p>0) or keypressed;
if p=0 then p:=punkt_con;
if (pr*p>0) and (p<>m) then begin
if mouse_on then mouse_show(off);
norma(x0+(m-1)*dx,y0+(m-1)*dy,mas[m]);
extra (x0+(p-1)*dx,y0+(p-1)*dy,mas[p]);end;
until pr=0;
punkt_menu:=p;
end;


FUNCTION getkey:byte;
var ch:char;
begin
ch:=readkey;
if ch=#0 then ch:=readkey;
getkey:=ord(ch);
end;
PROCEDURE make_menu(x0,y0,dx,dy,n:byte;mas:mc);
var x,y,i:byte;
begin
{Window(1, 1, 80, 25);
{textattr:=$70;
clrscr;}
for i:=1 to n do begin
x:=x0+(i-1)*dx;
y:=y0+(i-1)*dy;
gotoxy(x,y);
write(mas[i]);
end;
end;

procedure extra(x, y:byte; st:string);
begin
textattr:=$20;
gotoxy(x, y);
write(st);
end;

procedure norma(x, y:byte; st:string);
begin
textattr:=$70;
gotoxy(x, y);
write(st);
end;

end.