Diễn Đàn Pascal
Bạn có muốn phản ứng với tin nhắn này? Vui lòng đăng ký diễn đàn trong một vài cú nhấp chuột hoặc đăng nhập để tiếp tục.

Chia se 1 bai paccal ve ve do thi

2 posters

Go down

Chia se  1 bai paccal ve ve do thi Empty Chia se 1 bai paccal ve ve do thi

Bài gửi by anhlapro26 17/1/2011, 8:12 am

program hamsobac3;
uses crt, graph;
var
a, b, c, d: real; {cac he so}
x1, x2, y1, y2, xu, yu: real; {toa do cuc tri, diem uon}
delta: real; {delta' trong tinh toan y'}
k, currmode: integer;
isready: boolean;
(*----------------------------------------------------------*)
{khoi tao ve kiem tra loi do hoa neu co}
procedure khoitaodohoa;
var
maloi, driver, mode: integer;
begin
if (isready = false) then
begin
driver := detect;
initgraph(driver, mode, 'c:\tp\bgi'); {thay doi duong dan cho phu hop}
maloi := graphresult; {check for errors}
if (maloi <> grok) then
begin
writeln('Loi do hoa: ',grapherrormsg(maloi));
writeln('Nhan Enter de thoat...');
readln;
halt(1); {lenh ket thuc chuong trinh}
end
else isready := true;
end
else
begin
setgraphmode(currmode);
end;
end;
(*---------------------------------------------------------*)
procedure nhapdulieu;
var
s: string;
maloi: integer;
begin
clrscr;
writeln('Chuong trinh khao sat va ve do thi ham so bac 3');
writeln('y = ax3 + bx2 + cx + d');
writeln('-----------------------------------------------');
writeln('Nhap gia tri cac he so:');
write('a= ');
repeat
readln(s);
val(s, a, maloi);
if ((maloi<>0) or (a=0)) then
begin
writeln('Gia tri vua nhap ko hop le. Hay thu lai:');
write('a= ');
end;
until ((a<>0) and (maloi=0));
write('b= ');
repeat
readln(s);
val(s, b, maloi);
if (maloi<>0) then
begin
writeln('Gia tri vua nhap ko hop le. Hay thu lai:');
write('b= ');
end;
until (maloi=0);
write('c= ');
repeat
readln(s);
val(s, c, maloi);
if (maloi<>0) then
begin
writeln('Gia tri vua nhap ko hop le. Hay thu lai:');
write('c= ');
end;
until (maloi=0);
write('d= ');
repeat
readln(s);
val(s, d, maloi);
if (maloi<>0) then
begin
writeln('Gia tri vua nhap ko hop le. Hay thu lai:');
write('d= ');
end;
until (maloi=0);
end;
(*-----------------------------------------------------------*)
function F(x: real):real; {ham so nhan duoc}
begin
F := a*x*x*x + b*x*x + c*x + d;
end;
(*-----------------------------------------------------------*)
procedure xulydulieu;
var
temp: real;
begin
delta := b*b - 3*a*c;
if (delta>0) then
begin
x1 := ( (-1)*b + sqrt(delta) ) / (3*a);
x2 := ( (-1)*b - sqrt(delta) ) / (3*a);
y1 := F(x1);
y2 := F(x2);
if (a>0) then
begin
temp := x1;
x1 := x2;
x2 := temp;
temp := y1;
y1 := y2;
y2 := temp;
end;
end;
xu := (-1)*b / (3*a);
yu := F(xu);
end;
(*-----------------------------------------------------------*)
{xac dinh khoang khao sat va tinh toan ty le toa do thuc so voi man hinh}
procedure candoidothi(var xbegin, xend, kx, ky: real; sizex, sizey: integer);
var
temp: real;
begin
{khoang khao sat x}
if (delta <= 0) then
begin
xbegin := xu - 5;
xend := xu + 5;
end
else
begin
xbegin := x1 - (x2 - x1);
xend := x2 + (x2 - x1);
end;
temp := abs(xend);
if (abs(xbegin) > temp) then temp:=abs(xbegin);
kx := sizex / temp;

