bài tập đồ họa máy tính

Bài toán loại 2 D :
program duonghaichieu;
uses crt,graph;
type
point_2d = record
x,y:real;
end;
var
m,n:integer;
cgx,cgy,x,b,xgoc,ygoc:real;
p1,p2:point_2d;
xmin:real;
ymin: real;
xmax:real;
ymax:real;
maxx:integer;
maxy:integer;
{Chuyen tu cua so thuc sang cs nhin}
procedure wtv(p:point_2d;var q:point_2d);{chuyen sang cs nhin}
begin
q.x:=p.x*cgx;
q.y:=p.y*cgy;
end;
{Chuyen tu cs nhin sang man hinh}
procedure vts(p:point_2d; var q:point_2d);{chuyen sang man hinh}
begin
q.x:=xgoc+p.x;
q.y:=ygoc-p.y;
end;
{Ve he truc toa do}
procedure hetruc;

begin
line(round(xgoc),0,round(xgoc),getmaxy);
line(0,round(ygoc),getmaxx,round(ygoc));
end;
{Ve do thi sin}
function bp(x:real):real;
begin
bp:=sin(x);
end;
begin
clrscr;
m:=0;
initgraph(m,n,'');
maxx:=getmaxx;
maxy:=getmaxy;
b:=2*pi/360;
xmin:=0;
xmax:=2*pi;
ymin:=-1;
ymax:=1;
{ if xmin>0 then xmin:=0;
if ymin>0 then ymin:=0;
if xmax<0 then xmax:=0;
if ymax<0 then ymax:=0;}
{Tinh he so co gian}
cgx:=maxx/(xmax-xmin);
cgy:=maxy/(ymax-ymin);
{Tinh lai kich thuoc cua so}
xmin:=cgx*xmin;
xmax:=cgx*xmax;

ymin:=cgy*ymin;
ymax:=cgy*ymax;
{Tinh toa do he truc}
xgoc:=0;
if xgoc>xmin then xgoc:=round(abs(xmin));
ygoc:=0;
if ygoc<ymax then ygoc:=round(abs(ymax));
hetruc;
{Chuyen diem dau tien vao cua so man hinh de ve}
x:=xmin;
p1.x:=x;
p1.y:=bp(x);
wtv(p1,p2);
p1:=p2;
vts(p2,p2);
moveto(round(p2.x),round(p2.y));
repeat
p1.x:=x;p1.y:=bp(x);
wtv(p1,p2);
p1:=p2;
vts(p2,p2);
lineto(round(p2.x),round(p2.y));
x:=x+b;
until x>2*pi-xmin+b;
readln;
closegraph;
end.
uses crt,graph;
type
mt1= array[1 1,1 3] of real;

mt2= array[1 3,1 3] of real;
P2d = record
x,y:real;
end;
var a,b,c:P2d;
mta,mtb,mtc:mt1;
mttt,mttl,mtq:mt2;
mtkqa,mtkqb,mtkqc:mt1;
tx,ty,lx,ly,goc,radgoc:real;
i,j:integer;
kqa,kqb,kqc:P2d;
procedure ktdh;
var gd,gm:integer;
begin
gd:=0;
initgraph(gd,gm,'d:\bp\bgi');
end;
procedure mt1333(a:mt1;b:mt2;var c:mt1);
var i,j,k:integer;
begin
for i:=1 to 1 do
for j:=1 to 3 do
c[i,j]:=0;
for i:=1 to 1 do
for k:=1 to 3 do
for j:=1 to 3 do
c[i,k]:=c[i,k]+a[i,j]*b[j,k];
end;
procedure mt3333(a,b:mt2;var c:mt2);
var i,j,k:integer;

begin
for i:=1 to 3 do
for j:=1 to 3 do
c[i,j]:=0;
for i:=1 to 3 do
for k:=1 to 3 do
for j:=1 to 3 do
c[i,k]:=c[i,k]+a[i,j]*b[j,k];
end;
begin
clrscr;
write('Nhap toa do diem A: ');
readln(a.x,a.y);
write('Nhap toa do diem B: ');
readln(b.x,b.y);
write('Nhap toa do diem C: ');
readln(c.x,c.y);
{ write('Nhap Tx =');readln(tx);
write('Nhap Ty =');readln(ty);
mta[1,1]:=a.x;mta[1,2]:=a.y;mta[1,3]:=1;
mtb[1,1]:=b.x;mtb[1,2]:=b.y;mtb[1,3]:=1;
mtc[1,1]:=c.x;mtc[1,2]:=c.y;mtc[1,3]:=1;
mttt[1,1]:=1;mttt[2,1]:=0;mttt[3,1]:=tx;
mttt[1,2]:=0;mttt[2,2]:=1;mttt[3,2]:=ty;
mttt[1,3]:=0;mttt[2,3]:=0;mttt[3,3]:=1;
mt1333(mta,mttt,mtkqa);
mt1333(mtb,mttt,mtkqb);
mt1333(mtc,mttt,mtkqc);
kqa.x :=mtkqa[1,1];kqa.y:=mtkqa[1,2];
kqb.x :=mtkqb[1,1];kqb.y:=mtkqb[1,2];

kqc.x :=mtkqc[1,1];kqc.y:=mtkqc[1,2];}
{ write('Nhap Lx =');readln(lx);
write('Nhap Ly =');readln(ly);
mta[1,1]:=a.x;mta[1,2]:=a.y;mta[1,3]:=1;
mtb[1,1]:=b.x;mtb[1,2]:=b.y;mtb[1,3]:=1;
mtc[1,1]:=c.x;mtc[1,2]:=c.y;mtc[1,3]:=1;
mttl[1,1]:=lx;mttl[2,1]:=0;mttl[3,1]:=0;
mttl[1,2]:=0;mttl[2,2]:=ly;mttl[3,2]:=0;
mttl[1,3]:=0;mttl[2,3]:=0;mttl[3,3]:=1;
mt1333(mta,mttl,mtkqa);
mt1333(mtb,mttl,mtkqb);
mt1333(mtc,mttl,mtkqc);
kqa.x :=mtkqa[1,1];kqa.y:=mtkqa[1,2];
kqb.x :=mtkqb[1,1];kqb.y:=mtkqb[1,2];
kqc.x :=mtkqc[1,1];kqc.y:=mtkqc[1,2];}
write('Nhap goc quay =');readln(goc);
radgoc:=(goc*pi)/180;
mta[1,1]:=a.x;mta[1,2]:=a.y;mta[1,3]:=1;
mtb[1,1]:=b.x;mtb[1,2]:=b.y;mtb[1,3]:=1;
mtc[1,1]:=c.x;mtc[1,2]:=c.y;mtc[1,3]:=1;
mtq[1,1]:=cos(radgoc);mtq[2,1]:=-sin(radgoc);mtq[3,1]:=0;
mtq[1,2]:=sin(radgoc);mtq[2,2]:=cos(radgoc);mtq[3,2]:=0;
mtq[1,3]:=0;mtq[2,3]:=0;mtq[3,3]:=1;
mt1333(mta,mtq,mtkqa);
mt1333(mtb,mtq,mtkqb);
mt1333(mtc,mtq,mtkqc);
kqa.x :=mtkqa[1,1];kqa.y:=mtkqa[1,2];
kqb.x :=mtkqb[1,1];kqb.y:=mtkqb[1,2];
kqc.x :=mtkqc[1,1];kqc.y:=mtkqc[1,2];
ktdh;

