графика в паскале

[patriarch]

помогите пожалуйста.Как сделать так чтобы результат компиляции подольше задерживался на экране?ну то есть он быстро выдает значения и рисует графику, а потом закрывается.Что делать?

Uses Graph,Crt;
type ttt=array[0..1300]of double;
var x, xt, yt, ya, yc, ye:ttt;

    ea,ec,ee: double;                  {pogreshnosti}
    a, b, e, h, p: double;
    ch, sh:char;
    n, i, j, k, grad:integer;
    ff:text;

procedure graphic(init: integer; Ymin,Ymax: real; y,x:ttt;
                  n,color,typ : integer; s: string);
const maxx=1450; maxy=850;
var
tnum: string;
nz,r,m,p,i,j,kl,kr,kt,kb,kf,k0,kbf,kx,ky,p0: integer;
a1,hst,xma,xmi,yma,ymi,z: real;
begin
 nz:=6;   { kolichestvo yacheek v setke }
 r:=0;
 kl:=60;  { otstup po x }
 kt:=40;  { otstup po y }
 kr:=maxx-40;
 kb:=maxy-40;
 kx:=kr-kl;
 ky:=kb-kt;
 if(init=1) then
   begin
   xma:=b;
   xmi:=a;
   yma:=y[1];
   ymi:=y[1];
   if(not((Ymin=0) and (Ymax=0))) then
                   begin
                   ymi:=Ymin;yma:=Ymax
                   end
                                  else
                                  begin
                                  for i:=0 to n do
                                    begin
                                    if(y[i]<ymi) then ymi:=y[i];
                                    if(y[i]>yma) then yma:=y[i]
                                    end;
                                  a1:=abs(yma-ymi);
                                  yma:=yma+0.1*a1;
                                  ymi:=ymi-0.1*a1
                                  end;
   { vkluchaem grafiku }
   m:=detect;  {i:=egahi;}  initgraph(m,i,'c:\bp\bgi');
   { pereschityvaem koordinaty }
   cleardevice;
   setfillstyle(1,0);
   bar(2,2,maxx-2,maxy-2);
   setcolor (7);
   hst:=(yma-ymi)/nz;
   z:=yma;
   kf:=kt;
   p:=round(1.0/nz*ky);
   a1:=abs(z);
   j:=0;
   if(a1<1)then
             begin
             while(a1<1)do
                    begin j:=j-1;
                    a1:=a1*10
                    end
             end
          else
          if(a1>10)then
              begin
              while(a1>10)do
                  begin
                  j:=j+1;
                  a1:=a1/10;
                  end;
              end;
   for i:=0 to nz do
       begin
       a1:=z*exp(-j*ln(10));
       str(a1:3:4,tnum);
       kbf:=textwidth(tnum)+6;
       moveto(kl-kbf, kf-6);
       outtext(tnum);
       line(kl,kf,kr,kf);
       z:=z-hst;
       kf:=kf+p
       end;
   moveto(kl-kbf, 15);
   str(j,tnum);
   outtext('1xE');
   moveto(kl-kbf+25, 15);
   outtext(tnum);
   hst:=(xma-xmi)/nz;
   z:=xmi;
   kf:=kl;
   p:=round(1.0/nz*kx);
   for i:=0 to nz do
       begin
              a1:=abs(z);
              if(a1<10.0) then j:=2  else if(a1<100.0) then j:=1 else j:=2;
              str(z:4:j,tnum);
              kbf:=textwidth(tnum)+2;
              moveto(kf-kbf div 2,kb+4);
              outtext(tnum);
              line(kf,kb,kf,kt);z:=z+hst;
              kf:=kf+p
       end;
   p0:=kl+10
   end;{end of "init"}
   setcolor(color);
   hst:=kx/(xma-xmi);
   a1:=ky/(yma-ymi);
   j:=0;
   if(typ=0) then j:=0;
   if(typ=1) then j:=3;
   if(typ=2)then j:=1;
   setlinestyle(j,1,1);
   settextstyle(DEFAULTFONT,HORIZDIR,1);
   kbf:=textwidth(s)+6;
   outtextxy(p0,10,s);
   moveto(p0+kbf,15);
   lineto(p0+kbf+20,15);
   p0:=p0+100;
   for i:=0 to n do
       begin
       k0:= round(kl+(x[i]-xmi)*hst);
       kf:= round(kb-(y[i]-ymi)*a1);
       if(i=0)then moveto(k0,kf);
       if(typ<3)then lineto(k0,kf) else
                                   begin
                                   circle(k0,kf,1);
                                   ellipse(k0,kf,0,360,4,4)
                                   end
       end
   end;

   function gtest(z:double): double;
        begin
        gtest:=sqr(cos(pi*z));
        end;

   function f(u,v:double): double;
        begin
        f:=-pi*sin(2*pi*u)+p*(v-gtest(u));
        end;


   procedure fora;
   begin
      ya[0]:=gtest(a);
      for i:=1 to n do
        ya[i]:=ya[i-1]+h*f(x[i-1],ya[i-1]);
   end;

   procedure forc;
   var k1, k2: double;
   begin
      yc[0]:=gtest(a);
      for i:=1 to n do
        begin
        k1:=h*f(x[i-1],yc[i-1]);
        k2:=h*f(x[i-1]+h, yc[i-1]+k1);
        yc[i]:=yc[i-1]+(k1+k2)/2;
        end;
   end;

   procedure fore;
   var k1, k2, k3, k4: double;
   begin
      ye[0]:=gtest(a);
      for i:=1 to n do
        begin
        k1:=h*f(x[i-1],yc[i-1]);
        k2:=h*f(x[i-1]+h/3, ye[i-1]+k1/3);
        k3:=h*f(x[i-1]+2/3*h, ye[i-1]+2/3*k2);
        ye[i]:=ye[i-1]+(k1+3*k2)/2;
        end;
   end;

