BÁO CÁO BÀI TẬP LỚN MÔN ĐỒ HOẠ

If i=k then CuaSo(a+(i-1)*Rong,b,a+i*rong,b+Cao,8,15,7,4)
Else CuaSo(a+(i-1)*Rong-1,b,a+i*Rong,b+Cao,15,8,7,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+(I-1)*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);
5
C:=CO+round(Xp*Kx);
H:=HO-round(Yp*Ky);
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;
6
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;
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;
7
{*******************Het*Unit**************}
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
8
Dgoc:=2*Pi/n; {Delta goc}
ggoc:=goc/180*Pi; {Doi goc thanh Radian}
For i:=1 to n+1 do
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;
9
ss,St:String;
Begin
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<beta do
Begin
x:=X+dx; y:=F(x);
if Y<Min then Min:=Y;
if Y>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);
10
x:=alpha; Y:=F(x);
C:=Co+Round(X*Kx);
H:=Ho-Round(Y*Ky);
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<beta do
begin
x:=x+dx; Y:=F(x);
C:=Co+Round(X*Kx);
H:=Ho-Round(Y*Ky);
Lineto(c,h);
Delay(10);
End;
Beep;Beep;
SetColor(10);
OutTextXy(C1+40,h2+10,'FINISHED ENTER TO RETURN MAIN MENU');
Readln;
ClearDevice;
end;
* Giải thích phần đồ thị Bậc 3/Bậc 1:
Gồm 1 hàm và 2 thủ tục:
+ Hàm : F(X:real):Real;
Hàm gồm 1 tham số X là số thực, giá trị trả về của hàm cũng là một số thực, cụ thể ở
trên hàm F:= (3X
3
- 9x
2
+ 4x)/(7X + 9) ( Thủ tục này máy tự động tính toán khi ta truyền cho
nó giá trị của X ).
+ Thủ tục:
1. Procedure MinMaxF(Alpha,beta:real;Var Min,Max:Real);
Var X,Y,dx:Real;
Thủ tục có 2 đối số truyền vào là Alpha, Beta là 2 số thực, 2 biến ra là Min, Max
và 3 biến địa phương là X,Y,dx. thủ tục thực hiện việc truyền vào 2 đối số Alpha và Beta
là khoảng mà trên đó giá trị hàm số biến thiên. dx:=(beta-alpha)/640; là số gia tỷ lệ với số
Pixel ( Rộng ) của màn hình đồ hoạ. Với mỗi giá trị X:=X+dx ( Khởi đầu X:=Alpha ) thì
Y sẽ nhận được một giá trị Y:=F(x); Sau khi Y nhận được mỗi giá trị, lấy Y so sánh với
Min, nếu giá trị của Y <Min thì thực hiện gán Min:=Y. Tương tự như Min sau khi đối
chiếu với các giá trị biến thiên của Y trên khoảng Alpha, Beta ta tìm được 2 giá trị Max
của hàm số. Đây cũng chính là mục tiêu của thủ tục và 2 giá trị này sau khi tìm được,
được lưu vào 2 biến là Min Và Max.
2. Procedure VeFx(Alpha,beta:real;C1,H1,C2,H2:Integer);
Var Min,Max,Kx,Ky,dx,x,y:real;
So,Co,Ho,C,H,xn,yn:integer;
St:string;
Thủ tục gồm các đối số sau: Alpha,beta là 2 số thực thể hiện khoảng biến thiên
của hàm, C1,H1,C2,H2 là 2 số nguyên là toạ độ của cửa sổ trên mà hình mà ta cần vẽ đồ
thị trên đó. Các đối số này được truyền vào khi ta gọi thủ tục trong chương trình chính.
Các biến địa phương bao gồm: Min, Max 2 biến dùng lưu giá trị Min, Max của hàm số
11
biến thiên trong khoảng Alpha, Beta; Kx, Ky là 2 biến thực biểu diễn hệ số co dãn hình,
Kx là hệ số co dãn bề ngang, Ky là hệ số co dãn bề dọc và được tính theo công thức sau:
Kx:=(C2-C1)/(beta-alpha);
Ky:=(H2-H1)/(Max-Min);
X,Y là 2 biến thực biểu diễn giá trị biến thiên của Y theo X.
Dx là số gia tỷ lệ ( Đã nói ở phần trên); So Là mã trả về của chuỗi St khi ta thực hiện việc
đổi chuỗi sang số, số sau khi đổi được lưu vào biến Mau ( Biến toàn cục ). Khi thủ tục
được gọi nó thông báo cho phép nhập màu cần vẽ qua 2 thủ tục được gọi trong UnitDt2
gồm:
Procedure Gwrite(Var c,h:Integer;St:String);
Begin
OutTextxy(c,h,st);
C:=c+TextWidth(st);
end;
Và thủ tục: Procedure Gread(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;
End;
cho phép lưu 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:=C1-
Round(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 x<beta do
begin
x:=x+dx; Y:=F(x);
C:=Co+Round(X*Kx);
H:=Ho-Round(Y*Ky);
Lineto(c,h);
Delay(10);
End;
thì cứ mỗi điểm M(x,y) trên toạ độ Đề các ta vẽ được 1 điểm trên toạ độ màn hình cho
đến khi hết hình cần vẽ.
{*********** Do thi theo tham so ************}
Function x(t:real):real;
var m:real;
Begin
m:=R3/RR3;x:=(RR3-R3)*cos(m*t)+m*RR3*cos(t-m*t)
End;
{********************}
Function y(t:real):real;
var m:real;
Begin
12
m:=R3/RR3;Y:=(RR3-R3)*sin(m*t)-m*RR3*sin(t-m*t)
End;
{***************}
procedure MinMaxY(Var t:real;Var Min,Max:real);
var ham:real;
begin
t:=0; ham:=y(t);
max:=ham;
repeat
t:=t+0.1;ham:=y(t);
if ham>max then Max:=ham;
if ham<min then Min:=ham
until t>=Tmax
end;
{******************}
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<min then min:=ham
until t>=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;
13
{********************************************}
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;
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}
14

Xem chi tiết: BÁO CÁO BÀI TẬP LỚN MÔN ĐỒ HOẠ