setcolor(red);
line(round(a.x),round(a.y),round(b.x),round(b.y));
line(round(a.x),round(a.y),round(c.x),round(c.y));
line(round(c.x),round(c.y),round(b.x),round(b.y));
setcolor(white);
line(round(kqa.x),round(kqa.y),round(kqb.x),round(kqb.y));
line(round(kqb.x),round(kqb.y),round(kqc.x),round(kqc.y));
line(round(kqc.x),round(kqc.y),round(kqa.x),round(kqa.y));
readln;
closegraph;
end.
Bài toán loại 3D :
Program DOTHI;
Uses crt,graph,gmenu,minh3,mouses;
Type
Data=record
Dta:real;
at:byte;
end;
VAR
ghA,ghB,No:real;
Malenh,Maham,Ndoan:integer;
Y:array[1 3]of real;
BT:array[1 128]of data;
BT_ham,tip:string;
Fit:boolean;
Xtus,Ytus:integer;
Ntt,nn:byte;
i,j:integer;
(***********************************************************************

****)
Function tiento(x:real):boolean; forward;
Procedure Status(fx:string;a,b,x:real); forward;
{ }
Function F(x:real):boolean;
var i:integer;
Begin f:=false;
case Maham of
1:begin f:=true;NN:=1;y[1]:=x*x/5+x/5-2;tip:='y=0.2xý+0.2x-2';end;
2:begin f:=true;NN:=1;y[1]:=sin(x);tip:='y=Sin(x)';end;
3:begin f:=true;NN:=1;y[1]:=Cos(x);tip:='y=Cos(x)';end;
4:begin if cos(x)<>0 then begin
f:=true;NN:=1;y[1]:=sin(x)/cos(x);tip:='y=Tang(x)';end;end;
5:begin if x>0 then begin f:=true;NN:=1;y[1]:=ln(x);tip:='y=ln(x)';end else f:=false;end;
6:begin f:=true;NN:=1;y[1]:=exp(x);tip:='y=Exp(x)';end;
7:begin if x>=0 then begin f:=true;NN:=2;y[1]:=sqrt(x);y[2]:=-y[1];tip:='y=ûx';end;end;
8:begin f:=true;NN:=3;y[1]:=sin(x);y[2]:=x/2;y[3]:=y[1]+y[2];tip:='y=Sin(x)+x/2';end;
9:begin f:=true;NN:=1;y[1]:=sin(x)*cos(sin(x));tip:='y=Sin(x)*Cos(sin(x))';end;
10:begin if (9-x*x)>=0 then
begin f:=true;NN:=2;y[1]:=sqrt(9-x*x);y[2]:=-y[1];tip:='Duong tron R=3';end;end;
11:begin f:=Tiento(x);tip:=BT_ham;end;
end;
End;
(***********************************************************************
*****)
Procedure Hamso;
var tX,tY,px:real;dX,dY:integer;Start:boolean;
Fmin,Fmax,x0:real;
y0:array[1 3]of real;
Begin start:=false;

Zone(Xmin,Ymin,Xmax,Ymax,1,Hicolor);
GetOwnInfo;M_off;
if ghA=ghB then if ghA=0 then ghB:=1 else ghA:=-ghB;
if ghA>ghB then begin ghA:=ghA+ghB; ghB:=ghA-ghB; ghA:=ghA-ghB;end;
i:=0;while (not f(ghA+(ghB-ghA)*(i/Ndoan)))and(i<=Ndoan)do
i:=i+1;Fmin:=y[1];fmax:=fmin;
for i:=0 to Ndoan do
if f(ghA+(ghB-ghA)*(i/Ndoan))then
for j:=1 to NN do begin if fmin>y[j] then fmin:=y[j];
if fmax<y[j] then fmax:=y[j];end;
if Fmax<>Fmin then
Begin
tX:=(Xmax-Xmin)/(ghB-ghA);
tY:=(Ymax-Ymin)/abs(fmax-fmin);
if not fit then if (tX>tY)then tX:=tY else tY:=tX;
setcolor(7);
dX:=round(((Xmax-Xmin)-(ghB-ghA)*tX)/2);
dY:=round(((Ymax-Ymin)-(fmax-fmin)*tY)/2);
if (ghA*ghB)<=0 then
begin
line(Xmin+dx-round(ghA*tX),Ymax,Xmin+dx-round(ghA*tX),Ymin);
moveto(Xmin+dx-round(ghA*tX),ymin);linerel(1,8);linerel(-2,0);linerel(1,-8);
outtextxy(Xmin+dx-round(ghA*tX)+3,ymin+2,'Y');
end;
if (fmin*fmax)<=0 then
begin
line(Xmin,Ymax-dy+round(fmin*tY),Xmax,Ymax-dy+round(fmin*tY));
moveto(Xmax,Ymax-dy+round(fmin*tY));linerel(-8,1);linerel(0,-2);linerel(8,1);
outtextxy(Xmax-8,Ymax-dy+round(fmin*tY)-10,'X');
outtextxy(Xmin+dx-round(ghA*tX)+3,Ymax-dy+round(fmin*tY)-8,'0');

