Lối sống của sinh viên việt nam hiện nay, thực trạng và kiến nghị

  • Số trang: 22 |
  • Loại file: DOC |
  • Lượt xem: 21 |
  • Lượt tải: 0
nganguyen

Đã đăng 34173 tài liệu

Mô tả:

Website: http://www.docs.vn Email : lienhe@docs.vn 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 XMax 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
- Xem thêm -