programy pascal.docx

3

Program 1 tablice i menu repit

uses

  SysUtils;

function stat :real;

    var

     a,b,c,p:real;

     i,n: integer;

     x,y:array [1..10] of real;

      begin

        writeln('podaj n (1-10)');

            a:=0;

            b:=0;

            c:=0;

           repeat

            readln (n)

          until

          (n>0) and (n<=10);

        for  i:=1 to n do

          begin

            writeln('podaj x[',i,'] y[',i,']');

            readln (x[i],y[i]);

            a:=a+x[i]*y[i];

            b:=b+x[i]*x[i];

            c:=c+y[i];

          end;

        p:=a/(sqrt(b)*sqrt(c)+1);

        stat:=p;

      end;

function dyna :real;

    var

     a,b,c,p:real;

     i,n: integer;

     x,y:array of integer;

      begin

        writeln('podaj n');

            a:=0;

            b:=0;

            c:=0;

           repeat

            readln (n)

          until

          (n>0);

            setlength(x,n);

            setlength(y,n);

        for  i:=1 to n-1 do

          begin

            writeln('podaj x[',i,'] y[',i,']');

            readln (x[i],y[i]);

            a:=a+x[i]*y[i];

            b:=b+x[i]*x[i];

            c:=c+y[i];

          end;

        p:=a/(sqrt(b)*sqrt(c)+1);

        dyna:=p;

      end;

      var w:integer;

begin

  repeat

      repeat

        writeln('1. T.Dynamiczne');

        writeln('2. T.Staryczne');

        writeln('3. Zakonczenie');

        readln(w);

      until

      (w=1) or (w=2) or (w=3);

        case w of

          1: writeln (dyna:3:1);

          2: writeln(stat:3:1);

        end;

  readln;

  until w=3;

end.

Program 2 tablice i procedury

uses

  SysUtils;

type tab=array [1..10] of array [1..10] of integer;

var am,an,bn,bm:integer;

    a,b,c:tab;

    nazwa:string;

  procedure wyswietl (a:tab; n,m:integer);

  var i,j:integer;

    begin

      for i:=1 to n do

        begin

          for j:=1 to m do

              write (a[i,j], ' ');

        end;

     end;

procedure pobierz (var a:tab; n,m:integer; nazwa:string);

var i,j:integer;

  begin

    for i:=1 to n do

        for j:=1 to m do

          begin

            writeln('podaj ' ,nazwa,'[',i,',',j,']');

            readln(a[i,j]);

          end;

  end;

procedure suma(a,b:tab; var c:tab; n,m:integer);

var i,j:integer;

  begin

    for i:=1 to n do

      for j:=1 to m do

          c[i,j]:=a[i,j]+b[i,j];

  end;

begin

  { TODO -oUser -cConsole Main : Insert code here }

  writeln('podaj an,am,bn,bm');

  readln(an,am,bn,bm);

  if (an=bn) and (am=bm) then

    begin

      nazwa:='a';

      pobierz(a,an,am,nazwa);

      nazwa:='b';

      pobierz(b,bn,bm,nazwa);

      suma(a,b,c,an,am);

      wyswietl(c,an,am);

    end

    else

      writeln('zle wymiary');

readln

end.

Program 3 Elementy maxymalne w tablicy

uses

  SysUtils;

type tab=array of real;

  var

  c: real;

  poz,n: integer;

  a:tab;

    procedure pobierz (n:integer;a:tab);

      var

        i: integer;

    begin

        for i:=0 to n-1 do

          begin

            writeln('podaj n[',i,']');

            readln(a[i]);

          end;

    end;

    function elmax (a:tab;var poz:integer;n:integer):real;

      var

        i:integer;

        max:real;

      begin

        max:=a[0];

        poz:=0;

        i:=1;

          while i<=n-1 do

            begin

              if a[i]>max then

                begin

                 max:=a[i];

                  poz:=i;

                 end;

              i:=i+1;

            end;

         elmax:=max;

      end;

begin

  { TODO -oUser -cConsole Main : Insert code here }

  repeat

    begin

      writeln('podaj ilosc elementow tablicy');

      readln(n);

    end;

   until n>0;

   setlength(a,n);

    pobierz(n,a);

    c:=elmax(a,poz,n);

    writeln(' maxymaly element tablicy to ', c:0:3,' ktory jest na pozycji

    ',poz);

    readln;

end.

...