Website: http://www.docs.vn Email :
[email protected] Tel (: 0918.775.368
b¸o c¸o bµi tËp lín m«n ®å ho¹
§Ò tµi II
I/ Giíi thiÖu ®Ò tµi:
§å ho¹ m¸y tÝnh lµ mét trong c¸c lÜnh vùc mµ ngµnh tin häc quan t©m vµ ®· ®îc
®a vµo ch¬ng tr×nh ®µo t¹o chÝnh kho¸ cho ngµnh tin häc t¹i c¸c trêng §¹i häc. Néi
dung chñ yÕu cña m«n häc lµ nghiªn cøu c¸c thuËt to¸n, c¸c kü thuËt vÏ h×nh trªn m¸y
tÝnh, gióp sinh viªn cã thÓ x©y dùng c¸c phÇn mÒm vÒ ®å ho¹ m¸y tÝnh.
Lµ sinh viªn Cao ®¼ng tin häc, chóng em còng ®îc tiÕp xóc lµm quen víi mét sè
kü thuËt ®å ho¹ trªn m¸y vi tÝnh th«ng qua c¸c bµi gi¶ng vµ gi¸o tr×nh do Thµy D¬ng
ViÕt Th¾ng biªn so¹n. Víi kiÕn thøc cßn nhiÒu h¹n chÕ nªn ë ®Ò tµi nµy môc tiªu cña
chóng em chñ yÕu lµ vËn dông mét sè kiÕn thøc häc ®îc ®a vµo vËn dông thùc tÕ th«ng
qua bµi tËp lín.
Trong phÇn Nh÷ng bµi tËp lín §å ho¹, nhãm chóng em thùc hiÖn ®Ò II bao gåm
c¶ §å ho¹ ph¼ng vµ §å ho¹ kh«ng gian. Néi dung ®Ò tµi cô thÓ gåm:
§å ho¹ ph¼ng:
1. VÏ ®å thÞ hµm bËc ba / bËc nhÊt lªn cöa sæ (c1,h1,c2,h2).
2. VÏ ®å thÞ hµm sè theo tham sè x=f1(t), y=f2(t) lªn cöa sæ (c1,h1,c2,h2). (*)
3. VÏ ®å thÞ hµm sè ®éc cùc r=f() lªn cöa sæ (c1,h1,c2,h2). (*)
4. VÏ h×nh sao n c¸nh tù quay quanh t©m lªn cöa sæ (c1,h1,c2,h2). (*)
§å ho¹ kh«ng gian:
1. VÏ khèi ®a diÖn ®Òu cã ph©n biÖt nÐt khuÊt.
Trong ®Ò tµi, cã mét sè môc ®¸nh dÊu (*) chóng em kh«ng gi¶i thÝch cßn l¹i
phÇn gi¶i thÝch cña chóng em kÌm sau mçi thñ tôc cña ch¬ng tr×nh. Trong b¸o c¸o nµy
chóng em cã m« t¶ c¸c thñ tôc vÏ b»ng mét sè h×nh ¶nh minh ho¹ cho thªm phÇn sinh
®éng ( H×nh ¶nh minh ho¹ ë cuèi b¸o c¸o).
II/ Unit ch¬ng tr×nh:
Unit UnitDT2;
Interface
Var c,h,d,C1,h1,c2,m,h2,Co,Ho,Xn,Yn,R2,R1,mau,goc:Integer;
X0,DE,Y0,x2,x1,y2,y1:Real;
XA,YA,ZA, XB,YB,ZB, XC,YC,ZC,
XD,YD,ZD,Xe,Ye,Ze,Xf,Yf,Zf,Xg,Yg,Zg,Xh,Yh,Zh:REAL;
Phi,Theta,t,Tmax,Rho,Kx,Ky,R3,RR3,a,b,cx,E,Anfa,Beta,ax,bx:Real;
ch:char;
stv ,Td:String;
Procedure MhDoHoa;
Procedure
Chu_Bong(c,h,Font,Huong,KThuoc,Mauc,Maub,v:Integer;Tde:string);
Procedure Beep;
Procedure Chu_Chay;
Procedure About;
Procedure Gwrite(Var c,h:Integer;St:String);
Procedure Gwriteln(Var c,h:Integer;St:String);
Procedure Gread(Var c,h:Integer;Var luu:String);
Procedure Greadln(Var c,h:Integer;Var luu:String);
Procedure Cuaso(C1,H1,C2,H2,Mau_tr,Mau_d,Mau_n,V:Integer);
Procedure Menu_doc(K:Integer);
Procedure Menu_Ngang(K:Integer);
Procedure Projec(x,y,z:real;Var XProj,YProj:real);
Procedure KGMoveto(x,y,z:real);
Procedure KGPutPixel(x,y,z:real;color:byte);
Procedure KGLineto(x,y,z:real;Color:byte);
Procedure KGLine(x1,y1,z1,x2,y2,z2:real;color:byte);
Procedure KG_WriteXYZ(X,Y,Z:real;St:String;color:byte);
Procedure Vetruc(D:integer;Color:byte);
1
Procedure
Procedure
Procedure
Procedure
Procedure
Procedure
Procedure
ProjecP(x,y,z:real;Var XProj,YProj:real);
KGMovetoP(x,y,z:real);
KGPutPixelP(x,y,z:real;color:byte);
KGLinetoP(x,y,z:real;Color:byte);
KGLineP(x1,y1,z1,x2,y2,z2:real;color:byte);
KG_WriteXYZP(X,Y,Z:real;St:String;color:byte);
VetrucP(D:integer;Color:byte);
Implementation
Uses Crt,graph;
Procedure
MhDoHoa;
var Gd,Gm,ktra:integer;
Path:String;
Begin
Path:='c:\Tp\Bgi';
Repeat
Gd:=detect; InitGraph(Gd,Gm,Path);
Ktra:=GraphResult;
If Ktra <> 0 then
Begin
Write('Loi do hoa! Go lai Path, Neu quen thi
Enter!');
Readln(Path);
if Path='' then Halt(1);
end;
Until Ktra=0;
end;
{**********************}
Procedure
Chu_Bong(c,h,Font,Huong,KThuoc,Mauc,Maub,v:Integer;Tde:string);
Var I:Integer;
Begin
SetTextStyle(Font,Huong,Kthuoc);
SetColor(Maub);
for i:=1 to v do
OutTextXY(C+i,H-i,Tde);
SetColor(Mauc);OutTextXY(c,h,Tde);
end;
{******************************}
Procedure
Beep;
Begin
Sound(450);
Delay(100);
Nosound;
end;
{***********************************}
Procedure
Chu_Chay;
var cc,cc1:Integer;
St,st1:String;
Ch:Char;
Begin
Cc:=1;Cc1:=cc-340;
St:='Chuong trinh do nhom G2 thuc hien <-> ';
St1:='Giao vien huong dan: Duong Viet Thang <->';
Repeat
SetColor(15);
OutTextXY(cc,470,St);
SetColor(10);
OutTextXY(cc1,470,St1);
2
Delay(100);
SetColor(0);
OutTextXY(cc,470,St);
OutTextXY(cc1,470,St1);
Cc:=Cc+5;
Cc1:=Cc1+5;
If Cc>= 640 then Cc:=1;
If Cc1>= 640 then Cc1:=1;
Until KeyPressed;
end;
{***********************************}
Procedure
AboutNen;
Begin
C1:=10;H1:=10;H2:=470;
Cuaso(c1,h1,C1+620,H1+450,15,7,9,5);
{
Chu_Bong(c1+50,h1,8,0,5,Lightred,cyan,5,'TRUONG DHBK HA NOI');
Chu_Bong(C1+190,h1+50,8,0,4,Lightred,cyan,4,'KHOA CNTT');}
Chu_Bong(C1+90,h1+30,7,0,4,14,cyan,3,'BAI TAP LON MON');
Chu_Bong(C1+260,h1+80,7,0,4,14,cyan,3,'KY THUAT DO HOA');
Chu_Bong(C1+50,H1+170,4,0,4,10,lightred,3,'GIAO VIEN: DUONG VIET
THANG');
Chu_Bong(c1+10,h1+230,7,0,4,10,lightred,3,'THUC HIEN: NHOM G2');
Chu_Bong(C1+280,H1+250,15,0,4,14,cyan,2,'');
cuaso(c1+228,h1+280,c1+410,h1+412,15,8,lightblue,6);
SetColor(10);OutTextxy(C1+200,H1+430,'PRESS ENTER TO RETURN
MAINMENU');
OutTextXY(C1+240,H1+300,'1.DAO VAN DAT (CAP)');
OutTextXY(C1+240,H1+320,'2.NGUYEN CAO DAI');
OutTextXY(C1+240,H1+340,'3.TRINH BUI CHUNG');
OutTextXY(C1+240,H1+360,'4.DINH MINH DUC');
OutTextXY(C1+240,H1+380,'5.TRUONG CONG CHUONG');
End;
{**********************************}
Procedure
About;
Begin
ClearDevice;
SetBkColor(0);
Beep;
Delay(50);
Beep;
AboutNen;
Chu_Chay;
Readln;
ClearDevice;
end;
{*****************************}
Procedure Gwrite(Var c,h:Integer;St:String);
Begin
OutTextxy(c,h,st);
C:=c+TextWidth(st);
end;
{*************************************}
Procedure Gwriteln(Var c,h:Integer;St:String);
Var L:Integer;
Begin
L:=10;
OutTextxy(c,h,st);
c:=L;
h:=h+TextHeight('A')+10;
end;
{*********************************}
Procedure Gread(Var c,h:Integer;Var luu:String);
3
Var ch:char;
Begin
Ch:=' ';
Luu:=' ';
repeat
Ch:=readkey;
If ch<> #13 then
begin
Gwrite(c,h,ch);
luu:=luu+ch;
end;
Until ch=#13;
End;
{*********************************}
Procedure Greadln(Var c,h:Integer;Var luu:String);
Var ch:char;
Begin
Ch:=' ';
Luu:=' ';
repeat
Ch:=readkey;
If ch<> #13 then
begin
Gwrite(c,h,ch);
luu:=luu+ch;
end;
Until ch=#13;
C:=10;
h:=h+10;
end;
{*********************************}
Procedure Cuaso(C1,H1,C2,H2,Mau_tr,Mau_d,Mau_n,V:Integer);
Var I:integer;
Begin
For I:=1 to v do
Begin
SetColor(Mau_tr);
Line(C1+i,H1+i,C2-i,H1+i);
Line(C1+i,H1+i,C1+i,H2-i);
SetColor(Mau_d);
Line(C1+i,H2-i,C2-i,H2-i);
Line(C2-i,H2-i,C2-i,H1+i);
end;
{Ve Nen }
setFillStyle(1,Mau_n);
Bar(C1+v,H1+V,C2-V,H2-V);
End;
{**************************}
Procedure Menu_Ngang(K:Integer);
Var Ten_Muc:array[1..3] of string;
I,Rong,Cao,a,b:integer;
Begin
Ten_Muc[1]:='
Program';
Ten_Muc[2]:='
About ';
Ten_Muc[3]:='
Quit';
a:=20;b:=20;Rong:=200;Cao:=30;
For i:=1 to 3 do
Begin
If i=k then CuaSo(a+(i-1)*Rong,b,a+i*rong,b+Cao,8,15,7,4)
Else
CuaSo(a+(i-1)*Rong1,b,a+i*Rong,b+Cao,15,8,7,4);
4
SetColor(14);
OutTextxy(a+(i-1)*rong+10,b+10,Ten_Muc[i]);
End;
End;
{*******************************}
Procedure Menu_doc(K:Integer);
Var Ten_Muc:array[1..6] of string;
I,Rong,Cao,a,b:integer;
Begin
Ten_Muc[1]:='Do thi bac3/bac1';
Ten_Muc[2]:='Do thi tham so';
Ten_Muc[3]:='Do thi do cuc';
Ten_Muc[4]:='Round Star';
Ten_Muc[5]:='Da dien deu';
a:=20;b:=50;Rong:=150;Cao:=30;
For i:=1 to 5 do
Begin
If i=k then CuaSo(a,b+(I1)*Cao,a+Rong,b+i*Cao,8,white,3,4)
Else
CuaSo(a,b+(i-1)*Cao-1,a+Rong,b+i*Cao,15,8,9,4);
SetColor(10);
OutTextxy(a+10,b+(i-1)*Cao+10,Ten_Muc[i]);
End;
End;
Procedure Projec(x,y,z:real;Var XProj,YProj:real);
Var Xobs,Yobs,Zobs:real;
Aux1,Aux2,Aux3,Aux4,Aux5,Aux6,Aux7,Aux8:real;
th,ph:real;
Begin
th:=Pi*theta/180;
Ph:=Pi*Phi/180;
Aux1:=sin(th);
Aux2:=sin(ph);
Aux3:=cos(th);
Aux4:=cos(ph);
Aux5:=Aux3*Aux2;
Aux6:=Aux1*Aux2;
Aux7:=Aux3*Aux4;
Aux8:=Aux1*Aux4;
XObs:=-x*Aux1+Y*Aux3;
YObs:=-x*Aux5-Y*Aux6+Z*Aux4;
ZObs:=-x*Aux7-Y*Aux8-Z*Aux2+Rho;
If ZObs<>0 then
begin
XProj:=DE*XObs/ZObs;
YProj:=DE*YObs/ZObs;
end else
begin
XProj:=DE*XObs/0.000001;
YProj:=DE*YObs/0.000001;
end
End;
(*-----------------------------------*)
Procedure KGMoveto(x,y,z:real);
Var Xp,Yp:Real;c,h:integer;
Begin
Projec(x,y,z,Xp,Yp);
C:=CO+round(Xp*Kx);
H:=HO-round(Yp*Ky);
5
moveto(C,H);
End;
Procedure KGPutPixel(x,y,z:real;color:byte);
Var Xp,Yp:Real;c,h:integer;
Begin
Projec(x,y,z,Xp,Yp);
C:=Co+round(Xp*Kx);
H:=Ho-round(Yp*Ky);
PutPixel(C,H,color);
End;
Procedure KGLineto(x,y,z:real;Color:byte);
Var Xp,Yp:Real;c,h:integer;
Begin
SetColor(color);
Projec(x,y,z,Xp,Yp);
C:=Co+round(XP*Kx);
H:=Ho-round(YP*Ky);
lineto(C,H);
End;
Procedure KGLine(x1,y1,z1,x2,y2,z2:real;color:byte);
Begin
KgMoveto(x1,y1,z1);
KgLineto(x2,y2,z2,color);
End;
Procedure KG_WriteXYZ(X,Y,Z:real;St:String;color:byte);
Var Xp,Yp:Real;c,h:integer;
Begin
Projec(x,y,z,Xp,Yp);
C:=Co+round(XP*Kx);
H:=Ho-round(YP*Ky);
SetColor(color);
OutTextxy(c,h,St);
End;
Procedure Vetruc(D:integer;Color:byte);
Begin
KgMoveto(0,0,0);KgLineto(D,0,0,color);KG_Writexyz(D,0,0,'X',color);
KgMoveto(0,0,0);KgLineto(0,D,0,color);KG_Writexyz(0,D,0,'Y',color);
KgMoveto(0,0,0);KgLineto(0,0,D,color);KG_Writexyz(0,0,D,'Z',color);
End;
(*---------Chieu song song---------------*)
Procedure ProjecP(x,y,z:real;Var XProj,YProj:real);
Var Xobs,Yobs,Zobs:real;
Aux1,Aux2,Aux3,Aux4,Aux5,Aux6,Aux7,Aux8:real;
th,ph:real;
Begin
th:=Pi*theta/180;
Ph:=Pi*Phi/180;
Aux1:=sin(th);
Aux2:=sin(ph);
Aux3:=cos(th);
Aux4:=cos(ph);
Aux5:=Aux3*Aux2;
Aux6:=Aux1*Aux2;
Aux7:=Aux3*Aux4;
Aux8:=Aux1*Aux4;
XObs:=-x*Aux1+Y*Aux3;
6
YObs:=-x*Aux5-Y*Aux6+Z*Aux4;
ZObs:=-x*Aux7-Y*Aux8-Z*Aux2+Rho;
XProj:=XObs;
YProj:=YObs;
End;
(*-----------------------------------*)
Procedure KGMovetoP(x,y,z:real);
Var Xp,Yp:Real;c,h:integer;
Begin
ProjecP(x,y,z,Xp,Yp);
C:=Co+round(Xp*Kx);
H:=Ho-round(Yp*Ky);
moveto(C,H);
End;
Procedure KGPutPixelP(x,y,z:real;color:byte);
Var Xp,Yp:Real;c,h:integer;
Begin
ProjecP(x,y,z,Xp,Yp);
C:=Co+round(Xp*Kx);
H:=Ho-round(Yp*Ky);
PutPixel(C,H,color);
End;
Procedure KGLinetoP(x,y,z:real;Color:byte);
Var Xp,Yp:Real;c,h:integer;
Begin
SetColor(color);
ProjecP(x,y,z,Xp,Yp);
C:=Co+round(XP*Kx);
H:=Ho-round(YP*Ky);
lineto(C,H);
End;
Procedure KGLineP(x1,y1,z1,x2,y2,z2:real;color:byte);
Begin
KgMovetoP(x1,y1,z1);
KgLinetoP(x2,y2,z2,color);
End;
Procedure KG_WriteXYZP(X,Y,Z:real;St:String;color:byte);
Var Xp,Yp:Real;c,h:integer;
Begin
ProjecP(x,y,z,Xp,Yp);
C:=Co+round(XP*Kx);
H:=Ho-round(YP*Ky);
SetColor(color);
OutTextxy(c,h,St);
End;
Procedure VetrucP(D:integer;Color:byte);
Begin
KgMovetoP(0,0,0);KgLinetoP(D,0,0,color);KG_WritexyzP(D,0,0,'X',white);
KgMovetoP(0,0,0);KgLinetoP(0,D,0,color);KG_WritexyzP(0,D,0,'Y',white);
KgMovetoP(0,0,0);KgLinetoP(0,0,D,color);KG_WritexyzP(0,0,D,'Z',white);
End;
{*******************Het*Unit**************}
7
End.
III/Chuong trinh chÝnh:
Program
Detai2;
Uses Crt,dos,Graph,UnitDT2;
Const MaxDinh=50;
MaxMat=30;
MaxCanh=12;
D_goc=5;
D_Rho=1;
D_DE=20;
const
days : array [0..6] of String[9] =
('Sunday','Monday','Tuesday',
'Wednesday','Thursday','Friday',
'Saturday');
Type chieu=(VuongGoc,PhoiCanh);
Var
St:Array[1..MaxDinh,1..3] of Real;
Fc:Array[1..MaxMat,0..MaxCanh] of Integer;
O1,O2,O3:Real;
NF:integer;
Net_Khuat:Boolean;
PhepChieu:Chieu;
Ttn,n:integer;
yy, mm, dd, dow : Word;
hg, mp, sg, hund : Word;
function LeadingZero(w : Word) : String;
Var s : String;
begin
Str(w:0,s);
if Length(s) = 1 then
s := '0' + s;
LeadingZero := s;
end;
Procedure Gio1;
Var S,Stg,Stp,Stgi:String;
Begin
GetTime(hg,mp,sg,hund);str(hg,stg);Str(Mp,stp);Str(Sg,Stgi);
Setcolor(15);
OutTextXY(400,450,Stg+':'+stp+':'+Stgi);
end;
Procedure GetDate1;
Var
Stm,Std,sty:String;
So:Integer;
Day:String;
begin
GetDate(yy,mm,dd,dow);
Str(mm,stm);
Setcolor(15);
Day:=days[dow];Str(dd,std);Str(yy,sty);
OutTextXY(470,450,Day+','+stm+'/'+Std+'/'+Sty);
End;
{************Cac thu tuc ve sao***********************}
Procedure VeSao(c,h,R2,R1,n,goc,mau:integer);
Var x2,y2,x1,y1:array[1..20] of real;
Dgoc,ggoc:real;
i,cc,hh:integer;
Begin
Dgoc:=2*Pi/n;
{Delta goc}
ggoc:=goc/180*Pi; {Doi goc thanh Radian}
For i:=1 to n+1 do
8
begin
x2[i]:=R2*cos(ggoc+(i-1)*DGoc);
y2[i]:=R2*sin(ggoc+(i-1)*DGoc);
x1[i]:=R1*cos(ggoc+Pi/n+(i-1)*DGoc);
y1[i]:=R1*sin(ggoc+Pi/n+(i-1)*DGoc);
end;
cc:=c+round(x2[1]*Kx);
hh:=h-round(y2[1]*Ky);
moveto(cc,hh); {Xuat phat tu dinh ngoai so 1}
SetColor(mau);
For i:=2 to n+1 do
begin
cc:=c+round(x1[i-1]*Kx);hh:=h-round(y1[i-1]*Ky); {Dinh
trong tiep theo}
lineto(cc,hh);
cc:=c+round(x2[i]*Kx);hh:=h-round(y2[i]*Ky); {Dinh ngoai
tiep theo}
lineto(cc,hh);
end;
SetFillStyle(1,mau);
FloodFill(c,h,mau);
End;
{********************************}
Procedure Quay;
var t:integer;
Begin
t:=70;
While not keypressed do
begin
goc:=goc+10;
VeSao(c,h,R2,R1,n,goc,mau); delay(t);
SetColor(15);
OutTextXY(C-30,320,'VIET NAM');
VeSao(c,h,R2,R1,n,goc,red); delay(t);
end;
End;
{*******************************}
Procedure Dichuyen;
Var ch:char;
Begin
Kx:=1;Ky:=1;
While True do
begin
ch:=readkey;
Case ch of
#43: Begin Kx:=Kx+0.1;Ky:=Ky+0.1; End;
#45: Begin Kx:=Kx-0.1;Ky:=Ky-0.1; End;
#77: C:=C+20;
#75: C:=C-20;
#72: h:=h-20;
#80: h:=h+20;
#13: Exit;
End;
Quay ;
End ; {of While}
End;
{************************************}
Procedure Nhap_Dl;
var x,y,t,So,m:Integer;
ss,St:String;
Begin
9
ClearDevice;
SetbkColor(Blue);
x:=10;y:=100;
Setcolor(15);Gwrite(X,y,'Nhap so canh:');Gread(X,Y,st);
Gwriteln(X,y,' ');Gwrite(X,y,'Nhap mau sao:');Gread(X,Y,ss);
Val(st,t,so);
Val(ss,M,so);
n:=t; Mau:=m;
End;
{**************************}
Procedure Star;
Begin
Nhap_Dl;
C:=GetMaxx Div 2;h:=GetMaxY div 2;R2:=70;R1:=30;goc:=0;
SetFillStyle(1,red);
Bar(C-100,H-100,c+100,H+100);
Setcolor(LightRed);
OutTextxy(C-90,350,'ENTER TO RETURN MAINMENU');
Quay;
Dichuyen;
ClearDevice;
END;
{**********Do thi b3/b1**********}
Function F(X:real):real;
Begin
F:=(3*X*X*X+-9*x*x+4*X+6)/(7*x+9);
end;
{***********************************}
Procedure
MinMaxF(Alpha,beta:real;Var Min,Max:Real);
Var X,Y,dx:Real;
Begin
X:=Alpha; dx:=(Beta-Alpha)/640;
While X
Max then Max:=Y;
End;
end;
{*********************************}
Procedure
VeFx(Alpha,beta:real;C1,H1,C2,H2:Integer);
Var
Min,Max,Kx,Ky,dx:real;So,M,Co,Ho,C,H,xn,yn:integer; x,y:real;
St:string;
Begin
ClearDevice;
SetbkColor(Blue);
xn:=250;yn:=130;
Gwrite(Xn,yn,'Nhap mau de ve:');Gread(Xn,Yn,st);
Val(st,M,so);
Mau:=m;
SetFillStyle(1,9);
Bar(c1,h1,c2,h2);
SetColor(14);
Rectangle(c1-2,h1-2,c2+2,h2+2);
MinMaxF(alpha,beta,Min,Max);
Kx:=(C2-C1)/(beta-alpha);
Ky:=(H2-H1)/(Max-Min);
Co:=C1-Round(alpha*Kx);
Ho:=H1+Round(MaxY*Ky);
x:=alpha; Y:=F(x);
C:=Co+Round(X*Kx);
H:=Ho-Round(Y*Ky);
10
SetColor(red);
OutTextXY(Co+2,Ho+2,'0');
OutTextXY(C2-5,Ho-3,'>');
OutTextXY(Co-3,H1,'^');
Line(C1,ho,c2,ho);
Line(Co,H1,Co,H2);
Moveto(C,H);
Setcolor(Mau);
dx:=(beta-alpha)/640;
While x #13 then
begin
Gwrite(c,h,ch);
luu:=luu+ch;
end;
Until ch=#13;
End;
cho phÐp lu s©u võa nhËp vµo biÕn St. Xn vµ Yn lµ 2 biÕn nguyªn ®îc truyÒn vµo cho C
vµ H trong 2 thñ tô trªn.
Co, Ho lµ to¹ ®é mµn h×nh cña gèc ®Ò c¸c, nã ®îc x¸c ®Þnh theo c«ng thøc: Co:=C1Round(alpha*Kx);
Ho:=H1+Round(MaxY*Ky);
qua ®©y ta dïng ®Ó chuyÓn ®æi tõ to¹ ®é ®Ò c¸c sang to¹ ®é mµn h×nh:
C:=Co+Round(X*Kx);
H:=Ho-Round(Y*Ky);
Tõ ®ã qua vßng lÆp:
While xmax then Max:=ham;
if ham=Tmax
end;
12
{******************}
procedure MinMaxX(Var t:real;Var Min,Max:real);
var ham:real;
begin
t:=0; ham:=x(t);
max:=ham;
repeat
t:=t+0.1;ham:=x(t);
if ham>max then max:=ham;
if ham=Tmax
end;
{*******************}
Procedure Ve_Do_Thi_Tham_so(c1,h1,c2,h2:integer);
Var c0,h0,c,h:integer;
kx,ky,xmin,xmax,ymin,ymax:real;
Begin
ClearDevice;
SetBkColor(blue);
c1:=150;H1:=150;C2:=500;H2:=350;
MinMaxX(t,Xmin,Xmax);MinMaxY(t,Ymin,Ymax);
kx:=(c2-c1)/(Xmax-Xmin);Ky:=(h2-h1)/(Ymax-Ymin);
c0:=c1-round(Xmin*Kx);h0:=h1+round(Ymax*Ky);
bar(c1,h1,c2,h2);
SetColor(red);
line(c1,h0,c2,h0);line(c0,h1,c0,h2);
SetColor(8);rectangle(c1,h1,c2,h2);
SetColor(15);rectangle(c1-1,h1-1,c2+1,h2+1);
t:=0;
c:=c0+round(x(t)*Kx);h:=h0-round(y(t)*Ky);
moveto(c,h); SetColor(14);
while t < Tmax do
begin
t:=t+0.01;
c:=c0+round(x(t)*Kx);h:=h0-round(y(t)*Ky);
lineto(c,h);Delay(2);
end;
Beep;Beep;
SetColor(10); OutTextXy(200,H2+10,'FINISHED ENTER TO RETURN
MAINMENU');
Readln;
ClearDevice;
End;
{***************** Cac thu tuc ve Do thi doc cuc**********}
function r(alfa:real):real;
begin
r:=50*(1+7*sin(alfa)*cos(alfa)*sin(4*alfa));
end;
{********************************************}
procedure maxr(Var Max:real);
var af,tg:real;
begin
Af:=0;tg:=r(Af);
max:=Tg;
repeat
Af:=Af+0.1;Tg:=r(Af);
if Tg>max then max:=Tg
until Af>=2*pi
end;
{***********************************}
Procedure Ve_Doc_cuc(c1,h1,c2,h2,Mau:integer);
Var c0,h0,c,h:integer;
13
k,max,D,Af,ham,x,y:real;
Begin
ClearDevice;
SetBkColor(blue);
c1:=150;H1:=150;C2:=500;H2:=350;
Mau:=14;
maxr(Max);
If (c2-c1)<(h2-h1) then D:=c2-c1 else D:=h2-h1;
k:=D/2/max; { k la he so co dan }
c0:=c1+((c2-c1) div 2);h0:=h1+((h2-h1) div 2);
{(co,ho) la toa dé man hinh cua goc he de cac}
bar(c1,h1,c2,h2);
SetColor(red);
line(c1,h0,c2,h0);line(c0,h1,c0,h2);
SetColor(14);rectangle(c1-2,h1-2,c2+2,h2+2);
Af:=0; ham:=r(Af);x:=ham*cos(Af);y:=ham*sin(Af);
{Tinh toa dé man hinh diem xuat phat}
c:=c0+round(x*k);h:=h0-round(y*k);
moveto(c,h); SetColor(Mau);
while Af < 2*pi do
begin
Af:=Af+0.01; ham:=r(Af);x:=ham*cos(Af);y:=ham*sin(Af);
{Tinh toa do man hinh diem tiep theo }
c:=c0+round(x*k);h:=h0-round(y*k);
lineto(c,h);
Delay(5);
end;
Beep;Beep;
SetColor(10); OutTextXy(200,H2+10,'FINISHED ENTER TO RETURN
MAINMENU');
Readln;
ClearDevice;
End;
{**********Cac thu tuc ve Da dien********************}
Procedure Nhap_Diem_Nhin_Ban_Dau;
Begin
PhepChieu:=PhoiCanh;
Rho:=15;Theta:=30;Phi:=200;De:=600;
End;
{********************************}
Procedure Nhap_Dinh;
var a:integer;
Begin
a:=3;
st[1,1]:=0; st[1,2]:=0; st[1,3]:=0; {Dinh 1}
st[2,1]:=0;st[2,2]:=0; st[2,3]:=a; {Dinh 2}
st[3,1]:=a;st[3,2]:=0;st[3,3]:=a;
{Dinh 3}
st[4,1]:=a; st[4,2]:=0;st[4,3]:=0; {Dinh 4}
st[5,1]:=0; st[5,2]:=a; st[5,3]:=0; {Dinh 5}
st[6,1]:=0; st[6,2]:=a; st[6,3]:=a; {Dinh 6}
st[7,1]:=a; st[7,2]:=a; st[7,3]:=a; {Dinh 7}
st[8,1]:=a; st[8,2]:=a; st[8,3]:=0; {Dinh 8}
End;
{*******************************}
Procedure Nhap_mat;
Begin
NF:=6;
FC[1,0]:=4; FC[1,1]:=1; FC[1,2]:=2; FC[1,3]:=3; FC[1,4]:=4; {Mat
FC[2,0]:=4; FC[2,1]:=1; FC[2,2]:=5; FC[2,3]:=6; FC[2,4]:=2; {Mat
FC[3,0]:=4; FC[3,1]:=5; FC[3,2]:=8; FC[3,3]:=7; FC[3,4]:=6; {Mat
FC[4,0]:=4; FC[4,1]:=3; FC[4,2]:=7; FC[4,3]:=8; FC[4,4]:=4; {Mat
FC[5,0]:=4; FC[5,1]:=1; FC[5,2]:=4; FC[5,3]:=8; FC[5,4]:=5; {Mat
14
1}
2}
3}
4}
5}
FC[6,0]:=4; FC[6,1]:=2; FC[6,2]:=6; FC[6,3]:=7; FC[6,4]:=3; {Mat 6}
End;
{************************************}
Procedure Vecto_Nhin(St1,St2,St3:integer;Var V1,V2,V3:real);
Begin
V1:=O1-St[st1,1];V2:=O2-st[st1,2];V3:=O3-st[St1,3];
End;
{**************************}
Procedure Vecto_Chuan(St1,St2,St3:integer;Var N1,N2,N3:real);
Var P1,P2,P3,q1,q2,q3:real;
Begin
P1:=St[St2,1]-St[St1,1];
P2:=St[St2,2]-St[St1,2];
P3:=St[St2,3]-St[St1,3];
q1:=St[St3,1]-St[St1,1];
q2:=St[St3,2]-St[St1,2];
q3:=St[St3,3]-St[St1,3];
N1:=p2*q3-q2*p3;
N2:=p3*q1-q3*p1;
N3:=p1*P2-q1*P2;
END;
{***********************************}
Function TVH(V1,V2,V3,N1,N2,N3:Real):real;
Begin
TVH:=V1*N1+V2*N2+V3*N3;
end;
{***********************************}
Procedure
Ve_DaDien(Color:Integer);
Var F,St1,St2,St3,NS,No,Mau:InTeger;
V1,V2,V3,N1,N2,N3:Real;
X,Y,Z,Xo,Yo,Zo:Real;
Procedure Ve_Mat(Color:Integer);
Var S:Integer;
Begin
Mau:=Color;
NS:=Fc[F,0];
No:=Fc[F,1];Xo:=St[No,1];yo:=St[No,2];Zo:=St[No,3];
If PhepChieu=PhoiCanh then KgMoveto(xo,yo,zo)
Else KGMovetoP(Xo,yo,zo);
for s:=2 to Ns do
Begin
No:=Fc[F,s];X:=st[no,1];Y:=st[no,2];Z:=st[No,3];
If PhepChieu=PhoiCanh then KGLineto(X,Y,Z,Mau)
else KGLinetoP(X,Y,Z,Mau);
end;
If PhepChieu=PhoiCanh then KGLineto(Xo,Yo,Zo,Mau)
else KGLinetoP(Xo,Yo,Zo,Mau);
End; {Procedure ve mat}
Begin
for F:=1 to NF do
Begin
St1:=FC[F,1];St2:=FC[F,2];St3:=FC[F,3];
Vecto_Nhin(St1,St2,St3,V1,V2,V3);
Vecto_Chuan(St1,St2,St3,N1,N2,N3);
If TVH(V1,V2,V3,N1,N2,N3) > 0 then Net_Khuat:=False
Else Net_Khuat:=True;
If Not Net_Khuat then
Begin
SetlineStyle(Dottedln,0,NormWidth);
Ve_Mat(Color);
end;
If Net_Khuat then
15
Begin
end;
SetlineStyle(SoLidln,0,NormWidth);
Ve_Mat(Color);
end;
end;
{*********************************}
Procedure
Ve_Diem_Nhin(Color:Integer);
Var
Th,Ph:real;
Begin
Th:=Pi*Theta/180;
Ph:=Phi*Pi/180;
O1:=Rho*Cos(Ph)*Cos(Th);
O2:=Rho*Cos(Ph)*Sin(Th);
O3:=Rho*Sin(Ph);
KG_Writexyz(O1,O2,O3,'S',Color);
end;
{*********** Do thi the tham so ************}
Procedure Thong_Bao(Color:Integer);
var S1,S2,S3,S4,S5:String;
Begin
Str(Theta:3:1,S2); Str(Phi:3:1,S3); Str(DE:4:1,S4);
If PhepChieu=PhoiCanh then
Begin
Str(Rho:4:1,s1);
OutTextXY(180,30,s3);
OutTextXY(180,50,s2);
OutTextXY(180,70,s4);
End
else
SetColor(Lightred);OutTextXY(200,440,'PRESS ENTER TO
RETURN MENU');
End;
{********************}
procedure Xem_ve;
Var Ch:Char;
Color:Integer;
Begin
Cuaso(10,10,240,100,15,8,9,3);
SetColor(14);
OutTextXY(20,30,#24#25' Tang giam Phi');
OutTextXY(20,50,#27#26' Tang giam Theta');
OutTextXY(20,70,'+/- Tang giam DE ');
Color:=14;
Nhap_Diem_Nhin_ban_Dau;
repeat
Ve_Diem_Nhin(15);
Ve_DaDien(15);{Vetruc(4,red);}Thong_Bao(15);
Ch:=ReadKey;If ch=#0 then ch:=Readkey;
Ve_Diem_Nhin(GetBkColor);
Ve_DaDien(GetBkColor);
{Vetruc(4,GetBkColor);}Setcolor(9);Thong_Bao(9);
Case Ord(Upcase(ch)) of
72:Phi:=Phi+D_goc;
80:Phi:=Phi-D_goc;
75:Theta:=Theta-D_goc;
77:Theta:=Theta+D_goc;
69:Rho:=Rho+D_Rho;
65:Rho:=Rho-D_Rho;
43:DE:=DE+D_DE;
45:DE:=DE-D_DE;
67:If PhepChieu=PhoiCanh then
16
Begin
Kx:=30;Ky:=37;
PhepChieu:=VuongGoc;
end
Else
Begin
Kx:=1;Ky:=1;
PhepChieu:=PhoiCanh;
end;
end;
Until Ch=#13;
end;
{******************************}
Procedure Da_Dien_Deu;
Begin
MhDohoa;
SetBkColor(Blue);
Nhap_Diem_Nhin_Ban_Dau;
co:=GetMaXx DIV 2;ho:=GetMaxY DIV 2;
kX:=1;kY:=1;
Nhap_Dinh;
Nhap_Mat;
Xem_ve;
End;
{************Cac thu tuc ve Menu******************}
Procedure Chon_Doc;
Var TT:integer;
Begin
Menu_doc(tt);
While true do
Begin
Ch:=readkey;
Case Ch of
#72 :Begin
tt:=tt-1;
if tt<1 then Break;
end;
#80 :Begin
tt:=tt+1;
if tt>5 then tt:=1;
end;
#13 :Case tt of
1: Begin
Beep;
Anfa:=8;Beta:=8;c1:=150;H1:=150;C2:=500;H2:=350;
VeFx(anfa,Beta,c1,h1,c2,h2);
end;
2:Begin
Beep;
Ve_Do_Thi_Tham_so(c1,h1,c2,h2);
End;
3:Begin
Beep;
Ve_Doc_cuc(c1,h1,c2,h2,Mau);
End;
4:Begin
Beep;
Star;
ttn:=1;
Beep;
End;
17
5:Begin
Beep;
Da_Dien_Deu;
Beep;
ClearDevice;
Menu_Doc(tt);
End;
end;
End;
Menu_doc(tt);
End;
ClearDevice;
End;
{****************************}
Procedure Chon_Ngang(ttn:Integer);
Var i,j,dc1,DMau,Cc1:integer;
St,St1:String;
Begin
ClearDevice;
SetBkColor(0);
C1:=20;h1:=20;C2:=GetMaxx-c1;H2:=GetMaxy-H1;Cc1:=c1-345;
Cuaso(C1-5,H1-5,c2+5,H2+5,15,7,LightBlue,5);Dc1:=5;
Gio1;
GetDate1;
Cuaso(C1,H2-100,c1+180,H2,15,7,Blue,3);
SetColor(15);
OutTextXY(c1+50,H2-90,'INDICATE');
OutTextXY(c1+5,H2-60,#26#27+': Move left/Right');
OutTextXY(c1+5,H2-40,#24#25+': Move Up/Down');
OutTextXY(c1+5,H2-20,'Enter: thuc hien');
SetColor(14);
Chu_Bong(70,150,8,0,5,10,Lightred,6,'TRUONG DHBK HA NOI');
Chu_Bong(200,200,7,0,5,10,Lightred,6,'KHOA CNTT');
Chu_Bong(200,100,15,0,4,14,Lightred,3,'');
Menu_Ngang(ttn);
Chu_Chay;
While true do
Begin
Ch:=readkey;
Case Ch of
#75 :Begin
ttn:=ttn-1;
if ttn<1 then ttn:=3;
end;
#77 :Begin
ttn:=ttn+1;
if ttn>3 then ttn:=1;
end;
#13 :Case ttn of
1:Begin
Chon_doc;
Chon_Ngang(ttn);
end;
2:Begin
Beep;
About;
Ttn:=1;
Chon_Ngang(ttn);
End;
3:Begin
Beep;
Halt(0);
18
End;
End;
End;
Menu_Ngang(ttn);
End;
End;
{**********Chuong trinh chinh************}
BEGIN
MhDohoa;
SetBkColor(Blue);
R3:=3;RR3:=5; Tmax:=10*Pi;
Kx:=2;Ky:=2;
DE:=200;Rho:=5;Phi:=30;
Co:=GetMaxX div 2; Ho:=GetMaxY div 2;
Chon_Ngang(Ttn);
readln;
closeGraph;
END.
IV/ Mét sè h×nh ¶nh minh ho¹ cho ch¬ng tr×nh:
1.Menu chÝnh cña ch¬ng tr×nh:
19
2.Menu chÝnh cña ch¬ng tr×nh:
3.§å thÞ bËc ba/ bËc nhÊt:
20
.DOC 
22 
93 
132 
