Программирование на на языке Турбо Паскаль

Автор работы: Пользователь скрыл имя, 12 Марта 2014 в 21:38, курсовая работа

Краткое описание

Первоначально составление программы для ЭВМ выполнялось вручную и требовало много труда и времени. Затем для облегчения задачи программирования были разработаны специальные алгоритмические системы, получившие название алгоритмические языки программирования.
Одной из основных задач программирования как научно-технической дисциплины является разработка «языков программирования» - способов выражения программ, удобных для человека, и методов трансляции, перевода с языков программирования на язык машины.

Вложенные файлы: 1 файл

Рязанцев1.docx

— 357.52 Кб (Скачать файл)

80:begin

   key:=vibor+1;

   if key=6 then key:=1;

   end;

72:begin

   key:=vibor-1;

   if key=0 then key:=5;

   end;

13:key:=13;

       end;

      case key of

1:punkt(9,0,0,0,0);

2:punkt(0,9,0,0,0);

3:punkt(0,0,9,0,0);

4:punkt(0,0,0,9,0);

5:punkt(0,0,0,0,9);

      end;

    end;

if key<>13 then vibor:=key;

until key=13;

end;

Procedure razmer(var m,n:integer);

    begin

    repeat

    repeat

    gotoxy(5,1);

    textcolor(15);

    writeln('        Введены ограничения на размерность. Размерность не должна быть больше 7x7');

    textcolor(15);

     gotoxy(20,2);

     Writeln('Введите  размерность массива ');

     Write('Количество  строк = ');

  Readln(m);

     if (m>7) or (m<0) then

     begin

     writeln('Ошибка !!!Превышена размерность!!!');

     delay(2000);

     clrscr;

     end;

     until (m<=7) and (m>0);

     gotoxy(24,3);

     textcolor(15);

     Write('Количество столбцов = ');

     Readln(n);

     if (n>7) or (n<0) then

     begin

     textcolor(red);

     writeln('Ошибка!!!Превышена  размерность !!!');

     delay(2000);

     clrscr;

     end;

     until (m<=7) and (m>0) and (n>0) and (n<=7);

     V_or_Z;

     clrscr;

    end;

procedure rukami(m,n:integer;var a:mas2);  {procedura zapolneniay massiva v ruchnuy}

var

   i,j:integer;

begin

textcolor(15);

 gotoxy(24,1);

writeln('Введите массив размерностью ',m,'x',n,'');

   for i:= 1 to m do

      begin

      for j:=1 to n do

      begin

write('Введите значение a[',i,',',j,']=');

readln(a[i,j]);

end;

      end;

      clrscr;

      TeXTCOLOR(9);

      gotoxy(10,3);

      writeln('****************** Введёный массив A******************');

      TeXTCOLOR(15);

   begin

    for i:=1 to m do

    begin

     for j:= 1 to n do write(a[i,j]:7:3,'  ');

     writeln;

    end;

    end;

end;

{Procedura zapolneniay massiva sluchainimi chislami}

Procedure sluchaay(m,n:integer;var a:mas2);

var

  i,j:integer;

  z:real;

begin

randomize;

for i:=1 to m do

begin

  for j:=1 to n do a[i,j]:=random(30);

end;

for i:= 1 to m do

  begin

   for j:= 1 to n do

   begin

    if a[i,j]<15 then a[i,j]:=-a[i,j];

   end;

  end;

  for i:= 1 to m do

      begin

       for j:= 1 to n-1 do

         begin

            if abs(a[i,j])>abs(a[i,j+1]) then

             begin

              z:=a[i,j];

              a[i,j]:= a[i,j+1];

              a[i,j+1]:= z;

             end;

         end;

      end;

      TeXTCOLOR(9);

gotoxy(25,3);

  writeln('Исходный массив');

  TeXTCOLOR(15);

for i:= 1 to m do

  begin

  for j:=1 to n do write('  ',a[i,j]:7:3);

  writeln;

  end;

end;

{procedura zapolneniay massiva iz faila}