end;
setlinestyle(1,1,1);line(Xmin+dx,Ymin,Xmin+dx,Ymax);line(Xmax-dx,Ymin,Xmax-
dx,Ymax);
outtextxy(Xmin+dx+2,Ymax-dy+round(fmin*tY)+2,'A');outtextxy(Xmax-dx-8,Ymax-
dy+round(fmin*tY)+2,'B');
setlinestyle(0,0,0);setcolor(14);
for i:=0 to Ndoan do
Begin
px:=ghA+(ghB-ghA)*(i/Ndoan);
if f(px)then
begin
if start=false then begin start:=true;for j:=1 to NN do y0[j]:=y[j];end
else for j:=1 to NN do
begin setcolor(13+j);
line(Xmin+dx+round((x0-ghA)*tx),Ymax-dy-round((y0[j]-fmin)*tY),
Xmin+dx+round((px-ghA)*tX),Ymax-dy-round((y[j]-fmin)*tY));y0[j]:=y[j];
end; X0:=px;
end else start:=false;
End;
End else Message('Canh bao ','Ham nay khong xac dinh trong khoang [A,B]' );
SetOwnInfo;M_on;Status(tip,ghA,ghB,No);
End;
{ }
Procedure Status(fx:string;a,b,x:real);
Begin
Buttontext(Xtus+50,Ytus,250,29,fx);
str(a:7:2,fx);Buttontext(Xtus+365,Ytus,50,29,fx);
str(b:7:2,fx);Buttontext(Xtus+420,Ytus,50,29,fx);
str(x:7:2,fx);Buttontext(Xtus+500,Ytus,50,29,fx);
if F(x) then begin str(y[1]:7:2,fx);Buttontext(Xtus+570,Ytus,50,21,fx);end

else Buttontext(Xtus+570,Ytus,50,21,'None');
End;
{ }
Procedure manhinh;
var i:integer;
Begin menuflag:=true;
Window(0,1,GetmaxX,GetmaxY,0,'Do thi ham so y=F(x) trong khoang [a,b]');
AddButton(GetmaxX-H_buttool-2,1,H_Buttool ,32,'X',100);
if menuflag then begin Initmenu(Xmin,YMin);Ymin:=Ymin+H_Button+1;end;
Zone(Xmin,Ymin,Xmax,YMin+H_button+2,2,Bcolor);Ymin:=Ymin+1;
GetOwninfo;M_off;
Settextjustify(lefttext,1);settextstyle(Ttype,Tdir,Tsize);setcolor(Tcolor);
outtextxy(Xmin+3,Ymin+H_button div 2-1,' Ham so:');
outtextxy(Xmin+305,Ymin+H_button div 2-1,' Gioi han:');
outtextxy(Xmin+470,Ymin+H_button div 2-1,' N§:X Y');
SetOwninfo;M_on;Xtus:=xmin;Ytus:=Ymin;
Ymin:=Ymin+H_Button+3;
AddButton(Xmin,Ymin,48,0,'Axý+Bx+C',1);
AddButton(Xmin,Ymin+H_Button+1,48,0,'Sin(x)',2);
AddButton(Xmin,Ymin+2*(H_Button+1),48,0,'Cos(x)',3);
AddButton(Xmin,Ymin+3*(H_Button+1),48,0,'Tan(x)',4);
AddButton(Xmin,Ymin+4*(H_Button+1),48,0,'Ln(x)',5);
AddButton(Xmin,Ymin+5*(H_Button+1),48,0,'Exp(x)',6);
AddButton(Xmin,Ymin+6*(H_Button+1),48,0,'Sqrt(x)',7);
AddButton(Xmin,Ymin+7*(H_Button+1),48,0,'Si+x/2',8);
AddButton(Xmin,Ymin+8*(H_Button+1),48,0,'Si*co(si)',9);
AddButton(Xmin,Ymin+9*(H_Button+1),48,0,'xý+yý=Rý',10);
AddButton(Xmin,Ymax-H_button,48,0,'AutoFit',12);
AddButton(Xtus+50,Ytus,250,29,'Bieu thuc tien to',20);
AddButton(Xtus+365,Ytus,50,29,'ghA',21);

AddButton(Xtus+420,Ytus,50,29,'ghB',22);
AddButton(Xtus+500,Ytus,50,29,'X',23);
AddButton(Xtus+570,Ytus,50,29,'Y',24);
DrawallButton;
Xmin:=Xmin+50;
Zone(Xmin,Ymin,Xmax,Ymax,3,Bcolor);
Xmax:=Xmax-H_Buttool;Ymax:=Ymax-H_Buttool;
Zone(Xmin,Ymin,Xmax,Ymax,1,Hicolor);
End;
{ }
Procedure varInit;
begin
Xmin:=2;Ymin:=H_buttool+5;Xmax:=GetmaxX-5;Ymax:=GetmaxY-5;
ghA:=-pi;ghB:=pi;Ndoan:=570;Maham:=2;Malenh:=1;
end;
{ }
Procedure Nhaptiento;
var i,code:integer;st:string;So:real;
Begin Message('Chu y','Nhap ham so duoi dang bieu thuc tien to. Xem them Help ');
readstr(Xtus+50,Ytus,250,29,BT_ham);i:=1;Ntt:=0;
Repeat
case BT_ham[i] of
'+':begin Ntt:=Ntt+1;BT[ntt].dta:=1;BT[ntt].at:=1;end;
'-':begin Ntt:=Ntt+1;BT[ntt].dta:=2;BT[ntt].at:=1;end;
'*':begin Ntt:=Ntt+1;BT[ntt].dta:=3;BT[ntt].at:=1;end;
'/':begin Ntt:=Ntt+1;BT[ntt].dta:=4;BT[ntt].at:=1;end;
'0' '9':begin st:=BT_ham;delete(st,1,i-1);val(st,So,code);
while code<>0 do begin st:=copy(st,1,code-1);val(st,so,code);end;
Ntt:=ntt+1;BT[ntt].dta:=so;BT[ntt].at:=0;;i:=i+length(st)-1;
end;

