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

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

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

> Помогите дописать программу..., График... сжатие/растяжение
Mr.L@mbert_13
сообщение 12.04.2007 23:44
Сообщение #1





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

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


Всем, доброго времени суток! У меня такая трабла с реализацией некоторых функций программы
Я написал программу постоения графика на заданном промежутке... Не могу, точнее не умею, сделать сжатие растяжение графика вдоль оси ОХ ("-"-сжатие, "+"-растяжение), и постраничный вывод таблицы значений... sad.gif
Так основной код построения графика вот он (кое что там в коментаторных скобках эт то что я уже пробывал проэксперементировать):
Код
Procedure Graphik (Var c:char;min,max:real;S1:string);
Var DM,DG:integer;
     {Mx,My:real;}
     x1,y1:integer;
     x,y:integer;
     i:byte;
     b:integer;
     s:string;
     {k:char;}
begin
  {Mx:=1;
  My:=1;
  Repeat}
  If min=max then ERROR (c) Else begin
  DM:=detect;
  DG:=0;
  InitGraph (DM,DG,'G:\BP\BGI');
  If GraphResult=GrOK then
   begin
    x1:=GetMaxX div 2;
    y1:=GetMaxY div 2;
    SetColor (White);
    Line (0,y1,640,y1);
    Line (x1,0,x1,480);
    SetColor (black);
    SetTextStyle (4,0,0);
    Bar (0,445,310,480);
    OutTextXY (10,437,S1);
    b:=-1;
    Str (b,s);
    {Repeat
    If k=#45 then a:=a*0.9;
    If k=#43 then a:=a*1.1;}
    SetTextStyle (2,0,0);
    For i:=1 to 30 do
     begin
      SetColor (blue);
      line (x1-20*i,y1-2,x1-20*i,y1+2);
      OutTextXY (x1-20*i-5,y1+5,s);
      dec(b);
      Str (b,s);
     end;
    b:=1;
    Str (b,s);
    For i:=1 to 30 do
     begin
      line (x1+20*i,y1-2,x1+20*i,y1+2);
      OutTextXY (x1+20*i,y1+5,s);
      inc(b);
      Str (b,s);
     end;
    b:=8;
    str (b,s);
    For i:=0 to 17 do
     begin
      line (x1-2,30*i,x1+2,30*i);
      OutTextXY (x1+5,30*i,s);
      dec (b);
      str (b,s);
     end;
    Repeat
     x:=Round(20*min)+x1;
     y:=-(Round(30*min/(1-sqr(min)+0.0005)))+y1;
     min:=min+0.05;
     PutPixel (x,y,red);
    Until min>max;
    { k:=readkey;
    Until (k=#27) or (k=#43) or (k=#45);}
    end Else
     begin
      OKHO_MAIN;
      OKHO2;
      GoToXY (30,1);
      Write (S1);
      OKHO1;
      GoToXY (4,6);
      TextColor (Red);
      Write ('Module "GRAPH" not found.');
     end;
    Repeat
     c:=Readkey;
    Until (c=#27){ or (c=#45) or (c=#61)};
    {If c=#45 then Mx:=Mx*0.7;
    If c=#61 then Mx:=Mx*1.5;}
  end;
  {Until c=#27;}
  CloseGraph;
end;



Помогите, плиз... Заодно прикрепляю архив с файлами .pas и .exe... Заранее, спс...
Прикрепленный файл  proga.rar ( 20.26 килобайт ) Кол-во скачиваний: 318


--------------------
PhotoShop & Progr@mming FOREVER!!!
!!!Resist@nce is futule!!!
by Mr.L@mbert_13....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
volvo
сообщение 13.04.2007 1:18
Сообщение #2


Гость






Ну, с растяжением/сжатием графика проблема решается достаточно просто:

procedure graphik(var c: char; min, max: real;
s1: string);

var
DM, DG: integer;
x1, y1: integer;
x, y: integer;
i: byte;
s: string;

value, mult_x: real;
finished: boolean;
ch: char;

begin

if min = max then ERROR©
else begin

mult_x := 1.0;
DM := detect; DG := 0;

InitGraph (DM,DG,'G:\BP\BGI');
{ InitGraph (DM,DG,''); }

If GraphResult = grOK then begin

finished := false;
repeat
cleardevice;
x1 := GetMaxX div 2;
y1 := GetMaxY div 2;
SetColor(White);
Line(0, y1, 640, y1);
Line(x1, 0, x1, 480);
SetColor(Black);
SetTextStyle(4, 0, 0);
Bar(0, 445, 310, 480);
OutTextXY(10, 437, S1);

SetTextStyle(2, 0, 0);
for i := 1 to 30 do begin
SetColor(Blue);
Line(Trunc(x1-mult_x*20*i), y1-2, Trunc(x1-mult_x*20*i), y1+2);
str(-i, s);
OutTextXY(Trunc(x1-mult_x*20*i-5), y1+5, s);
end;

for i:=1 to 30 do begin
line(Trunc(x1+mult_x*20*i), y1-2, Trunc(x1+mult_x*20*i), y1+2);
str(i, s);
OutTextXY(Trunc(x1+mult_x*20*i), y1+5, s);
end;

for i := 0 to 17 do begin
line(x1-2, 30*i, x1+2, 30*i);
str(8 - i, s);
OutTextXY(x1+5, 30*i, s);
end;

value := min;
repeat
x := Round(20*value*mult_x)+x1;
y := -(Round(30*value/(1-sqr(value)+0.0005)))+y1;
value := value + 0.05;
PutPixel(x, y, red);
until value > max;

repeat
ch := readkey;
case ch of

#45: mult_x := mult_x - 0.1; { minus }
#61: mult_x := mult_x + 0.1; { plus }
#27:
finished := true;

end;
until ch in [#45, #61, #27];

until finished;

end
else begin
OKHO_MAIN;
OKHO2;
GoToXY(30, 1);
Write(S1);
OKHO1;
GoToXY(4, 6);
TextColor(Red);
Write('Module "GRAPH" not found.');
end;

end;
closegraph;
end;

Постраничный вывод - скорее всего завтра, если никто раньше не поможет...
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 



- Текстовая версия 24.06.2025 4:10
Хостинг предоставлен компанией "Веб Сервис Центр" при поддержке компании "ДокЛаб"