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


просто человек
******

Группа: Пользователи
Сообщений: 3 641
Пол: Женский
Реальное имя: Юлия

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


ну, еще бывают циклы с постусловием - это если говорить о первом случае.
  while true do begin
c := ReadKey;
if Ord( с ) = 27 then
halt;
if Ord( c ) = 0 then
begin
c := ReadKey;
if Ord( с ) = 75 then
xkoef := xkoef * 1.2
else
if Ord( с )= 77 then
xkoef := xkoef / 1.2
else
continue;
break;
end;

то есть выход из цикла происходит во вполне определенном случае - при ord( с )=77 или 75. так? почему бы это не сделать while (ord( с )<>77) and (ord( с )<>75), считав заранее первое с?я еще лучше - вообще в постусловие засунуть. Тогда и continue не нужно - мы в любом случае перейдем на следующий проход (кроме с=27, но это совсем другое).
хотя, конечно, лучшая программа - это работающая программа....

Сообщение отредактировано: volvo -


--------------------
Все содержимое данного сообщения (кроме цитат) является моим личным скромным мнением и на статус истины в высшей инстанции не претендует.
На вопросы по программированию, физике, математике и т.д. в аське и личке не отвечаю. Даже "один-единственный раз" в виде исключения!
 Оффлайн  Профиль  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

 





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