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.

cứu tôi với!!!

Go down

cứu tôi với!!! Empty cứu tôi với!!!

Bài gửi by kysutinhoc12 4/1/2011, 2:00 am

có ai pro pascal vào giải e bài này với, chỉ là chỉnh sửa cho khác đi chút!!!
chỉnh những cái nào có thể thôi ạ!!!
t5 e nộp rồi!
cảm ơn nhé11

Program VeDoThi;
Uses Crt,Graph;
Const R : Word = 100;
Type
ProcType = Procedure;
Var
Page : Array[0..2] Of ProcType;
i : Integer;
mxd,a,b,c,d,e,a1,b1,c1,M,N,P,delta,x1,x2,cd,ct : Real;
ch:Char;
flag:boolean;

Function TCX(x:real):real;
begin
TCX:=M*x+N;
end;

Function F(x:real):real;
begin
F:=(a*x*x+b*x+c)/(d*x+e);
end;


function FSR(N : real; W, D : byte) : string; { Convert Real to String }
var
S : string;
begin
Str(N : W : D, S);
FSR := S;
end;

procedure BBT1;
begin
Setcolor(Yellow);
Rectangle(50,100,600,450);
Rectangle(50,100,600,200);
Rectangle(50,200,600,250);
Rectangle(50,250,600,450);
Rectangle(50,100,150,450);
Rectangle(50,200,370,450);
Rectangle(380,200,600,450);

OutTextXY(90,150,'x');
OutTextXY(90,225,'y''');
OutTextXY(90,350,'y');
OutTextXY(170,150,'-ì');
OutTextXY(270,150,FSR(x1,3,1));
OutTextXY(360,150,FSR(mxd,3,1));
OutTextXY(470,150,FSR(x2,3,1));
OutTextXY(560,150,'+ì');

OutTextXY(270,225,'0');
OutTextXY(470,225,'0');
OutTextXY(210,225,'-');
OutTextXY(410,225,'-');
OutTextXY(320,225,'+');
OutTextXY(520,225,'+');

OutTextXY(250,300,FSR(cd,3,1));
OutTextXY(170,400,'-ì');
OutTextXY(330,400,'-ì');
Line(180,390,240,310);
Line(280,310,340,400);

OutTextXY(470,400,FSR(ct,3,1));
OutTextXY(400,300,'+ì');
OutTextXY(550,300,'+ì');
Line(500,390,560,310);
Line(400,310,460,400);

end;


procedure BBT2;
begin
Setcolor(Yellow);
Rectangle(50,100,600,450);
Rectangle(50,100,600,200);
Rectangle(50,200,600,250);
Rectangle(50,250,600,450);
Rectangle(50,100,150,450);
Rectangle(50,200,370,450);
Rectangle(380,200,600,450);

OutTextXY(90,150,'x');
OutTextXY(90,225,'y''');
OutTextXY(90,350,'y');
OutTextXY(170,150,'-ì');
OutTextXY(270,150,FSR(x1,3,1));
OutTextXY(360,150,FSR(mxd,3,1));
OutTextXY(470,150,FSR(x2,3,1));
OutTextXY(560,150,'+ì');

OutTextXY(270,225,'0');
OutTextXY(470,225,'0');
OutTextXY(210,225,'-');
OutTextXY(410,225,'+');
OutTextXY(320,225,'+');
OutTextXY(520,225,'-');

OutTextXY(250,400,FSR(ct,3,1));
OutTextXY(170,300,'+ì');
OutTextXY(330,300,'+ì');
Line(180,310,240,390);
Line(280,390,340,310);

OutTextXY(470,300,FSR(cd,3,1));
OutTextXY(400,400,'-ì');
OutTextXY(550,400,'-ì');
Line(500,310,560,390);
Line(400,390,460,310);

end;


procedure BBT3;
begin
Setcolor(Yellow);
Rectangle(50,100,600,450);
Rectangle(50,100,600,200);
Rectangle(50,200,600,250);
Rectangle(50,250,600,450);
Rectangle(50,100,150,450);
Rectangle(50,200,370,450);
Rectangle(380,200,600,450);

OutTextXY(90,150,'x');
OutTextXY(90,225,'y''');
OutTextXY(90,350,'y');
OutTextXY(170,150,'-ì');
OutTextXY(360,150,FSR(mxd,3,1));
OutTextXY(560,150,'+ì');

OutTextXY(270,225,'-');
OutTextXY(470,225,'-');

OutTextXY(170,300,'+ì');
OutTextXY(330,400,'-ì');
Line(180,310,320,390);

OutTextXY(420,300,'+ì');
OutTextXY(580,400,'-ì');
Line(430,310,570,390);

end;


procedure BBT4;
begin
Setcolor(Yellow);
Rectangle(50,100,600,450);
Rectangle(50,100,600,200);
Rectangle(50,200,600,250);
Rectangle(50,250,600,450);
Rectangle(50,100,150,450);
Rectangle(50,200,370,450);
Rectangle(380,200,600,450);

OutTextXY(90,150,'x');
OutTextXY(90,225,'y''');
OutTextXY(90,350,'y');
OutTextXY(170,150,'-ì');
OutTextXY(360,150,FSR(mxd,3,1));
OutTextXY(560,150,'+ì');

OutTextXY(270,225,'+');
OutTextXY(470,225,'+');

OutTextXY(170,400,'-ì');
OutTextXY(330,300,'+ì');
Line(180,390,320,310);

OutTextXY(420,400,'-ì');
OutTextXY(580,300,'+ì');
Line(430,390,570,310);
end;