Procedure fil(var n,m:integer;var a:mas2);

var i,j:integer;

    f:text;

    k:integer;

begin

  assign(f,'inp1.txt');

  reset(f);

  n:=0;

  {kod dlay schitvaniay kolichestva elementov v massive}

  while not EOLN(f) do

     begin

     read(f,k);

     n:=n+1;

     end;

  close(f);

  reset(f);

  i:=1;

  {schitvanie massiva iz faila}

  while not EOF(f) do

     begin

     for j:=1 to n do

     read(f,a[i,j]);

    if j=n then i:=i+1;

     end;

     m:=i-1;

  close(f);

begin

TeXTCOLOR(9);

gotoxy(10,1);

   writeln('////////////////////// Исходный массив ///////////////////////////');

   TeXTCOLOR(15);

for i:=1 to m do

   begin

   for j:=1 to n do write(a[i,j]:7:3,'  ');

      writeln;

   end;

end;

writeln('******************************************************************')

end;

{nahojdenie minimalnogo elementa i vivod preobrazovanogo massiva}

function minimal(a:mas2; var min:real):real;

var i,j:integer;

begin

  min:=abs(a[1,1]);

begin

for i:= 1 to m do

  for j:=1 to n do

   if abs(a[i,j])<min then min:=abs(a[i,j]);

end;

  writeln('Минимальое значение  массива = ',abs(min):7:3,'(Значение взято  по модулю)');

    if min=0 then

    begin

     min:=1;

    writeln('Минимальное значание массива равно0. Массив остался без изменения');

  end;

  writeln('Для продолжения  нажмите ENTER');

  readln;

end;

procedure premas(min:real;a:mas2; var b:mas2);

var i,j:integer;

{a:mas2;

min:real;}

begin

TeXTCOLOR (9);

writeln('преобразованный массив(Каждый  элемент поделен на минимальное  значение)');

 TeXTCOLOR(15);

for i:=1 to m do

   begin

     for j:=1 to n do b[i,j]:=a[i,j]/min;

   end;

for i:= 1 to m do

   begin

   for j:=1 to n do write('   ',b[i,j]:7:3);

   writeln;

   end;

   readkey;

   clrscr;

end;

{procedura nahojdeniya 4 vektoriv}

Procedure vek(b:mas2);

var i,j:integer;

begin

textcolor(9);

writeln('                          4 искомых вектора ');

TEXTCOLOR(15);

for i:= 1 to 4 do

  begin

  write('',i,' вектор: ');

  for j:= 1 to n do write('  ',b[i,j]:7:3);

  writeln;

  end;

end;

procedure nahsred(b:mas2;var sr:mas1);

var sum:real;

    summa:mas1;

    i,j:integer;

begin

begin

  for i:= 1 to 4 do

  begin

    sum:=0;

     for j:= 1 to n do

      begin

       sum:=sum+b[i,j];

      end;

      begin

       summa[i]:=sum;

      end;

  end;

end;

for i:= 1 to 4 do

  begin

   for j:= 1 to n do

    begin

     sr[i]:=summa[i]/n;

    end;

  end;

for i:= 1 to 4 do

  begin

     writeln('Среднее  арифметическое для ',i,' строки = ',sr[i]:7:3);

  end;

writeln('Для продолжения  нажмите Enter');

 readln;

end;

procedure raznos(sr:mas1;b:mas2; var raz:mas2);

var i,j:integer;

begin

for i:= 1 to 4 do

  begin

   for j:= 1 to n do

     raz[i,j]:=b[i,j]-sr[i]

  end;

end;

procedure  minimum(raz:mas2;var bli:mas1);

var i,j:integer;

    min:mas1;

begin

for i:= 1 to 4 do

   begin

    min[i]:=abs(raz[i,1]);

    for j:= 1 to n do

     begin

        if (abs(raz[i,j]))<min[i] then

        min[i]:=raz[i,j];

      end;

        if min[i]=(abs(raz[i,1])) then

        min[i]:=raz[i,1];

     end;

