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

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

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

> Сжатие и растяжение графика
сообщение
Сообщение #1


Пионер
**

Группа: Пользователи
Сообщений: 75
Пол: Мужской

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


Вот значит написал программу выводящую на экран график функции, оси, деление и подпись осей....
Помогите плиз организовать сжатие и растяжение графика вдоль оси Ох: т.е. при нажатии стрелки вправо - растяжение, стрелка влево - сжатие...
Код

uses Crt, Graph;
var
x,y,h:real;
I1,I2,J1,J2,k:integer;
x1,x2,y1,y2:integer;
i,n,j:integer;
s:string;
driver,Regim:integer;

function II(x:real):Integer;
begin
  II:=I1 + Trunc ((x-x1)*(I2-I1)/(x2-x1))
end;

function JJ(y:real):Integer;
begin
  JJ:=J1 + Trunc ((y-y1)*(J2-J1)/(y2-y1))
end;

begin
n:=30;
x1:=-3;x2:=5;
y1:=-7;y2:=2;
I1:=10;I2:=400;
j1:=10;J2:=300;
h:=(x2-x1)/n;
driver:=VGA;
Regim:=1;
InitGraph(Driver,Regim,'');
SetColor(blue);
SetFillStyle(blue,yellow);
Bar(I1,J1,I2,J2);
rectangle(I1,J1,I2,J2);
SetColor(LightRed);

MoveTo(II(x1),JJ(0));LineTo(II(x2),JJ(0));
MoveTo(II(0),JJ(y1));LineTo(II(0),JJ(y2));

for i:=x1 to x2 do
begin
  PutPixel(II(x1+i+3),JJ(0),15);  {cena deleniya}
  str(i,s);
  OutTextXY(II(x1+i+3-0.05),JJ(0.1),s)
end;

for j:=y1 to y2 do   {-5,1}        
begin
  if j=0 then
  else
   begin
    str(-j,s);
    PutPixel(II(0),JJ(y1+j+(-y1)),15);      {думаю, что в этом цикле ошибка}
    OutTextXY(II(0.1),JJ(y1+j+(-y1)),s)
   end
end;

OutTextXY(II(x2),JJ(0.1),'x');
Line(II(x2),JJ(0),II(x2-0.1),JJ(0+0.05));
Line(II(x2),JJ(0),II(x2-0.1),JJ(0-0.05));

OutTextXY(II(-0.2),JJ(y1-0.18),'y');
Line(II(0),JJ(y1),II(0.1),JJ(y1+0.15));
Line(II(0),JJ(y1),II(-0.1),JJ(y1+0.15));
SetBkColor(white);
SetColor(green);x:=x1;y:=sqrt(x*x+2);
MoveTo(II(x),JJ(-y));

for i:=1 to n do
begin
   x:=x+h;
   y:=sqrt(x*x+2);
   LineTo(II(x),JJ(-y))
  end;
readln;
closegraph
end.


--------------------
Ну, а почему бы в свободное время не позаниматься программированием?
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #2


Michael_Rybak
*****

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

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


Изменения:

1. x1, y1, x2, y2 стали типа real

2. Добавил цикл, о котором ты говоришь ("чтобы справиться с этой задачей, нужно организовать цикл...")

3. В тело цикла перенес инициализацию x1, x2, y1, y2, h и n. Область вывода (I1, J1, I2, J2) остается неизменной, меняется (по x) только часть графика, которую мы туда впихиваем. n меняем, потому что с увеличением масштаба точки улетают высоко вверх, а видимая часть рисуется с плохой детализацией.

4. Вот в этом цикле:

for i:=x1 to x2 do
begin
PutPixel(II(x1+i+3),JJ(0),15); {cena deleniya}
str(i,s);
OutTextXY(II(x1+i+3-0.05),JJ(0.1),s)
end;


Во-первых, добавил округление x1 и x2, т.к. они теперь дробные. Во-вторых, вместо x1+i-3 оставил просто i, потому что x1+3 изначально у тебя равно 0, а при масштабировании нужно было бы тройку домножать на коеффициент. На самом деле это не нужно:

for i:=trunc(x1)-1 to trunc(x2)+1 do
begin
PutPixel(II(i),JJ(0),15); {cena deleniya}
str(i,s);
OutTextXY(II(i-0.05),JJ(0.1),s)
end;