[patriarch]

продолжение.Так как форум решил что слишком много символов

   function pogr(uhty:ttt):double;
   var max: double;
   begin
        max:=0;
        for k:=1 to n do
           if abs(uhty[k]-gtest(a+k*h)) > max then max:=abs(uhty[k]-gtest(a+k*h));
        pogr:=max;
   end;

   procedure tab;
   begin
      for i:=1 to 5 do
        begin
           ea:=pogr(ya);
           ec:=pogr(yc);
           ee:=pogr(ye);
           writeln('n=',n,'  ea=',ea:12,'  ec=',ec:12,'  ee=',ee:12);
           n:=n*2;
           fora; forc; fore;
        end;
   end;

begin
   clrscr;
   a:=0;                  {nachalo otrezka}
   b:=1;                  {konec otrezka}
   n:=20;                 {delaem srazy ravnomernuy setku,kol-vo uzlov n+1}
   h:=(b-a)/(n+1);        {shag setki}
   grad:=50;
   p:=7;
   for i:=0 to grad do
        begin
        xt[i]:=a+i*(b-a)/(grad+1);
        yt[i]:=gtest(xt[i]);
        end;
   {(xt,yt)-eto koordinaty testovogo grafika}
   for i:=0 to n do
        x[i]:=a+i*h;

   fora; forc; fore;

  ea:=pogr(ya);
   ec:=pogr(yc);
   ee:=pogr(ye);
   writeln('n=',n,'  ea=',ea:12,'  ec=',ec:12,'  ee=',ee:12);

   graphic(1,0,0,yt,xt,grad,11,0,'test');
   graphic(0,0,0,ya,x,n,10,0,'a');
   graphic(0,0,0,yc,x,n,4,0,'c');
   graphic(0,0,0,ye,x,n,5,0,'e');

   writeln('p=',p:4);
   if n<=20 then
        begin
        for j:=0 to n do
                begin
                writeln('j=',j:3,'  ya=',ya[j]:12,'  yc=',yc[j]:12,'  ye=',ye[j]:12, '  ytest=',gtest(a+j*h):12);
                end;
        end;
   writeln;

   for j:=1 to 8  do
        begin
           ea:=pogr(ya);
           ec:=pogr(yc);
           ee:=pogr(ye);
           writeln('n=',n:5,'  ea=',ea:10,'  ec=',ec:12,'  ee=',ee:14);
           if n=1300 then break;
           n:=n*2;
           if n>1300 then n:=1300;
           h:=(b-a)/(n+1);
           for i:=0 to n do
           x[i]:=a+i*h;
           fora; forc; fore;
        end;

 sh:=readkey;
closegraph;
end.

[Serge_Bliznykov]

