IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

> Работа с двумя графиками, Проблемы с масштабированием
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 16
Пол: Мужской
Реальное имя: Кудрявцев Александр

Репутация: -  0  +


Итак, вот есть задачка! Построить 2 графика, отмасштабированных и вывести таблицу значений...и всё это через файл
Программка рисует графики, масштабирует, да только неправильно! К 4 часам утра не могу найти проблему... А сдавать в 12... smile.gif Думаю, ни у одного меня возникнут вопросы с такими вот программами... Помогите найти ошибку (почему-то 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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Гуру
*****

Группа: Пользователи
Сообщений: 1 117
Пол: Мужской
Реальное имя: Богдан

Репутация: -  11  +


Цитата
Помогите найти ошибку (почему-то cos0 для программы не 1, а 0,5)...

В паскале тригонометрические функции работают с радианным представлениям угла...


--------------------
Лао-Цзы :
Знать много и не выставлять себя знающим есть нравственная высота. Знать мало и выставлять себя знающим есть болезнь. Только понимая эту болезнь, мы можем избавиться от нее.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 16
Пол: Мужской
Реальное имя: Кудрявцев Александр

Репутация: -  0  +


Цитата(Bokul @ 18.01.2007 5:07) *

В паскале тригонометрические функции работают с радианным представлениям угла...

Ясненько, а что? из-за этого изменится его значение? Напомните плиз как его перевести в градусы. Но мне не верится! Дело в том, что 2 график - это разложение в ряд Тейлора того же самого косинуса! И в точке "0" они соввпадают, но лежат не на единичке! sad.gif

Сообщение отредактировано: Pilotchik -
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
Pilotchik   Работа с двумя графиками   18.01.2007 8:44
Lapp   Думаю, ни у одного меня возникнут вопросы с таким…   18.01.2007 8:57
Pilotchik   О, да, не у одного. Первый вопрос: как насчет фай…   18.01.2007 9:02
Bokul   В паскале тригонометрические функции работают с…   18.01.2007 9:07
Pilotchik   В паскале тригонометрические функции работают с р…   18.01.2007 9:08
Bokul   Ты хотел сказать в радианы? function rad(q:rea…   18.01.2007 9:20
Pilotchik   так в том-то и дело! Показываем преподу, а он …   18.01.2007 9:23
volvo   Приведи описание ВСЕХ вводимых в программу данных.…   18.01.2007 15:24
Pilotchik   Приведи описание ВСЕХ вводимых в программу данных…   19.01.2007 0:43
Pilotchik   Задачка же интересная! Ну посмотрите, пожалуйс…   19.01.2007 5:59
Lapp   Задачка же интересная! Ну посмотрите, пожалуй…   19.01.2007 6:06
Pilotchik   Всё ясно, я ж тоже не сидел просто так, сюда обрат…   19.01.2007 7:11
Pilotchik   Посмотрите, очень надо.. если бы были web-money, з…   20.01.2007 2:24
volvo   Спортивный интерес? А как, по-твоему, разбираться …   20.01.2007 2:43
Pilotchik   Итак,хорошенько раскинув мозгами и почитав наконец…   22.01.2007 5:37


 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 29.03.2024 22:44
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name