'X','x':begin Ntt:=ntt+1;BT[ntt].at:=2;end;
'S','s':begin Ntt:=ntt+1;BT[ntt].dta:=11;BT[ntt].at:=1;end;
'C','c':begin Ntt:=ntt+1;BT[ntt].dta:=12;BT[ntt].at:=1;end;
end;i:=i+1;
Until i>length(BT_ham);
End;
{ }
Function Tiento(x:real):boolean;
var a,b:real;G:array[1 128]of data;i,j,l,n:byte;
Begin i:=ntt;n:=ntt;tiento:=false;
for i:=1 to ntt do begin G[i]:=BT[i];if BT[i].at=2 then G[i].dta:=x;end;
While i>0 do
Begin if (G[i].at=1) then
Case round(g[i].dta) of
1,2,3,4:if i<=n-2 then
begin tiento:=true;
case round(g[i].dta) of
1:G[i].dta:=G[i+1].dta+G[i+2].dta;
2:G[i].dta:=G[i+1].dta-g[i+2].dta;
3:G[i].dta:=G[i+1].dta*g[i+2].dta;
4:if g[i+2].dta<>0 then G[i].dta:=G[i+1].dta/g[i+2].dta
else begin tiento:=false;i:=1;end;
end; G[i].at:=0;j:=i;y[1]:=G[j].dta;nn:=1;
while (j+2)<n do begin G[j+1].dta:=G[j+3].dta;j:=j+1;end;n:=n-2;
end else begin tiento:=false;i:=1;end;
11,12:if i<=n-1 then
begin tiento:=true;
case round(G[i].dta)of
11:G[i].dta:=sin(G[i+1].dta);
12:G[i].dta:=Cos(G[i+1].dta);end;

G[i].at:=0;j:=i;y[1]:=G[j].dta;nn:=1;
while (j+1)<n do begin G[j+1].dta:=G[j+2].dta;j:=j+1;end;n:=n-1;
end else begin tiento:=false;i:=1;end;
End; i:=i-1;
End;
End;
{ }
BEGIN
graphInit;M_init;varinit;M_on;
manhinh; hamso;
Message('Start','Chao mung cac ban den voi CT nay. Chuc thanh cong ');
Repeat malenh:=0;
Keytrap; if mamenu<>0 then begin malenh:=mamenu;mamenu:=0;end;
if MLP then Malenh:=M_inBT;
case Malenh of
1 10:begin Maham:=Malenh;hamso;end;
12:begin fit:=not fit; hamso;end;
20:begin nhaptiento;maham:=11;hamso;end;
21:begin readval(Xtus+365,Ytus,50,29,ghA);hamso;end;
22:begin readval(Xtus+420,Ytus,50,29,ghB);hamso;end;
23:begin readval(Xtus+500,Ytus,50,29,No);hamso;end;
end;
Until (malenh=-1)or(malenh=100);
closegraph;
END.
Program DH256;
uses crt,dos,vga256,graph;
var
x,y,j,i:integer;
{ }

Procedure Cuong(x0,y0,xh,yh,color:integer);
var dx,dy,tx,ty,i:integer;kc,x,y:real;
Begin datcontro(x0,y0);datmau(color);
dx:=xh-x0;dy:=yh-y0;
kc:=sqrt(abs(dx*dx+dy*dy))+1;
for i:=1 to round(kc) do
begin
x:=i; y:=kc*sin(i*2*pi/kc)/16;
tx:=round((x*dx-y*dy)/kc);
ty:=round((x*dy+y*dx)/kc);
doanden(x0+round(tx),y0+round(ty));
end;
End;
{ }
Procedure Hoa(x0,y0,R,color:integer);
var x,y,i,t:integer;di,dr:real;
Begin cuong(320,10,x0,y0,random(7));
datcontro(x0,y0);
datmau(color);t:=random(9);
for i:=1 to 180 do
begin di:=t+i*pi/90;
dr:=R*sin(4*di)*cos(t*di);
x:=x0+round(dr*cos(di));
y:=Y0+round(dr*sin(di));
doanden(x,y);
end;
End;
{ }
BEGIN randomize;
khoitao256;

{ clrscr;} write('sdfgdfgdf');
directvideo:=false;
for i:=0 to 255 do
begin datmau(i);
tomauCN(i*2,10,i*2+2,200);
end;
datmau(14);
for i:=1 to 255 do
begin datmau(i);doan(0,i,i,0);end;
datmau(15);doan(1,10,510,10);
for i:=1 to 25 do
begin
Hoa(random(540)+50,random(380)+50,random(25)+25,random(63)+32);
sound(random(500)+50);delay(2500);
end; nosound;
readln;
END.
{ }
Unit DHMT;
Interface
uses graph,crt;
Type
MT2d=array[1 3,1 3]of real; {ma tran thuan nhat 2 chieu}
MT3d=array[1 4,1 4]of real;
Point3d=record
x,y,z:real;
end;
Point2d=record
x,y:real;
end;

VAR
Twv:MT2d;
Per,Par:MT3d;
Procedure Khoitaodohoa(BGIpath:string);
Procedure Diem(P:point2d;color:byte);
Procedure Doan(p1,p2:point2d);
Procedure Cuaso2d(x1,y1,x2,y2:real);
Procedure Tamnhin2d(x1,y1,x2,y2:Integer);
Procedure Biendoi2d(var P:point2d;M:mt2d);
Procedure Quay2d(goc:real;var MT:MT2d);
Procedure NhanMT2d(a,b:MT2d;var MT:MT2d);
Procedure KTMT2d(var mt:MT2d);
Procedure KTMT3d(var mt:MT3d);
Procedure Biendoi3d(var P:point3d;M:mt3d);
Procedure NhanMT3d(a,b:MT3d;var MT:MT3d);
Procedure Tinhtien3d(x,y,z:real;var MT:MT3d);
Procedure Quay3d(truc:char;goc:real;var MT:MT3d);
Procedure KhoitaoSongsong(g1,g2:real);
Procedure KhoitaoPhoicanh(x0,y0,z0,g1,g2,d:real);
Procedure ChieuPC(P:point3d;var Pa:Point2d);
Procedure ChieuSS(P:point3d;var Pa:Point2d);
Function Cohen3D(var p1,p2:point3D):Boolean;
Function PerClipLine(p1,p2:Point3d;var q1,q2:Point2d):boolean;
Procedure ClipPoly(np:integer;P:array of point3d;var nd:integer;var DG:array of
pointtype);
Implementation
var
XWmin,YWmin,XWmax,YWmax:real; {Window trong he toa do thuc 2D}
XVmin,YVmin,XVmax,YVmax:Integer;{Viewport trong thiet bi hien thi}
Zfront,Zback,ClipX,clipY:real; {khung nhin lap the cho phoi canh}