в цикле при отрисовке используйте задержку
это команда Delay(число_миллисекунд);
К сожалению, на современных компьютерах эта функция отрабатывает в десятки раз быстрее, чем должна.
Для того, чтобы с этим бороться надо:

или (предпочтительно) использовать патченный TURBO.TPL
(его тут на форуме выкладывал Puporev, пользуясь случаем хочу ещё раз сказать за него спасибо!)

или использовать такую функцию вместо стандартной Delay:

procedure MyDelay(HundSecond : longInt);
var
  Ticks      : LongInt  absolute 0:$46c;
begin
  HundSecond:=round(HundSecond * 0.185) +Ticks;
  repeat  until (Ticks>HundSecond);
end;

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

[patriarch]

Сообщение от Serge_Bliznykov

в цикле при отрисовке используйте задержку
это команда Delay(число_миллисекунд);
К сожалению, на современных компьютерах эта функция отрабатывает в десятки раз быстрее, чем должна.
Для того, чтобы с этим бороться надо:

или (предпочтительно) использовать патченный TURBO.TPL
(его тут на форуме выкладывал Puporev, пользуясь случаем хочу ещё раз сказать за него спасибо!)

или использовать такую функцию вместо стандартной Delay:

procedure MyDelay(HundSecond : longInt);
var
  Ticks      : LongInt  absolute 0:$46c;
begin
  HundSecond:=round(HundSecond * 0.185) +Ticks;
  repeat  until (Ticks>HundSecond);
end;

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

это писать после каждой отрисовки? то есть после каждого moveto и lineto или можно перед closegraph написать?
Дело в том что сдавать программу надо в терминальном классе и там мне никто не даст поставить патченный паскаль...

[Serge_Bliznykov]

и там мне никто не даст поставить патченный паскаль...

если папка C:\BP\Bin Вам доступна для записи, то никто Вам не запретит переписать туда свой файл, вместо имеющегося там...
Впрочем, Вам виднее.. Кстати, если Вы откомпилируете EXE-шник с "правильным" turbo.tpl - то потом он будет корректно работать на любой машине. Можете откомпилировать EXE-шник дома....

это писать после каждой отрисовки? то есть после каждого moveto и lineto

да. именно после отрисовки! ну, не после каждого оператора вывода графики, а только после тех команд отрисовки (обычно они используются в цикле), которые Вам хотелось бы увидеть "замедленно" - т.е. чтобы линия (объект, рисунок, график и т.д.) возник не мгновенно, а появлялся постепенно...
я ведь правильно понял, что Вам нужно?

p.s. программа у меня отказалась запускаться с размером стека по умолчанию, а когда сделал ей стек побольше, запустилась, но в нижней части была выведена полоса непонятного мусора.
Так и должно быть?!

вот, примерно так у меня выглядит:

[patriarch]

нет.Мне нужно не чтобы отрисовывался постепенно, а чтобы он нарисовался и не исчезал очень быстро...
Нет такой полосы быть не должно.

[Serge_Bliznykov]

а чтобы он нарисовался и не исчезал очень быстро...

у Вас так и сделано!

sh:=readkey;

ожидает нажатия ЛЮБОЙ клавиши, после этого закрывает графический режим.
Либо не нажимайте клавиши во время выполнения программы,
либо замените эту строчку на банальный
ReadLn;
тогда программа будет ждать, пока не нажмут Enter и только после этого закроется.

А то, что я говорил про задержки - Вам не нужно! Извините, что сразу не понял Вас.

Нет такой полосы быть не должно

Ну, извините, но она есть... Думаю, что где-то ошибка в границах цикла... отлаживать мне лично, лень... Да и Вам отлаживать проще - Вы же сами это писали, понимаете, где что...

[patriarch]

Эм, ну лично у меня он отрисовывает графику и очень быстро закрывает ее....что я делаю не так?

[D61C76h]

После того как твоя графика была отрисована (в конце главной программы) вставь конструкцию

repeat
until KeyPressed;

Так ты запустишь бесконечный цикл, который завершиться по нажатию любой клавиши и завершит программу.

[Serge_Bliznykov]

не знаю....
на readln; пробовали менять sh:=readkey; ?
не помогло?
Попробуйте воспользоваться эмулятором DOS режима - программой DOSBOX (правда, с ней надо немножко разобрать - как её установить и как ей пользоваться, но зато она позволить исключить возможные проблемы, связанные с неверной отработкой DOS программ в Вашей Windows)...