for i:= 1 to 4 do

  begin

   bli[i]:=sr[i]+min[i];

   end;

for i:= 1 to 4 do

  begin

   writeln('Ближайший элемент к среднему арифметическому в ',i,' векторе = ',bli[i]:7:3);

  end;

  writeln;

  writeln('Все исходные  и расчитаные данные автоматически  записаны в файл с именем rez.txt');

  for i:=1 to 5 do

   writeln;

  writeln('                    Для выхода в меню нажмите клавишу Enter');

  readkey;

  end;

{procedura sohraneniya preobrazovannogo massiva v fail}

Procedure failzap(b:mas2;sr:mas1;bli:mas1);

var

  t:text;

  i,j:integer;

begin

  assign(t,'rez.txt');

  rewrite(t);

  {Запись в файл исходного массива}

  Writeln(t,'                                   Ishodniy massiv A');

  for i:= 1 to m do

     begin

      for j:= 1 to n do

        begin

          write(t,a[i,j]:2:2,'  ');

end;

      writeln(t);

     end;

  writeln(t);

{Zapis' izmenennogo massiva}

Writeln(t,'                         Preobrazovanniy massiv ‚');

    For i:= 1 to m do

      begin

      for j:= 1 to n do

begin

Write(t,b[i,j]:7:3,'  ');

end;

      Writeln(t);

      end;

    Writeln(t);

{srednee arifmeticheskoe masiva}

for i:= 1 to 4 do

  begin

   writeln(t,'Srednee arifmeticheskoe dlya ',i,' stroki = ',sr[i]:7:3);

  end;

{vivod 4 vectorov}

begin

Writeln(t,'                        4 Iskomix ektora');

  for i:= 1 to 4 do

  begin

   write(t,'',i,'vector ');

    for j:= 1 to n do  write(t,b[i,j]:7:3,'  ');

    writeln(t);

    end;

  writeln(t);

  end;

for i:= 1 to 4 do

writeln(t,'Blijaeshiy element k srednemu arif. v ',i,' vektore',bli[i]:7:3);

close(t);

end;

begin

 

     repeat

 

   for i:= 1 to 10 do

    begin

     for j:= 1 to 10 do

      begin

       b[i,j]:=0;

       a[i,j]:=0;

       bli[i]:=0;

       raz[i,j]:=0;

      end;

     end;

  gd:=detect;

  initgraph(gd,gm,'');

   menu(key);

   cleardevice;

   closegraph;

     case key of

 

     1: begin

      razmer(m,n);

      rukami(m,n,a);

      minimal(a,min);

      premas(min,a,b);

      nahsred(b,sr);

      vek(b);

      raznos(sr,b,raz);

      minimum(raz,bli);

      failzap(b,sr,bli);

     end;

    2:begin

      razmer(m,n);

      sluchaay(m,n,a);

      minimal(a,min);

      premas(min,a,b);

      nahsred(b,sr);

      vek(b);

      raznos(sr,b,raz);

      minimum(raz,bli);

      failzap(b,sr,bli);

    end;

     3:begin

      fil(n,m,a);

      minimal(a,min);

      premas(min,a,b);

      nahsred(b,sr);

      vek(b);

      raznos(sr,b,raz);

      minimum(raz,bli);

      failzap(b,sr,bli);

     end;

     4:begin

      gd:=detect;

      initgraph(gd,gm,'');

settextstyle(12,0,1);

setcolor(red);

outtextxy(250,20,'Задание);

  setcolor(15);

outtextxy(10,40,'Дан двухмерный  массив размером M x N. Преобразовать  его по правилу -');

outtextxy(2,60,'разделить все  элементы матрицы на элемент, наименьший по абсолютной величине.');

outtextxy(2,80,'Из первых четырёх  строк массива сформировать четыре  новых вектора');

outtextxy(2,100,'(одномерные массивы). Для каждого вектора найти  элемент, ближайший к  ');

outtextxy(2,120,'среднему арифмеическому.');

readkey;

Информация о работе Программирование на на языке Турбо Паскаль