Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Помогите дописать программу...

Автор: Mr.L@mbert_13 13.04.2007 3:44

Всем, доброго времени суток! У меня такая трабла с реализацией некоторых функций программы
Я написал программу постоения графика на заданном промежутке... Не могу, точнее не умею, сделать сжатие растяжение графика вдоль оси ОХ ("-"-сжатие, "+"-растяжение), и постраничный вывод таблицы значений... 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 килобайт ) Кол-во скачиваний: 234

Автор: volvo 13.04.2007 5:18

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

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;

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

Автор: Mr.L@mbert_13 14.04.2007 15:02

2 volvo: За сжатие/растяжение спс огромное... Всё работает... good.gif smile.gif по тому же принципу сделал 1.gif сжатие и растяжение вдоль OY. Но появился вопросик: А что за команда cleardevice? И что она даёт?

Автор: Артемий 14.04.2007 17:31

Цитата
А что за команда cleardevice?

Это процедура очищает граф. экран..

Автор: Mr.L@mbert_13 15.04.2007 15:14

А постраничный вывод никто не поможет сделать??? !help.gif sad.gif плиз...

 
Procedure Output (min,max,st:real);
Const t5='H/C';
Var y:real; k,i:byte;
begin
i:=3;
TextColor (Green);
k:=1;
While min<=max do
Begin
If (i>18) then begin k:=40; i:=3; end;
If (min>0.9999) and (min<1.0001) or (min>-1.0001) and (min<-0.9999)
then begin
GoToXY (k,i);
WriteLn (min:13:3,t5:13);
min:=min+st;
i:=i+1;
end
else begin
y:=min/(1-min*min);
GoToXY (k,i);
writeLn (min:13:3,y:13:3);
min:=min+st;
i:=i+1;
end;
end;
end;

Procedure Tab (Xmn,Xmx,st:real);
var c:char;
begin
If Xmin=Xmax then ERROR Else begin
OKHO_MAIN;
TextColor (White);
GoToXY (23,1);
Write ('TA6JluCa (Xmin=',Xmn:4:3,',Xmax=',Xmx:4:3,',step=',st:4:3,')');
Output (Xmn,Xmx,st);
OKHO2;
GoToXY (35,1);
Write ('ESC - return to MENU');
Repeat
c:=Readkey;
Until c=#27;
end;
end;


Автор: volvo 15.04.2007 19:21

Зачем тебе постраничный вывод, если всех данных может быть максимально 30, что прекрасно помещается в твои 2 столбца по 18 записей?

Ну, в принципе, конечно нет проблем, только по-моему это лишнее:

procedure Output(min, max, st: real);
const t5 = 'H/C';
var
y: real; k, i: byte;
value: real;
curr: integer;

begin
curr := 0;
value := min;

while value < (max + st / 2) do begin

gotoxy(1, 3 + (curr mod 18));

If (abs(value - 1) < 0.01) or
(abs(value + 1) < 0.01) then writeLn(value:13:3, t5:13)
else begin

y := value / (1 - sqr(value));
writeLn(value:13:3, y:13:3);

end;
value := value + st;
inc(curr);

if curr mod 18 = 0 then begin
repeat until keypressed;
while keypressed do readkey;
end;

end;

end;

(Tab не изменяется...)

Автор: Mr.L@mbert_13 16.04.2007 11:18

Да дело в том что элементов должно быть больше... Это я собственноручно ограничил STEP не мешьне единицы.... А так должен быть постраничный вывод и никаких столбцов.... С возможностью перехода на первую и последнюю страницу....