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


Уникум
*******

Группа: Пользователи
Сообщений: 6 823
Пол: Мужской
Реальное имя: Лопáрь (Андрей)

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


Цитата(Pilotchik @ 18.01.2007 5:44) *

Думаю, ни у одного меня возникнут вопросы с такими вот программами...

О, да, не у одного.
Первый вопрос: как насчет файла данных graficpr.txt ? Не облагодетельствуешь?..


--------------------
я - ветер, я северный холодный ветер
я час расставанья, я год возвращенья домой
 Оффлайн  Профиль  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

 





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