Bài tập lớn Đồ hoạ phẳng và Đồ hoạ không gian

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); Procedure ProjecP(x,y,z:real;Var XProj,YProj:real); Procedure KGMovetoP(x,y,z:real); Procedure KGPutPixelP(x,y,z:real;color:byte); Procedure KGLinetoP(x,y,z:real;Color:byte); Procedure KGLineP(x1,y1,z1,x2,y2,z2:real;color:byte); Procedure KG_WriteXYZP(X,Y,Z:real;St:String;color:byte); Procedure 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); 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); 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)*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 ZObs0 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); 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; 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**************} 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 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 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); 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:= (3X3 - 9x2 + 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ố 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 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; {********************************************} 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} 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 1} FC[2,0]:=4; FC[2,1]:=1; FC[2,2]:=5; FC[2,3]:=6; FC[2,4]:=2; {Mat 2} FC[3,0]:=4; FC[3,1]:=5; FC[3,2]:=8; FC[3,3]:=7; FC[3,4]:=6; {Mat 3} FC[4,0]:=4; FC[4,1]:=3; FC[4,2]:=7; FC[4,3]:=8; FC[4,4]:=4; {Mat 4} FC[5,0]:=4; FC[5,1]:=1; FC[5,2]:=4; FC[5,3]:=8; FC[5,4]:=5; {Mat 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 Begin SetlineStyle(SoLidln,0,NormWidth); Ve_Mat(Color); end; 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 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;