Правила форума
Прочтите прежде чем задавать вопрос!
Программка рисует графики, масштабирует, да только неправильно! К 4 часам утра не могу найти проблему... А сдавать в 12...
Думаю, ни у одного меня возникнут вопросы с такими вот программами... Помогите найти ошибку (почему-то cos0 для программы не 1, а 0,5)...Код
uses graph,crt;
const route='c:\graficpr.txt';
k=300;
eps=1E-4;
Mx=640;
My=480;
type kord=array[1..k] of real;
var n,i,a,b,c,dr,dm,e:integer;
f:text;
cx,cy,cxy:boolean;
ch:char;
procedure osi(kf:real;yz,xz:integer);
var j,kx,ky:integer;
st:string;
begin
setcolor(15);
line(15,yz,465,yz);
line(462,yz-3,465,yz);
line(462,yz+3,465,yz);
line(xz,15,xz,465);
line(xz-3,18,xz,15);
line(xz+3,18,xz,15);
setcolor(15);
kx:=0;
ky:=0;
if 470-yz<10 then ky:=-1;
if 470-xz<10 then kx:=-1;
for j:=1 to round((yz-20)/kf) do
begin
line(xz-1,round(yz-j*kf),xz+1,round(yz-j*kf));
str(j,st);
settextstyle(2,0,2);
outtextxy(xz-10,round(yz-j*kf)-4,st);
end;
for j:=1 to round((450-yz)/kf)+1 do
begin
line(xz-1,round(yz+j*kf),xz+1,round(yz+j*kf));
str(-j,st);
settextstyle(2,0,2);
outtextxy(xz-13,round(yz+j*kf)-4,st);
end;
for j:=0 to round((xz-20)/kf) do
begin
line(round(xz-j*kf),yz-1,round(xz-j*kf),yz+1);
str(-j,st);
settextstyle(2,0,2);
outtextxy(round(xz-j*kf-4),yz+2,st);
end;
for j:=1 to round((440-xz)/kf) do
begin
line(round(xz+j*kf),yz-1,round(xz+j*kf),yz+1);
str(j,st);
settextstyle(2,0,2);
outtextxy(round(xz+j*kf-4),yz+2,st);
end;
settextstyle(0,0,1);
outtextxy(450,yz+5+15*ky,'Ox');
outtextxy(xz+5+20*kx,15,'Oy');
cx:=true;
end;
procedure func_name;
begin
setcolor(blue);
line(480,20,500,20);
outtextxy(505,20,'Y(x)=cos(x)+b');
outtextxy(554,15,'x');
setcolor(red);
line(480,40,500,40);
outtextxy(505,40,'F(x)=1---+-----+...');
outtextxy(567,30,'2 4 6');
outtextxy(562,35,'x x x');
outtextxy(561,46,'2! 4! 6!');
end;
procedure grafic(n:integer;xm,ym,xm2,ym2:kord);
var xna4,xkon,yna4,ykon,yna42,ykon2,kfx,kfy,kf,k,dx,dy:real;
xzero,yzero:integer;
begin
xna4:=xm[1];
xkon:=xm[n];
yna4:=ym[1];
ykon:=ym[n];
yna42:=ym2[1];
ykon2:=ym2[n];
cx:=true;
cy:=true;
cxy:=true;
if ykon<ykon2 then ykon:=ykon2;
if yna4>yna42 then yna4:=yna42;
kfx:=(Mx-200)/(xkon-xna4);
kfy:=(My-40)/(ykon-yna4);
if kfx>=kfy then kf:=kfy else if kfx<kfy then kf:= kfx;
dx:=-xna4*kf+250-(xkon-xna4)*kf/2;
dy:=yna4*kf+240+(ykon-yna4)*kf/2;
if round(ym[1])<>0 then k:=kf;
rectangle(10,10,470,470);
for i:=1 to n-1 do begin
setcolor(blue);
line(round(xm[i]*kf+dx),round(ym[i]*(-kf)+dy),round(xm[i+1]*kf+dx),round(ym[i+1]*(-1)*kf+dy));
setcolor(red);
line(round(xm[i]*kf+dx),round(ym2[i]*(-kf)+dy),round(xm2[i+1]*kf+dx),round(ym2[i+1]*(-kf)+dy));
if (round(ym2[i])=0) and cy=true then begin xzero:=round(ym2[i]*(-kf)+dy+1-k/2);cy:=false; end;
if (round(xm2[i])=0) and cx=true then begin yzero:=round(xm2[i]*kf+dx+kf/2);cx:=false; end;
if (cy=false) and (cx=false) and (cxy=true) then begin osi(kf,xzero,yzero);cxy:=false;end;
end;
func_name;
end;
procedure table(n:integer;xm,ym,xm2,ym2:kord);
var dx,j,x,y:integer;
st,stx,sty:string;
begin
setcolor(blue);
for j:=0 to ((n+ n mod 77)*2 div 77) do begin
rectangle(1+j*80,0,15+j*80,479);
rectangle(15+j*80,0,47+j*80,479);
rectangle(47+j*80,0,80+j*80,479);
line(1+j*80,10,80+j*80,10);
if j=(n div 77) then setcolor(red);
end;
x:=0;
y:=0;
dx:=((n div 77)+1)*80;
for i:=1 to n do begin
setcolor(blue);
str(i,st);
str(xm[i]:3:3,stx);
str(ym[i]:3:3,sty);
settextstyle(2,0,2);
outtextxy(3+x,5+i*6-y,st);
outtextxy(3+15+x,5+i*6-y,stx);
outtextxy(3+47+x,5+i*6-y,sty);
setcolor(red);
str(xm2[i]:3:3,stx);
str(ym2[i]:3:3,sty);
outtextxy(3+x+dx,5+i*6-y,st);
outtextxy(3+15+x+dx,5+i*6-y,stx);
outtextxy(3+47+x+dx,5+i*6-y,sty);
for j:=1 to (n div 77)+1 do
if i=77*j then begin
setcolor(blue);
settextstyle(2,0,4);
outtextxy(5+x,-1,'N');
outtextxy(5+15+x,-1,'X');
outtextxy(5+47+x,-1,'Y(x)');
setcolor(red);
outtextxy(5+x+dx,-1,'N');
outtextxy(5+15+x+dx,-1,'X');
outtextxy(5+47+x+dx,-1,'F(x)');
x:=x+80;y:=y+462;
end;
end;
readln;
readln;
setfillstyle(1,0);
bar(0,0,640,480);
setcolor(15);
end;
procedure load_from_file;
var xm,ym,xm2,ym2:kord;
f:text;
begin
assign(f,route);
reset(f);
readln(f,n);
for i:=1 to n do begin
readln(f,xm[i],ym[i],xm2[i],ym2[i]);
end;
close(f);
table(n,xm,ym,xm2,ym2);
readln;
grafic(n,xm,ym,xm2,ym2);
end;
procedure rec_to_file(n:integer;xm,ym,xm2,ym2:kord);
begin
assign(f,route);
rewrite(f);
writeln(f,n);
for i:=1 to n do
writeln(f,xm[i],' ',ym[i],' ',xm2[i],' ',ym2[i]);
close(f);
end;
procedure func_calc;
var x,y,x2,y2,a,b,c,xna4,xkon:real;
h,j:integer;
xm,ym,xm2,ym2:kord;
begin
writeln('Vvesti novble parametrbl ??? Enter Y/N ???');
read(ch);
if ch='y' then begin
writeln('Vvedite koefficient B, kol-vo to4ek, na4albnble i kone4nble zna4eni9 X');
a:=0;
write(' B: ');readln(b);
write('Kol-vo: ');read(n);
write('Na4albnoe X:');read(xna4);
write('Kone4noe X:');read(xkon);
x:=xna4;
j:=1;
i:=1;
repeat
h:=0;
y:=cos(x)+b;
ym[i]:=y;
xm[i]:=x;
c:=1;
y2:=c;
while abs(c)>eps do
begin
c:=c*(-(sqr(x)/((h+1)*(h+2))));
y2:=y2+c;
h:=h+1;
end;
xm2[i]:=x;
ym2[i]:=y2;
j:=j+1;
i:=i+1;
x:=x+((xkon-xna4)/(n-1));
until j>n;
rec_to_file(n,xm,ym,xm2,ym2);
end;
end;
begin
clrscr;
func_calc;
dr:=detect;
initgraph(dr,dm,'');
load_from_file;
readln;
closegraph;
end.