{khoang khao sat y}
temp := abs(F(xbegin));
if (abs(F(xend)) > temp) then temp := abs(F(xend));
if (delta>0) then
begin
if (abs(y2) > temp) then temp := abs(y2);
if (abs(y1) > temp) then temp := abs(y1);
end;
ky := sizey / temp;
end;
(*-------------------------------------------------------------*)
procedure vedothi(c1, d1, c2, d2: integer); {gioi han man hinh ve do thi}
var
ox, oy: integer; {goc toa do}
sizex, sizey: integer; {gioi han mot phan tu do thi}
kx, ky: real; {ty le toa do thuc so voi man hinh}
x, y, xbegin, xend: real; {diem tren do thi va gioi han do thi}
begin
{goc toa do}
ox := (c1 + c2) div 2;
oy := (d1 + d2) div 2;
outtextxy(ox+5, oy+2, 'o');

{truc tung}
line(ox, d1+10, ox, d2-10);
line(ox, d1+10, ox+2, d1+15);
line(ox, d1+10, ox-2, d1+15);
outtextxy(ox-12, d1+10, 'y');

{truc hoanh}
line(c1+10, oy, c2-10, oy);
line(c2-10, oy, c2-15, oy+2);
line(c2-10, oy, c2-15, oy-2);
outtextxy(c2-15, oy+5, 'x');

{xac dinh gioi han do thi va ty le toa do thuc so voi man hinh}
sizex := ((c2-c1) div 2)-40;
sizey := ((d2-d1) div 2)-40;
candoidothi(xbegin, xend, kx, ky, sizex, sizey);

{danh dau cac diem dac biet}
{diem uon}
putpixel(ox + round(xu*kx), oy - round(yu*ky), 14);

{cuc tri}
if (delta>0) then
begin
putpixel(ox + round(x1*kx), oy - round(y1*ky), 14); {cuc tri}
putpixel(ox + round(x2*kx), oy - round(y2*ky), 14); {cuc tri}
end;

{ve do thi}
x:=xbegin;
y:=F(x);
moveto(ox + round(x*kx), oy - round(y*ky));
repeat
x := x + 0.01;
y := F(x);
lineto(ox + round(x*kx), oy - round(y*ky));
until (x >= xend);
end;
(*-----------------------------------------------------*)
{in chuoi va xuong dong trong man hinh do hoa}
procedure outtextln(s: string);
begin
outtext(s);
moveto(0, gety + 2*textheight('H'));
end;
(*-----------------------------------------------------*)
{chuyen doi tu kieu so sang chuoi}
function tostring(x: real): string;
var
s: string;
begin
str(x:0:2, s); {lam tron den hai chu so thap phan}
if (s[length(s)] = '0') then
begin
delete(s, length(s), 1);
if (s[length(s)] = '0') then delete(s, length(s)-1, 2);
end;
tostring := s;
end;
(*----------------------------------------------------*)
{chuyen doi tu kieu so sang chuoi voi dinh dang phu hop}
function tostr(x: real): string;
var
s: string;
begin
str(x:0:2, s); {lam tron den hai chu so thap phan}
if (s[length(s)] = '0') then
begin
delete(s, length(s), 1);
if (s[length(s)] = '0') then delete(s, length(s)-1, 2);
end;
if (x<0) then s := '(' + s + ')';
tostr := s;
end;
(*-------------------------------------------------------------*)
procedure khaosat;
var
w, h: integer;
begin
w:=textwidth('W');
h:=textheight('H');

outtextln('Khao sat va ve do thi ham so:');
outtextln('y = ' + tostr(a) + 'x^3' + ' + ' + tostr(b) + 'x^2' + ' + ' + tostr(c) + 'x' + ' + ' + tostr(d));
outtext('(So thuc lam tron den hai chu so thap phan)');
moveto(0, gety + h);
outtextln('-------------------------------------------');
outtextln('* TXD la R');
outtextln('* Dao ham cap mot:');
outtextln('y'' = ' + tostr(3*a) + 'x^2' + ' + ' + tostr(2*b) + 'x' + ' + ' + tostr(c));
if (delta>0) then
begin
outtextln('y''= 0 <=> x= ' + tostring(x1) + ' hoac x= ' + tostring(x2) + ' (cuc tri)');
outtext('x= ' + tostring(x1) + ' => y= ' + tostring(y1) + '; ');
outtextln('x= ' + tostring(x2) + ' => y= ' + tostring(y2));
end
else
if (a<0) then
begin
if (delta=0) then
outtextln('=> y'' <= 0 voi moi x')
else
outtextln('=> y'' < 0 voi moi x');
outtextln('=> Ham so nghich bien tren R (ko co cuc tri)');
end
else
begin
if (delta=0) then
outtextln('=> y'' >= 0 voi moi x')
else
outtextln('=> y'' > 0 voi moi x');
outtextln('=> Ham so dong bien tren R (ko co cuc tri)');
end;
outtextln('* Dao ham cap hai:');
outtextln('y'''' = ' + tostr(6*a) + 'x' + ' + ' + tostr(2*b));
outtextln('y'''' = 0 <=> x = ' + tostring(xu));