5. То же самое с циклом по Y. Ошибки там, мне кажется, нету. Ты все правильно понял, когда написал y1+j+(-y1). Именно это я имел ввиду в предыдущем пункте.

6. При обработке клавиш курсор_влево и курсов_вправо делаем то, что сказала мисс_граффити


uses Crt, Graph ;
var
x,y,h:real;
I1,I2,J1,J2,k:integer;
x1,x2,y1,y2:real;
i,n,j:integer;
s:string;
driver,Regim:integer;

xkoef: real;

c: char;

function II(x:real):Integer;
begin
II:=I1 + Trunc ((x-x1)*(I2-I1)/(x2-x1))
end;

function JJ(y:real):Integer;
begin
JJ:=J1 + Trunc ((y-y1)*(J2-J1)/(y2-y1))
end;

begin
I1:=10;I2:=400;
j1:=10;J2:=300;
driver:=VGA;
Regim:=1;
InitGraph(driver,regim,'');

xkoef := 1.0;

while true do begin

n:=trunc(30*xkoef);
x1:=-3*xkoef;x2:=5*xkoef;
y1:=-7;y2:=2;
h:=(x2-x1)/n;


SetColor(blue);
SetFillStyle(blue,yellow);
Bar(I1,J1,I2,J2);
rectangle(I1,J1,I2,J2);
SetColor(LightRed);

MoveTo(II(x1),JJ(0));LineTo(II(x2),JJ(0));
MoveTo(II(0),JJ(y1));LineTo(II(0),JJ(y2));

for i:=trunc(x1)-1 to trunc(x2)+1 do
begin
PutPixel(II(i),JJ(0),15); {cena deleniya}
str(i,s);
OutTextXY(II(i-0.05),JJ(0.1),s)
end;

for j:=trunc(y1)-1 to trunc(y2)+1 do {-5,1}
begin
if j=0 then
else
begin
str(-j,s);
PutPixel(II(0),JJ(j),15);
OutTextXY(II(0.1),JJ(j),s)
end
end;

OutTextXY(II(x2),JJ(0.1),'x');
Line(II(x2),JJ(0),II(x2-0.1),JJ(0+0.05));
Line(II(x2),JJ(0),II(x2-0.1),JJ(0-0.05));

OutTextXY(II(-0.2),JJ(y1-0.18),'y');
Line(II(0),JJ(y1),II(0.1),JJ(y1+0.15));
Line(II(0),JJ(y1),II(-0.1),JJ(y1+0.15));
SetBkColor(white);
SetColor(green);x:=x1;y:=sqrt(x*x+2);
MoveTo(II(x),JJ(-y));

for i:=1 to n do
begin
x:=x+h;
y:=sqrt(x*x+2);
LineTo(II(x),JJ(-y))
end;

while true do begin
c := ReadKey;

if Ord( c ) = 27 then
halt;

if Ord( c ) = 0 then begin
c := ReadKey;
if Ord( c ) = 75 then
xkoef := xkoef * 1.2
else if Ord( c ) = 77 then
xkoef := xkoef / 1.2
else
continue;

break;
end;

end;
end;

readln;
closegraph
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

Сообщений в этой теме
}0pa   Сжатие и растяжение графика   22.10.2006 17:36
}0pa   Да,я понимаю, что это нудная задачка...Ну, помогит…   23.10.2006 17:00
мисс_граффити   а у тебя тот код, что ты привел, нормально компили…   23.10.2006 17:06
}0pa   Ну,помогите вставить этот кфц. в нужную часть кода…   26.10.2006 4:33
мисс_граффити   ну ты сам хоть попробуй что ли. для приличия. и о…   26.10.2006 4:37
}0pa   Начнем с того, что эту прогу я сам написал. Но, по…   26.10.2006 11:28
мисс_граффити   молодец. у меня твой код НЕ компилируется. Вообще.…   26.10.2006 16:18
Michael_Rybak   Изменения: 1. x1, y1, x2, y2 стали типа real 2. …   26.10.2006 18:33
}0pa   Спасибо, за прекрасное объяснение. Я бы тебе плюсе…   26.10.2006 23:04
}0pa   while true do begin Что значит это?   28.10.2006 22:37
мисс_граффити   while true do begin Что значит это? вечный цикл…   28.10.2006 22:48
Michael_Rybak   У меня "шлейф" остается только снаружи…   28.10.2006 23:12
мисс_граффити   ну, еще бывают циклы с постусловием - это если гов…   28.10.2006 23:59


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

 





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