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

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

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

> Помогите дописать программу..., График... сжатие/растяжение
сообщение
Сообщение #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 килобайт ) Кол-во скачиваний: 236


--------------------
PhotoShop & Progr@mming FOREVER!!!
!!!Resist@nce is futule!!!
by Mr.L@mbert_13....
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
 
 Ответить  Открыть новую тему 
Ответов
сообщение
Сообщение #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

 





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