{$F+}
{-------------------------------}
Procedure PageN0;
Var
s1,s2,s3:String;
Begin
ClearDevice;
SetColor(Yellow);
SetTextJustify(CenterText,CenterText);
OutTextXY(GetMaxX Div 2,50,'KHAO SAT VA VE DO THI CUA HAM SO');
str(a:3:1,s1);str(b:3:1,s2);str(c:3:1,s3);
OutTextXY(GetMaxX Div 2,GetMaxY Div 2 -10 , s1 + '*X*X + ' + s2 + '*X + ' + s3 );
OutTextXY(GetMaxX Div 2,GetMaxY Div 2,'y = ------------------');
str(d:3:1,s1);str(e:3:1,s2);
OutTextXY(GetMaxX Div 2,GetMaxY Div 2 + 10 , s1 + '*X + ' + s2 );
End;

{-------------------------------}
Procedure PageN1;
Begin
ClearDevice;
SetColor(Yellow);
SetTextJustify(CenterText,CenterText);
OutTextXY(GetMaxX Div 2,50,'BANG BIEN THIEN CUA HAM SO');
if ((a*d>0) AND (delta >= 0)) then BBT1;
if ((a*d<0) AND (delta >= 0)) then BBT2;
if ((a*d<0) AND (delta < 0)) then BBT3;
if ((a*d>0) AND (delta < 0)) then BBT4;
End;

{-------------------------------}
Procedure PageN2;
Var
x,y,kx,ky,ymax,ymin,first,last:real;
i,c0,h0,c,h:integer;
tmp1:String;
Begin
ClearDevice;
if (mxd>0) then
Begin
first:=-10*mxd;
last:=12*mxd;
End;

if (mxd<0) then
Begin
first:=12*mxd;
last:=-10*mxd;
End;

if (mxd=0) then
Begin
first:=-5;
last:=5;
End;


{Tim min max}
x:=first;y:=TCX(x);ymin:=y;ymax:=y;
Repeat
y:=TCX(x);
if y>ymax then ymax:=y;
if y x:=x+0.1;
Until x>=last;
if ymin>=0 then ymin:=-0.1;
if ymax<=0 then ymax:=0.1;

SetColor(Yellow);
kx:=(GetMaxX-35)/(last-first);
ky:=(GetMaxY-35)/(ymax-ymin);
x:=first;
c0:=round(-x*kx+10);
h0:=round(ymax*ky+20);
{Ve 2 truc toa do}
Line(10,h0,GetMaxX-25,h0);
Line(c0,20,c0,GetMaxY-15);
OutTextXY(c0-10,h0+5,'0');
OutTextXY(GetMaxX-16,h0,'>X ');
SetTextStyle(DefaultFont,VertDir,0);
OutTextXY(c0,18,'>');
SetTextStyle(DefaultFont,HorizDir,0);
OutTextXY(c0,8,'Y');

Setcolor(cyan);
c:=c0+round(mxd*kx);
Line(c,20,c,GetMaxY-15);

x:=first;
While x < last do
Begin
c:=c0+round(x*kx);
h:=h0-round(TCX(x)*ky);
{Ve tiem can xien}
putpixel(c,h,cyan);

if (abs(mxd-x)>0.01) then
Begin
h:=h0-round(F(x)*ky);
putpixel(c,h,white);
End;
x:=x+0.01;
End;
OutTextXY(100,5,'Hay an phim Q de thoat !');
End;

{$F-}
{------------------------------}
Procedure InitGraphic;
Var
Gd,Gm,GmHi : Integer;
Begin
DetectGraph(Gd,Gm);
If Not (Gd in [EGA,VGA,HercMono]) Then
Begin
Writeln('Khong lat trang duoc');
Halt(1);
End;
{GetModeRange(Gd,Gm,GmHi);}
InitGraph(Gd,Gm,'C:\TP\BGI');
SetBkColor(Black);
End;

Procedure Menu;
Begin
clrscr;
writeln('****** VE DO THI HAM SO ******');
writeln;
writeln(' aX*X + b*X + c ');
writeln(' y = -------------- ');
writeln(' c*X + d ');
writeln('Nhap cac he so cho ham so');
write('Nhap he so a = '); readln(a);
write('Nhap he so b = '); readln(b);
write('Nhap he so c = '); readln(c);
write('Nhap he so d = '); readln(d);
write('Nhap he so e = '); readln(e);
mxd:=-e/d;
a1:=a*d; b1:=2*a*e; c1:=b*e-c*d;
delta:=b1*b1-4*a1*c1;
if delta>=0 then
Begin
x1:=(-b1-sqrt(delta))/(2*a1);
x2:=(-b1+sqrt(delta))/(2*a1);
if F(x1)>=F(x2) then
Begin
cd:=F(x1);
ct:=F(x2);
End
else
Begin
cd:=F(x2);
ct:=F(x1);
End;


End;
M:=a/d; N:=(b*d-a*e) / (d*d);
writeln('Tiem can dung x = ',FSR(mxd,2,1));
writeln('Tiem can xien y = ',FSR(M,3,1),'*X + ',N:2:1);
readln;
End;

{-------------------------------}
BEGIN
Menu;
InitGraphic;
flag:=false;
Page[0]:=PageN0;
Page[1]:=PageN1;
Page[2]:=PageN2;
i := 0;
Page[0];
Repeat
if i<0 then i:=0;
if i>2 then i:=2;

Page[i];
ch:=readkey;
if ch=chr($00) then
Begin
ch:=upcase(readkey);
case ord(ch) of
73: i:=i-1;
81: i:=i+1;
end;
End
else
Begin
if upcase(ch)='Q' then flag:=true;
End;
Until flag=true;
CloseGraph;
END.
kysutinhoc12
kysutinhoc12
Thành viên mới
Thành viên mới

Nam Ngày sinh : 17/08/1990
Tuổi : 33
Ngày đăng ký : 04/01/2011

Về Đầu Trang Go down

Về Đầu Trang


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