Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Паскаль, Turbo Pascal, PascalABC.NET
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 20.06.2011, 09:58   #1
kavai^^
Новичок
Джуниор
 
Регистрация: 20.06.2011
Сообщений: 1
Вопрос надо составить блок-схему в паскаль!!! за вознограждение)))

Код:
program Kursovik_5;
  uses graph;
  type mas1 = array[1..1010] of real;
       mas2 = array[1..1010] of integer;
       mas3 = array[1..20] of real;
       mas4 = array[1..20] of string;
  var kx,ky          : mas1;
      xx,yy          : mas2;
      KorX,KorY      : mas3;
      tx,ty          : mas4;
      n,p            : integer;
      x0,y0,h,xk,x,y : real;

  function f(x,y : real) : real;
  begin
   f :=y*sin(2*x)+3.4*x;
  end;

  {metod Runge-Kutta}
  procedure RungeKutta(x0,y0 : real;
               n,p   : integer;
           var kx,ky : mas1);
  var k1,k2,k3,k4,dy : real;
      i,j,t,ii,q     : integer;
  begin
   kx[1] := x0;
   ky[1] := y0;
   x := x0;
   y := y0;
   for i := 0 to n do
    begin
     k1 := h*f(x,y);
     k2 := h*f(x+h/2,y+k1/2);
     k3 := h*f(x+h/2,y+k2/2);
     k4 := h*f(x+h,y+k3);
     dy := (k1+2*k2+2*k3+k4)/6;
     x := x+h;
     y := y+dy;
     kx[i+1] := x;
     ky[i+1] := y;
    end;
   i := 0;
   t := n div p;       
  for i :=0 to n do
    begin
      if i mod 20 = 0 then
         writeln(i:4,'. ','  x=',kx[i]:15:14,'  y=',ky[i]:15:14);
    end;
      writeln('nazhmite ENTER');
      readln;
  end;

  {metod Eilera}
  procedure Eilera(x0,y0,xk,h : real;
               n,p        : integer;
           var kx,ky      : mas1);
  var i,q,j,t,ii : integer;
      x,y        : real;
  begin
   x := x0;
   y := y0;
   kx[1] := x0;
   ky[1] := y0;
   for i := 0 to n do
    begin
     x := x+h;              {h - tochnost}
     y := y+h*f(x,y);
     ky[i+1] := y;
     kx[i+1] := x;
    end;
   i := 0;
   t := n div p;
   for i := 0 to n do
    begin
      if i mod 20 = 0 then
         writeln(i:4,'. ','  x=',kx[i]:15:14,'  y=',ky[i]:15:14);
    end;
      writeln('nazhmite ENTER');
      readln;
 end;

{postroenie grafika}
   procedure PostroenieGrafika(kx,ky : mas1;
                    n     : integer;
                    mx    : real);
   var my,miy,hx,hy          : real;
       j,i,ex,ey,nx,ny       : integer;
       x0,y0,pr,le,g         : integer;
       GraphDriver,GraphMode : integer;
   begin
    my := ky[1];               {my -max Y}
    miy := ky[1];              {miy - min Y}
    {opredelenie max i min X i Y}
    for i := 2 to n do
     begin
      if ky[i]<miy then miy := ky[i];
      if ky[i]>my then my := ky[i];
     end;
    GraphDriver := Detect;
    InitGraph(GraphDriver,GraphMode,'');
    ex :=30;
    ey :=40;
    le :=40;                      
    pr := GetMaxY-40;

    nx := (GetMaxX-le) div ex+4;
    ny := (GetMaxY-le) div ey+1;          
    hx := (ex*nx)/mx;
    hy := (ey*ny)/(my-miy);

    for i := 0 to n do
     begin
      xx[i] := round(hx*(kx[i]))+le-115;
      yy[i] := GetMaxY-round(hy*(ky[i]-miy)/1)-le;
     end;
    SetColor(6);                                 
    SetBkColor(15);                              
    SetLineStyle(0,0,3);                 
    OutTextXY(100, 20, 'reshenie dif yravnenia');
    for i := 1 to (n-1) do
     Line(xx[i],yy[i],xx[i+1],yy[i+1]);
    {sistema koordinat}
    SetColor(5);
    SetLineStyle(0,0,0);
    line(le, 5, le, GetMaxY - 5);                {os OY}
    line(5, pr, GetMaxX - 5, pr);                {os OX}
    for i := 1 to 20 do
     begin
      KorX[i] := 0;
      KorY[i] := 0;
     end;
    KorX[1] := 1;
    tx[1] := '1';
    for i := 2 to nx do
     begin
      KorX[i] := KorX[i-1]+0.34;
      Str(KorX[i]:3:1, tx[i]);
     end;
    KorY[1] := 0;
    ty[1] := '0';
    KorY[1]:=0;
    for i := 2 to ny do
     begin
      KorY[i] := KorY[i-1]+6;
      Str(KorY[i]:3:2, ty[i]);
     end;
    j := le;
    for i := 1 to nx do
     begin
      OutTextXY(j-10, pr+4, tx[i]);
      j := j+ex;
     end;
    g := pr;
    for i := 1 to ny do
     begin
      OutTextXY(le-40, g-10, ty[i]);
      g := g-ey;
     end;
    j := le;
    g := pr;
    for i := 1 to ny do
     begin
      line(le-2, g, le+2, g);
      g := g-ey;
     end;
    j := le;
    for i:=1 to nx do
     begin
      line(j, pr-2, j, pr+2);
      j := j+ex;
     end;
    readln;
    closeGraph;
   end;

   {osnovnaya programma}
   begin
    x0 :=1;       {natchalnoe}
    y0 :=0;       {uslovie}
    xk :=6;        {konechnoe znachenie X}
    h := 0.005;
    n := round((xk-x0)/h);  {kollichestvo povtorenii}
    if n>1000 then
     begin
      writeln('  slshkom malenkii shag');
      halt;                     {ostanovka programmi}
     end;
    p := 22;    {p - kollichestvo strok na ekrane}
    Melera(x0,y0,xk,h,n,p,kx,ky);
    PostroenieGrafika(kx,ky,n,xk);
    RungeKutta(x0,y0,n,p,kx,ky);
    PostroenieGrafika(kx,ky,n,xk);
   end.
______
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Модератор.

Последний раз редактировалось Serge_Bliznykov; 20.06.2011 в 11:33.
kavai^^ вне форума Ответить с цитированием
Старый 20.06.2011, 18:04   #2
maLoy*508
Форумчанин
 
Аватар для maLoy*508
 
Регистрация: 28.03.2008
Сообщений: 672
По умолчанию

пишите - обсудим...
контакты в профиле...
maLoy*508 вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Составить Блок Схему IntelUser Помощь студентам 7 05.03.2011 18:39
Нарисовать блок схему и составить программу Паскаль-строки izi2000 Фриланс 0 12.02.2011 09:23
надо составить блок схему dima.m Помощь студентам 2 30.03.2010 01:40
Помогите пожалуйста решить две задачи по паскалю и составить и составить блок схему! ...Оленька... Паскаль, Turbo Pascal, PascalABC.NET 2 20.01.2009 09:37