{bang y''}
line(6*w, gety, 6*w, gety + 10*h);
line(2*w, gety + 3*h, 42*w, gety + 3*h);
line(2*w, gety + 6*h, 42*w, gety + 6*h);
line(24*w, gety + 6*h, 32*w, gety + 7*h);
line(32*w, gety + 7*h, 32*w, gety + 10*h);
line(24*w, gety + 6*h, 16*w, gety + 7*h);
line(16*w, gety + 7*h, 16*w, gety + 10*h);

moveto(3*w, gety + h);
outtext('x');
moveto(7*w, gety);
outtext('-oo');
moveto(24*w, gety);
settextjustify(1,2);
outtext(tostring(xu));
settextjustify(0,2);
moveto(39*w, gety);
outtext('+oo');
moveto(3*w, gety + 3*h);
outtext('y''');
moveto(12*w, gety);
if (a>0) then
outtext('+')
else
outtext('-');
moveto(24*w, gety);
outtext('0');
moveto(36*w, gety);
if (a>0) then
outtext('-')
else
outtext('+');
moveto(23*w, gety + 3*h);
outtext('D.U');
moveto(3*w, gety + h);
outtext('C');
moveto(11*w, gety);
if (a>0) then
outtext('lom')
else
outtext('loi');
moveto(35*w, gety);
if (a>0) then
outtext('loi')
else
outtext('lom');
moveto(25*w, gety + h);
settextjustify(1,2);
outtextln('(' + tostring(xu) + ';' + tostring(yu) + ')');
settextjustify(0,2);
outtextln('Qua x=' + tostring(xu) + ' y'''' doi dau');
outtextln('=>I('+ tostring(xu) + ';' + tostring(yu) + ') la diem uon');

{gioi han ham so}
outtext('* Gioi han: ');
if(a>0) then outtext('lim(y) = +oo lim(y) = -oo')
else outtext('lim(y) = -oo lim(y) = +oo');
moveto(0, gety + h);
outtextln(' x->+oo x->-oo');

{bang bien thien}
outtextln('* Bang bien thien:');
line(6*w, gety, 6*w, gety + 10*h);
line(2*w, gety + 3*h, 42*w, gety + 3*h);
line(2*w, gety + 6*h, 42*w, gety + 6*h);

moveto(0, gety + h);
moveto(3*w, gety);
outtext('x');
moveto(7*w, gety);
outtext('-oo');
moveto(39*w, gety);
outtext('+oo');
if (delta<=0) then
begin
if (delta=0) then
begin
moveto(24*w, gety);
settextjustify(1,2);
outtext(tostring(xu));
settextjustify(0,2);
end;
moveto(3*w, gety + 3*h);
outtext('y''');
if (delta=0) then
begin
moveto(14*w, gety);
if (a>0) then
outtext('+')
else
outtext('-');
moveto(24*w, gety);
outtext('0');
moveto(36*w, gety);
if (a>0) then
outtextln('+')
else
outtextln('-');
end
else
begin
moveto(24*w, gety);
if (a>0) then
outtextln('+')
else
outtextln('-');
end;