PerClip:mt3d;
Tamchieu:point3d;
MPchieu:Point3D;
(****************************************************)
Procedure TinhTWV; forward;
Procedure Khoitaodohoa(BGIpath:string);
var gd,gm:integer;
Begin
gd:=detect;Initgraph(gd,gm,BGIpath);
If GraphResult<>0 then begin write(#7,'Loi do hoa');readln;halt;end;
directvideo:=false;
XWmin:=0;YWmin:=0;XWmax:=getmaxX;YWmax:=getmaxY;
XVmin:=0;YVmin:=0;XVmax:=GetmaxX;YVmax:=GetmaxY;
tinhTWV;
End;
{ }
Procedure diem(P:point2d;color:byte);
Begin
Putpixel(round(P.x),round(P.y),color);
End;
{ }
Procedure doan(p1,p2:point2d);
var x1,y1,x2,y2:integer;
Begin
x1:=round(p1.x);y1:=round(p1.y);
x2:=round(p2.x);y2:=round(p2.y);
line(x1,y1,x2,y2);
End;
{ }
Procedure TinhTWV;

var t:real;
Begin
Twv[1,1]:=(XVmax-XVmin)/(XWmax-XWmin);Twv[2,1]:=0; Twv[3,1]:=0;
Twv[1,2]:=0;Twv[2,2]:=-(YVmax-YVmin)/(YWmax-YWmin); Twv[3,2]:=0;
Twv[1,3]:=XVmin-XWmin*Twv[1,1];Twv[2,3]:=YVmax-
YWmin*Twv[2,2];Twv[3,3]:=1;
End;
{ }
Procedure Cuaso2d(x1,y1,x2,y2:real);
Begin
if x1<x2 then begin XWmin:=x1;XWmax:=x2;end
else begin XWmin:=x2;XWmax:=x1;end;
if y1<y2 then begin YWmin:=y1;YWmax:=y2;end
else begin YWmin:=y2;YWmax:=y1;end;
TinhTWV;
End;
{ }
Procedure Tamnhin2d(x1,y1,x2,y2:Integer);
Begin
if x1<x2 then begin XVmin:=x1;XVmax:=x2;end
else begin XVmin:=x2;XVmax:=x1;end;
if y1<y2 then begin YVmin:=y1;YVmax:=y2;end
else begin YVmin:=y2;YVmax:=y1;end;
TinhTWV; rectangle(x1-1,y1-1,x2+1,y2+1);
End;
{ }
Procedure Biendoi2d(var P:point2d;M:mt2d);
var xt,yt,t:real;
Begin
xt:=P.x*m[1,1]+P.y*m[1,2]+m[1,3];

yt:=P.x*m[2,1]+P.y*m[2,2]+m[2,3];
t:=P.x*m[3,1]+P.y*m[3,2]+m[3,3];
P.x:=xt/t;P.y:=yt/t;
End;
{ }
Procedure Quay2d(goc:real;var MT:MT2d);
var af:real;
Begin
af:=goc*pi/180;
MT[1,1]:=Cos(af); MT[2,1]:=sin(af); MT[3,1]:=0;
MT[1,2]:=-mt[2,1];MT[2,2]:=MT[1,1]; MT[3,2]:=0;
MT[1,3]:=0; MT[2,3]:=0; MT[3,3]:=1;
End;
{ }
Procedure NhanMT2d(a,b:MT2d;var MT:MT2d);
var i,j,k:byte;
Begin
for i:=1 to 3 do for j:=1 to 3 do Mt[i,j]:=0;
for i:=1 to 3 do
for j:=1 to 3 do
for k:=1 to 3 do mt[i,j]:=mt[i,j]+a[k,j]*b[i,k];
End;
(******************{PHAN 3D}************************)
Procedure KTMT2D(var mt:MT2d);
var i,j:integer;
Begin
for i:=1 to 3 do for j:=1 to 3 do
if i<>j then mt[i,j]:=0 else mt[i,j]:=1;
End;
{ }

Procedure KTMT3D(var mt:MT3d);
var i,j:integer;
Begin
for i:=1 to 4 do for j:=1 to 4 do
if i<>j then mt[i,j]:=0 else mt[i,j]:=1;
End;
{ }
Procedure Biendoi3d(var P:point3d;M:mt3d);
var xt,yt,zt,t:real;
Begin
xt:=P.x*m[1,1]+P.y*m[1,2]+P.z*m[1,3]+m[1,4];
yt:=P.x*m[2,1]+P.y*m[2,2]+P.z*m[2,3]+m[2,4];
zt:=P.x*m[3,1]+P.y*m[3,2]+P.z*m[3,3]+m[3,4];
t:=P.x*m[4,1]+P.y*m[4,2]+P.z*m[4,3]+m[4,4];
P.x:=xt/t;P.y:=yt/t;P.z:=zt/t;
End;
{ }
Procedure Tinhtien3d(x,y,z:real;var MT:MT3d);
Begin
KtMT3D(mt);
mt[1,4]:=x;mt[2,4]:=y;mt[3,4]:=z;
End;
{ }
Procedure Quay3d(truc:char;goc:real;var MT:MT3d);
var af:real;
Begin
KTMT3d(mt);
af:=goc*pi/180;
if truc='z'then
begin mt[1,1]:=cos(af);mt[2,1]:=sin(af);

mt[1,2]:=-mt[2,1];mt[2,2]:=mt[1,1]; end;
if truc='x'then
begin mt[2,2]:=cos(af);mt[3,2]:=sin(af);
mt[2,3]:=-mt[3,2];mt[3,3]:=mt[2,2]; end;
if truc='y'then
begin mt[1,1]:=cos(af);mt[3,1]:=-sin(af);
mt[1,3]:=-mt[3,1];mt[3,3]:=mt[1,1]; end;
End;
{ }
Procedure NhanMT3d(a,b:MT3d;var MT:MT3d);
var i,j,k:byte;
t:mt3d;
Begin
for i:=1 to 4 do for j:=1 to 4 do t[i,j]:=0;
for i:=1 to 4 do
for j:=1 to 4 do
for k:=1 to 4 do t[i,j]:=t[i,j]+a[k,j]*b[i,k];
mt:=t;
End;
{ }
Procedure KhoitaoSongsong(g1,g2:real);
var d1,d2:real;
Begin
KTMT3d(par);d1:=-g1*pi/180;d2:=g2*pi/180;
Par[1,1]:=sin(d1);Par[2,1]:=-cos(d1)*sin(d2);
Par[1,2]:=Cos(d1);Par[2,2]:=sin(d1)*sin(d2);
Par[2,3]:=Cos(d2);Par[3,3]:=0;
End;
{ }
Procedure KhoitaoPhoicanh(x0,y0,z0,g1,g2,d:real);

var a,b,mt:MT3d;
Begin
KTMT3d(a);a[1,4]:=-x0;a[2,4]:=-y0;a[3,4]:=-z0;
{Quay3d('z',-90-g1,b);}Quay3d('z',90-g1,b); NhanMT3d(a,b,mt);
{Quay3d('x',-90+g2,a);}Quay3d('x',-90-g2,a);NhanMT3d(mt,a,mt);
KTMT3d(a);{a[3,3]:=-1;}a[1,1]:=-1;NhanMT3d(mt,a,mt);PerClip:=mt;
KTMT3d(a);a[4,3]:=1/d;a[4,4]:=0;NhanMT3d(mt,a,mt);
Per:=mt;
Tamchieu.x:=x0;Tamchieu.y:=y0;Tamchieu.z:=z0;
MPchieu.x:=g1*pi/180;MPchieu.y:=g2*pi/180;MPchieu.z:=d;
Zfront:=1;{Zback:=;}
ClipX:=1; ClipY:=1;
Cuaso2d(-d*clipX,-d*ClipY,d*ClipX,d*clipY);
End;
{ }
Procedure ChieuPC(P:point3d;var Pa:Point2d);
Begin
Biendoi3d(P,Per);
Pa.x:=P.x;Pa.y:=P.y;
End;
{ }
Procedure ChieuSS(P:point3d;var Pa:Point2d);
Begin
Biendoi3d(P,Par);
Pa.x:=P.x;Pa.y:=P.y;
End;
{ }
Function giao(p1,p2:point3d;A,B,C,D:real;var P0:point3d):boolean;
var mau:real;
Begin

mau:=A*(P2.x-P1.x)+B*(P2.y-P1.y)+C*(P2.z-P1.z);
if mau<>0 then
begin Giao:=true;
P0.x:=(B*(P2.y*P1.x-P1.y*P2.x)+C*(P2.z*P1.x-P1.z*P2.x)-D*(P2.x-P1.x))/mau;
P0.y:=(C*(P2.z*P1.y-P1.z*P2.y)+A*(P2.x*P1.y-P1.x*P2.y)-D*(P2.y-P1.y))/mau;
P0.z:=(A*(P2.x*P1.z-P1.x*P2.z)+B*(P2.y*P1.z-P1.y*P2.z)-D*(P2.z-P1.z))/mau;
end else giao:=false;
End;
{ }
Function Cohen3D(var p1,p2:point3D):Boolean;
var ma1,ma2,mtg:integer;
dx,dy,dz:real;
kq:boolean;p0:point3d;
dao:boolean;
Procedure Tinhma(P:point3D;var ma:integer);
begin ma:=0;
if P.z<Zfront then ma:=ma+1;
{ if p.z>Zback then ma:=ma+2;}
if P.y> P.z*ClipY then ma:=ma+4;
if P.y<-P.z*ClipY then ma:=ma+8;
if P.x> P.z*ClipX then ma:=ma+16;
if P.x<-P.z*ClipX then ma:=ma+32;
end;
Begin kq:=false;dao:=false;
While kq=false do
Begin
Tinhma(p1,ma1);Tinhma(p2,ma2);
dx:=p2.x-p1.x;dy:=p2.y-p1.y;dz:=p2.z-p1.z;
if (ma1 or ma2)=0 then
begin kq:=true;cohen3d:=true;if dao then begin p0:=p1;p1:=p2;p2:=p0;end;exit;end;

if (ma1 and ma2)<>0 then begin kq:=true;cohen3d:=false;exit;end;
if ma1=0 then
begin mtg:=ma1;ma1:=ma2;ma2:=mtg;
p0:=p1;p1:=p2;p2:=p0;dao:=not dao;
dx:=-dx;dy:=-dy;dz:=-dz;end;
if (ma1 div 32)<>0 then
giao(p2,p1,1,0,clipX,0,p0){x=-z.ClipX}
else
if ((ma1 mod 32)div 16)<>0 then
giao(p2,p1,1,0,-clipX,0,p0){x=+z.ClipX}
else
if (((ma1 mod 32)mod 16)div 8)<>0 then
giao(p2,p1,0,1,clipY,0,P0) {y=-z.ClipY}
else
if ((((ma1 mod 32)mod 16)mod 8)div 4)<>0 then
giao(p2,p1,0,1,-clipY,0,P0) {y=z.ClipY}
else
{ if (((((ma1 mod 32)mod 16)mod 8)mod 4)div 2)<>0 then
{z=Zback}
if (ma1 mod 2)<>0 then giao(p2,p1,0,0,1,-zfront,P0); {z=Zfront}
P1:=P0;
End;
End;
{ }
Function PerClipLine(p1,p2:Point3d;var q1,q2:Point2d):boolean;
var a:mt3d;
Begin PerClipLine:=false;
Biendoi3d(P1,PerClip);Biendoi3d(P2,PerClip);
if cohen3D(p1,p2)then
begin KTMT3d(a);a[4,3]:=1/MPchieu.z;a[4,4]:=0;

biendoi3d(p1,a);biendoi3d(p2,a);
Q1.x:=p1.x;Q1.y:=p1.y;Q2.x:=p2.x;Q2.y:=P2.y;
biendoi2d(q1,Twv);biendoi2d(q2,Twv);
PerclipLine:=true;
end;
End;
{ }
Procedure ClipPoly(np:integer;P:array of point3d;var nd:integer;var DG:array of
pointtype);
var G:point3d;mt:MT3d;
Q:array[0 18]of point3d;
nq,i:integer; e:point2d;
Begin
for i:=1 to np do biendoi3d(p[i],perclip);
P[np+1]:=p[1];nq:=0;
for i:=1 to np do
begin {P.z<Zfront}
if p[i].z>=Zfront then begin nq:=nq+1;Q[nq]:=P[i];if i=1 then write(1);end;
if ((P[i].z>Zfront)and(P[i+1].z<Zfront))or((P[i].z<Zfront)and(P[i+1].z>Zfront))
then begin
giao(p[i+1],p[i],0,0,1,-zfront,G);nq:=nq+1;Q[nq]:=G;
end;
end;
np:=nq;for i:=1 to np do p[i]:=q[i];nq:=0;P[np+1]:=p[1];
for i:=1 to np do
begin {y=z*ClipY}
if P[i].y<=P[i].z*ClipY then begin nq:=nq+1;Q[nq]:=P[i];if i=1 then write(2);end;
if ((P[i].y<P[i].z*ClipY)and(P[i+1].y>P[i+1].z*ClipY))
or((P[i].y>P[i].z*ClipY)and(P[i+1].y<P[i+1].z*ClipY))
then begin giao(p[i+1],p[i],0,1,-clipY,0,G);nq:=nq+1;Q[nq]:=G;end;

end;
np:=nq;for i:=1 to np do p[i]:=q[i];nq:=0;P[np+1]:=p[1];
for i:=1 to np do
begin {y:=-z*clipY}
if P[i].y>=-P[i].z*ClipY then begin nq:=nq+1;Q[nq]:=P[i];if i=1 then write(3);end;
if ((P[i].y<-P[i].z*ClipY)and(P[i+1].y>-P[i+1].z*ClipY))
or((P[i].y>-P[i].z*ClipY)and(P[i+1].y<-P[i+1].z*ClipY))
then begin giao(p[i+1],p[i],0,1,clipY,0,G);nq:=nq+1;Q[nq]:=G;end;
end;
np:=nq;for i:=1 to np do p[i]:=q[i];nq:=0;P[np+1]:=p[1];
for i:=1 to np do
begin {x:=z*clipX}
if P[i].x<=P[i].z*ClipX then begin nq:=nq+1;Q[nq]:=P[i];if i=1 then write(4);end;
if ((P[i].x<P[i].z*ClipX)and(P[i+1].x>P[i+1].z*ClipX))
or((P[i].x>P[i].z*ClipX)and(P[i+1].x<P[i+1].z*ClipX))
then begin giao(p[i+1],p[i],1,0,-clipX,0,G);nq:=nq+1;Q[nq]:=G;end;
end;
np:=nq;for i:=1 to np do p[i]:=q[i];nq:=0;P[np+1]:=p[1];
for i:=1 to np do
begin {x:=-z*clipX}
if P[i].x>=-P[i].z*ClipX then begin nq:=nq+1;Q[nq]:=P[i];if i=1 then write(5);end;
if ((P[i].x<-P[i].z*ClipX)and(P[i+1].x>-P[i+1].z*ClipX))
or((P[i].x>-P[i].z*ClipX)and(P[i+1].x<-P[i+1].z*ClipX))
then begin giao(p[i+1],p[i],1,0,clipX,0,G);nq:=nq+1;Q[nq]:=G;end;
end;
np:=nq;for i:=1 to np do p[i]:=q[i];nq:=0;
KTMT3d(mt);mt[4,3]:=1/MPchieu.z;mt[4,4]:=0;
for i:=1 to np do
begin biendoi3d(p[i],mt);
e.x:=P[i].x;e.y:=p[i].y;

biendoi2d(e,Twv);
DG[i].x:=round(e.x); DG[i].y:=round(e.y);
end;nd:=np;
End;
{ }
{ }
BEGIN
END.
program duongbachieu;
uses crt,graph;
type
point_2d = record
x,y:real;
end;
point_3d = record
x,y,z:real;
end;
const g:real=pi/4;
var
m,n:integer;
cgx,cgy,x,y,z,t,b,xgoc,ygoc:real;
p1,p2:point_2d;
p3:point_3d;
xmin:real ;
ymin: real ;
zmin: real ;
xmax:real ;
ymax:real ;
zmax:real ;
maxx:integer;

maxy:integer ;
procedure c3_2(p:point_3d;var q:point_2d);
begin
q.x:=p.x +p.z*cos(g);
q.y:=p.y+p.z*sin(g);
end;
procedure wtv(p:point_2d;var q:point_2d);
begin
q.x:=p.x*cgx;
q.y:=p.y*cgy;
end;
procedure vts(p:point_2d; var q:point_2d);
begin
q.x:=xgoc+p.x;
q.y:=ygoc-p.y;
end;
procedure hetruc;
begin
setlinestyle(1,0,1);
line(round(xgoc),0,round(xgoc),getmaxy);
line(0,round(ygoc),getmaxx,round(ygoc));
line(0,round(ygoc+xgoc),639,round(ygoc+xgoc)-639);
setlinestyle(0,0,1);
end;
procedure bp(t:real;var p:point_3d);
begin
p.x:=sin(t);p.y:=cos(t);p.z:=sin(t)*cos(t);
end;
begin
clrscr;

m:=0;
initgraph(m,n,'d:\bp\bgi');
maxx:=getmaxx;
maxy:=getmaxy;
b:=2*pi/360;
xmin:=-1;
xmax:=1;
ymin:=-1;
ymax:=1;
zmin:=-1/2;
zmax:=1/2;
{Thu nho }
xmin:=xmin+zmin*sin(g);
xmax:=xmax+zmax*cos(g);
ymin:=ymin+zmin*sin(g);
ymax:=ymax+zmax*sin(g);
{ if xmin>0 then xmin:=0;
if ymin>0 then ymin:=0;
if xmax<0 then xmax:=0;
if ymax<0 then ymax:=0;}
cgx:=maxx/(xmax-xmin);
cgy:=maxy/(ymax-ymin);
xmin:=cgx*xmin;
xmax:=cgx*xmax;
ymin:=cgy*ymin;
ymax:=cgy*ymax;
xgoc:=0;
if xgoc>xmin then xgoc:=round(abs(xmin));
ygoc:=0;
if ygoc<ymax then ygoc:=round(abs(ymax));

hetruc;
t:=0;
bp(t,p3);
c3_2(p3,p1);;
wtv(p1,p2);
p1:=p2;
vts(p2,p2);
moveto(round(p2.x),round(p2.y));
repeat
bp(t,p3);
c3_2(p3,p1);
wtv(p1,p2);
p1:=p2;
vts(p2,p2);
lineto(round(p2.x),round(p2.y));
t:=t+b;
until t>2*pi+b;
readln;
closegraph;
end.
uses graph,dhmt,crt;
type
Pie=record
p:array[1 4]of Point2d;
x,y,g:integer;
end;
Var
DG:array[1 200]of Pie;
nd,cur,nx,ny,kc:integer;
x0,y0:integer;

ch:char;
{ }
Procedure Khoitao;
var rx,ry,i,j:integer;
P:array[1 200]of point2d;
Begin
kc:=50; nx:=4; ny:=3; nd:=ny*nx;x0:=200;y0:=300;
for i:=0 to nx do for j:=0 to ny do
begin if (i mod nx<>0)and(j mod ny<>0)then
begin rx:=random(kc)-(kc div 2);ry:=random(kc)-(kc div 2);end
else begin rx:=0;ry:=0;end;
P[j*(nx+1)+i+1].x:=x0+i*kc+rx;
P[j*(nx+1)+i+1].y:=y0-j*kc+ry;
end;
for i:=1 to nd do
begin
dg[i].P[1]:=P[ i+((i-1)div nx)];
dg[i].P[2]:=P[1+i+((i-1)div nx)];
dg[i].P[3]:=P[2+i+((i-1)div nx)+nx];
dg[i].P[4]:=P[1+i+((i-1)div nx)+nx];
dg[i].x:=0;dg[i].y:=0;dg[i].g:=0;
end;
End;
{ }
Procedure Ve(tt:integer);
var i,j:integer;
Q:array[1 5]of pointtype;
Begin
if tt<>0 then begin setcolor(14);setfillstyle(1,3);end
else begin setcolor(0);setfillstyle(1,0);end;

for i:=1 to nd do
begin
for j:=1 to 4 do begin q[j].x:=round(dg[i].P[j].x);q[j].y:=round(dg[i].P[j].y);end;
q[5]:=q[1];fillpoly(4,q);drawpoly(5,q);
end;
if tt<>0 then
begin setcolor(14);setfillstyle(1,11);
for j:=1 to 4 do begin q[j].x:=round(dg[tt].P[j].x);q[j].y:=round(dg[tt].P[j].y);end;
q[5]:=q[1];fillpoly(4,q);drawpoly(5,q);
end;
setcolor(15);rectangle(x0,y0,x0+nx*kc,y0-ny*kc);
End;
{ }
Procedure Tinhtien(tt,huong:integer);
var mt:mt2d;
delta,i:byte;
Begin
ktmt2d(mt);delta:=20;
case (huong mod 5) of
1:begin mt[1,3]:=delta; dg[tt].x:=dg[tt].x+delta;end;
2:begin mt[1,3]:=-delta;dg[tt].x:=dg[tt].x-delta;end;
3:begin mt[2,3]:=delta; dg[tt].y:=dg[tt].y+delta;end;
4:begin mt[2,3]:=-delta;dg[tt].y:=dg[tt].y-delta;end;
end;
for i:=1 to 4 do biendoi2d(dg[tt].P[i],mt);
End;
{ }
Procedure Quay(tt,goc:integer);
var mt:mt2d;
c,s:real;

x,y:real; j:integer;
Begin
x:=dg[tt].P[1].x;y:=dg[tt].P[1].y;
ktmt2d(mt);mt[1,3]:=-x;mt[2,3]:=-y;
for j:=1 to 4 do biendoi2d(dg[tt].P[j],mt);
case goc of
1:begin c:=sqrt(2)/2;s:=c; with dg[tt] do if g<315 then g:=g+45 else g:=0;end;
2:begin c:=sqrt(2)/2;s:=-c;with dg[tt] do if g>0 then g:=g-45 else g:=315;end;
end;
ktmt2d(mt); mt[1,1]:=c;mt[2,1]:=s;mt[1,2]:=-s;mt[2,2]:=c;
for j:=1 to 4 do biendoi2d(dg[tt].P[j],mt);
ktmt2d(mt);mt[1,3]:=x;mt[2,3]:=y;
for j:=1 to 4 do biendoi2d(dg[tt].P[j],mt);
End;
{ }
Procedure Tanvo;
var i,j,h,v:integer;
Begin h:=nx*kc;v:=ny*kc;
Setfillstyle(1,3);bar(x0,y0,x0+h,y0-v);
setcolor(15+blink);settextstyle(0,0,1);settextjustify(1,0);
outtextxy(x0+(h div 2),y0-v+16,'Vo chong cai nhau:');
setcolor(12);settextstyle(4,0,4);settextjustify(1,0);
outtextxy(x0+(h div 2),y0-(v div 2),'HANH PHUC');
delay(2000);readln;
for i:=1 to nd do
for j:=1 to random(10) do
begin ve(0);tinhtien(i,random(i)+1);tinhtien(i,random(i)
+2);quay(i,random(1)+1);ve(i);delay(100); end;
End;
{ }

Function ketqua:boolean;
var i:integer;h,v:integer;
Begin
ketqua:=true;
for i:=1 to nd do
if (dg[i].x<>0)or(dg[i].y<>0)or(dg[i].g<>0)then
begin ketqua:=false;exit;end;
h:=nx*kc;v:=ny*kc;setcolor(3);
for i:=1 to v div 2 do
begin rectangle(x0+i,y0-i,x0+h-i,y0-v+i);delay(10);end;
setcolor(12);settextstyle(4,0,4);settextjustify(1,0);
outtextxy(x0+(h div 2),y0-(v div 2),'Hanh phuc');
setcolor(15+blink);settextstyle(0,0,1);settextjustify(1,0);
outtextxy(x0+(h div 2),y0,'Tiep tuc cai nhau(c/k)?:');
End;
{ }
BEGIN randomize;directvideo:=false;
Khoitaodohoa('c:\tp\bgi');
khoitao;Tanvo;cur:=1;ve(cur);
Repeat
ch:=readkey;ve(0);
case ch of
#72:tinhtien(cur,4);
#80:tinhtien(cur,3);
#75:tinhtien(cur,2);
#77:tinhtien(cur,1);
#71:if cur>1 then cur:=cur-1 else cur:=nd;
#79:if cur<nd then cur:=cur+1 else cur:=1;
#83:begin Quay(cur,1);gotoxy(10,1);write(dg[cur].g:4);end;
#81:begin Quay(cur,2);gotoxy(10,1);write(dg[cur].g:4);end;

end;
ve(cur);
if ketqua then
begin ch:=readkey;if (ch='k')or (ch='K')then ch:=#27 else tanvo;end;
Until ch=#27;
closegraph;
END.
Unit Gmenu;
Interface
uses crt,graph,minh3,mouses;
const Deep=16;
Type
Mdeep=array[0 Deep]of byte;{0:vitri me,1 deep:vitri Item theo do sau}
var MenuFlag:boolean;
MaMenu:integer;
Procedure Getmenu;
Procedure menubar;
Procedure Show1Item(vt:mdeep;tt:byte);
Procedure Show1Menu(vt:Mdeep);
Procedure Showmenu(cur:Mdeep);
Procedure InitMenu(x,y:integer);
Procedure Keytrap;
{Procedure InitMenu(x,y:integer);
Procedure LuachonMenu;}
Implementation
Type
MIpoint=^MenuItem;
MenuItem=Record
Name:string;
att:byte;

scut1,scut2:byte;
Ma:integer;
down,right:Mipoint;
End;
MEpoint=^Menu;
Menu=Record
Name:string;
Phantu:byte;
Shortcut:byte;
Down:Mipoint;