Tài liệu hạn chế xem trước, để xem đầy đủ mời bạn chọn Tải xuống
1
/ 98 trang
THÔNG TIN TÀI LIỆU
Thông tin cơ bản
Định dạng
Số trang
98
Dung lượng
463,5 KB
Nội dung
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 . Bài toán loại 2 D : program duonghaichieu; uses crt,graph; type point_2d = record x,y:real; end; var . 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;