if (a>0) then
begin
moveto(39*w, gety + h);
outtext('+oo');
moveto(3*w, gety + h);
outtext('y');
moveto(7*w, gety + h);
outtext('-oo');
line(getx + w, gety + h, getx + 28*w, gety - 2*h);
line(getx + 28*w, gety - 2*h, getx + 28*w - 5, gety - 2*h-4);
line(getx + 28*w, gety - 2*h, getx + 28*w - 4, gety - 2*h + 4);
moveto(0, gety + 3*h);
end
else
begin
moveto(7*w, gety + h);
outtext('+oo');
line(getx + w, gety, getx + 28*w, gety + 2*h);
line(getx + 28*w, gety + 2*h, getx + 28*w - 4, gety + 2*h-4);
line(getx + 28*w, gety + 2*h, getx + 28*w - 5, gety + 2*h + 4);
moveto(3*w, gety + h);
outtext('y');
moveto(39*w, gety + h);
outtextln('-oo');
end;
end
else
begin
settextjustify(1,2);
moveto(18*w, gety);
outtext(tostring(x1));
moveto(25*w, gety);
outtext(tostring(xu));
moveto(32*w, gety);
outtext(tostring(x2));
settextjustify(0,2);
moveto(3*w, gety + 3*h);
outtext('y''');
moveto(12*w, gety);
if (a>0) then
outtext('+')
else
outtext('-');
moveto(18*w, gety);
outtext('0');
moveto(25*w, gety);
if (a>0) then
outtext('-')
else
outtext('+');
moveto(32*w, gety);
outtext('0');
moveto(38*w, gety);
if (a>0) then
outtext('+')
else
outtext('-');
if (a>0) then
begin
moveto(18*w, gety + 3*h);
settextjustify(1,2);
outtext('CD(' + tostring(y1) + ')');
moveto(32*w, gety + 3*h);
outtext('CT(' + tostring(y2) + ')');
settextjustify(0,2);
moveto(3*w, gety - 2*h);
outtext('y');
moveto(39*w, gety - h);
outtext('+oo');
moveto(7*w, gety + 3*h);
outtext('-oo');
line(11*w, gety + h, 18*w, gety - 2*h);
line(18*w, gety - 2*h, 32*w, gety);
line(32*w, gety, 38*w, gety - 3*h);
moveto(0, gety + 2*h);
end
else
begin
moveto(7*w, gety + 3*h);
outtext('+oo');
moveto(32*w, gety);
settextjustify(1,2);
outtext('CD(' + tostring(y2) + ')');
moveto(18*w, gety + 3*h);
outtext('CT(' + tostring(y1) + ')');
settextjustify(0,2);
moveto(39*w, gety);
outtext('-oo');
moveto(3*w, gety - 2*h);
outtext('y');
line(11*w, gety - h, 18*w, gety + 2*h);
line(18*w, gety + 2*h, 32*w, gety);
line(32*w, gety, 38*w, gety + 3*h);
moveto(0, gety + 4*h);
end;
end;
outtextln('* Do thi: Co tam doi xung I, di qua (0,' + tostring(d) + ')');
end;
(*-----------------------------------*)
{chuong trinh chinh}
begin
isready := false;
repeat
nhapdulieu;
xulydulieu;
khoitaodohoa;
khaosat;
outtext('Nhan enter de quan sat do thi...');
readln;
vedothi(3*getmaxx div 5, 50, getmaxx, getmaxy-50);
moveto(getmaxx, getmaxy);
settextjustify(2,0);
outtext('Press any key to continue, ESC to cancel');
settextjustify(0,2);
k:=ord(readkey);
if (k=0) then k := ord(readkey);
if (k<>27) then
begin
currmode := getgraphmode;
restorecrtmode;
isready := true;
end;
until (k=27);
closegraph;
end.
anhlapro26
anhlapro26
Thành viên mới
Thành viên mới

Nam Ngày sinh : 26/10/1989
Tuổi : 34
Ngày đăng ký : 15/01/2011

Về Đầu Trang Go down

Chia se  1 bai paccal ve ve do thi Empty Re: Chia se 1 bai paccal ve ve do thi

Bài gửi by duy_sau_rom 11/4/2011, 1:55 pm

E thu chep bai nay chay nhung khong duoc. Sad
duy_sau_rom
duy_sau_rom
Thành viên mới
Thành viên mới

Nam Ngày sinh : 01/09/1995
Tuổi : 28
Ngày đăng ký : 30/03/2011

Về Đầu Trang Go down

Về Đầu Trang

- Similar topics

 
Permissions in this forum:
Bạn không có quyền trả lời bài viết