Program Gauss_1;

Uses crt;

Const
  nn=100;             {Максимальная размерность матрицы}
  mm=100;

Type
  Mas      = array[1..3] of string[40];     {Массив для меню}
  Matrix   = array[1..nn, 1..mm] of double; {Матрица с свободных членов}
  ResultM  = array[0..nn] of real;          {Решения СЛАУ}

Const
  Stor:Mas= (' Use one of the proposed matrix ',
             '   Enter matrix from keyboard   ',
             '      Exit from program         ');

  Stor2:Mas=(' Use the matrix of second order ',
             '  Use the matrix of third order ',
             ' Use the matrix of fourth order ');

Var
  a        : matrix;  {Исходная матрица с коэффициентами при неизвестных}
  b        : ResultM; {Решения полученные из исходной матрица "а"}
  n,un      : integer; {Размерность матрицы}
  i,j,k    : integer; {Счетчики для циклов}
  kod      : char;    {Код символа, вводимый с клавиатуры}
  typeM    : integer; {Переключатель для меню}
  OrigMode : integer; {Начальное "состояние экрана"}
  s        : byte;
  st       : string;

{Прорисовка главного меню в текстовом виде}
Procedure DisplayMainMenu;
Begin
  OrigMode:=LastMode;
  Textmode(CO80);
  clrscr;
  Window(31,11,62,16);
  TextBackGround(7); {Цвет фона}
  TextColor(0);      {Цвет вводимых символов}
  clrscr;
  k:=1;              {Номер режима}
  GotoXY(3,2);       {Вывод заглавного меню}
  write('   Choose an opinion:  ');
  {Выделение выбранной строки фоном и цветом}
  kod:=' ';
  while kod<>#13 do
  begin
    for i:=1 to 3 do
    begin
      if i=k then
      begin
        TextBackGround(0);
        TextColor(7);
      end
      else
      begin
        TextBackGround(7);
        TextColor(0);
      end;
      {Вывод строк меню}
      GotoXY(1,i+2);
      write(Stor[i]);
    end;
    {Отображение выбора с помощью кнопок "вверх" и "вниз"}
    kod:=readkey;
    delay(100);
    {Если зажата функциональная клавиша}
    if kod=#0 then
    begin
      {Считывание второго байта}
      kod:=readkey;
      {Если зажата клавиша "вверх"}
      if kod=#72 then
      begin
        if k>1 then k:=k-1
               else k:=3
      end;
      {Если зажата клавиша "вниз"}
      if kod=#80 then
      begin
        if k<3 then k:=k+1
               else k:=1
      end;
    end;
    {Переключатель возможной работы программы}
    case k of
      1: typeM:=1;
      2: typeM:=2;
      3: typeM:=3;
    end;
  end;
  {Переход к "стандартному" экрану}
  TextMode(OrigMode);
  TextBackGround(0);
  TextColor(7);
  Window(1,1,80,25);
  clrscr;
  GotoXY(1,1);
End;

{Запись в массив "a" матрицы второго порядка}
Procedure UseFirstMatrix(var a: matrix);
Begin
  n:=2;
  un:=2;
  a[1,1]:=2;
  a[1,2]:=-1;
  a[1,3]:=0;
  a[2,1]:=1;
  a[2,2]:=3;
  a[2,3]:=7;
End;

{Запись в массив "a" матрицы третьего порядка}
Procedure UseSecondMatrix(var a: matrix);
Begin
  n:=3;
  un:=3;
  a[1,1]:=1;
  a[1,2]:=2;
  a[1,3]:=3;
  a[1,4]:=3;
  a[2,1]:=3;
  a[2,2]:=5;
  a[2,3]:=7;
  a[2,4]:=0;
  a[3,1]:=1;
  a[3,2]:=3;
  a[3,3]:=4;
  a[3,4]:=1;
End;

{Запись в массив "a" матрицы четвертого порядка}
Procedure UseThirdMatrix(var a: matrix);
Begin
  n:=4;
  un:=4;
  a[1,1]:=2;
  a[1,2]:=-1;
  a[1,3]:=3;
  a[1,4]:=-5;
  a[1,5]:=1;
  a[2,1]:=1;
  a[2,2]:=-1;
  a[2,3]:=-5;
  a[2,4]:=0;
  a[2,5]:=2;
  a[3,1]:=3;
  a[3,2]:=-2;
  a[3,3]:=-2;
  a[3,4]:=5;
  a[3,5]:=3;
  a[4,1]:=7;
  a[4,2]:=-5;
  a[4,3]:=-9;
  a[4,4]:=-10;
  a[4,5]:=8;
End;

{Прорисовка меню матрицы-константы в текстовом виде}
Procedure DisplayMatrixMenu;
Begin
  OrigMode:=LastMode;
  Textmode(CO80);
  clrscr;
  Window(31,11,62,16);
  TextBackGround(7); {Цвет фона}
  TextColor(0);      {Цвет вводимых символов}
  clrscr;
  k:=1;              {Номер режима}
  GotoXY(3,2);       {Вывод заглавного меню}
  write('   Choose an opinion:  ');
  {Выделение выбранной строки фоном и цветом}
  kod:=' ';
  while kod<>#13 do
  begin
    for i:=1 to 3 do
    begin
      if i=k then
      begin
        TextBackGround(0);
        TextColor(7);
      end
      else
      begin
        TextBackGround(7);
        TextColor(0);
      end;
      {Вывод строк меню}
      GotoXY(1,i+2);
      write(Stor2[i]);
    end;
    {Отображение выбора с помощью кнопок "вверх" и "вниз"}
    kod:=readkey;
    delay(100);
    {Если зажата функциональная клавиша}
    if kod=#0 then
    begin
      {Считывание второго байта}
      kod:=readkey;
      {Если зажата клавиша "вверх"}
      if kod=#72 then
      begin
        if k>1 then k:=k-1
               else k:=3
      end;
      {Если зажата клавиша "вниз"}
      if kod=#80 then
      begin
        if k<3 then k:=k+1
               else k:=1
      end;
    end;
    {Переключатель возможной работы программы}
    case k of
      1: UseFirstMatrix(a);
      2: UseSecondMatrix(a);
      3: UseThirdMatrix(a);
    end;
  end;
  {Переход к "стандартному" экрану}
  TextMode(OrigMode);
  TextBackGround(0);
  TextColor(7);
  Window(1,1,80,25);
  clrscr;
  GotoXY(1,1);
End;

{Процедура ввода матрицы с клавиатуры}
{a - матрица, в которую вносятся данные}
{n - количество уравнений в матрице}
Procedure EnterMatrix(var a:Matrix; var n,un:integer);
Begin
  {Ввод количества линейных уравнений}
  {которые и определяют порядок матрицы, и кол-во неизвестных}
  repeat
    write('Enter the number of linear equations: ');
    readln(n);
  until (n>0) and (n<=nn);
  write('Enter the number of unknowns: ');
  readln(un);
  {Ввод коэффициентов, находящихся при неизвестных}
  for i:=1 to n do
  begin
    for j:=1 to un+1 do
    begin
      write('a[',i,',',j,']=');
      readln(a[i,j]);
    end;
    writeln;
  end;
End;

{Процедура вывода матрицы на экран}
{a - матрица, в которую вносятся данные}
{n - количество уравнений в матрице}
Procedure PrintMatrix(var a:Matrix; var n,un:integer);
Begin
  for i:=1 to n do
  begin
    for j:=1 to un+1 do
    begin
      write(a[i,j]:7:4,'  ');
    end;
    writeln;
  end
End;

{Вывод на экран решений СЛАУ, полученных по методу Гаусса}
Procedure PrintResult(un:integer);
Begin
  writeln;
  for i:=1 to un do
  begin
    writeln(' x',i,'=',b[i]:7:4,' ');
  end;
  writeln;
  write('press any key for exit...');
  readkey;
End;

{Процедура редактирование матрицы}
Procedure EditMatrix(var a:Matrix; var n,un:integer; var st: string);
Var
  RowMatrix: integer;
Begin
  if ((st='Y') or (st='y')) then
  begin
    clrscr;
    PrintMatrix(a,n,un);
    writeln('In which line you make a mistake?');
    readln(RowMatrix);
    for i:=RowMatrix to RowMatrix do
    begin
      for j:=1 to un+1 do
      begin
        write('a[',i,j,']=');
        readln(a[i,j]);
      end;
    end;
  end;
  clrscr;
  PrintMatrix(a,n,un);
  st:=' ';
  writeln('Do you want to edit this matrix again?(Y/N)');
  readln(st);
  if ((st='Y') or (st='y')) then EditMatrix(a,n,un,st);
End;

{Процедура вычисления решений СЛАУ, методом Гаусса}
Procedure Gauss(var a:matrix;var n,un:integer; var s:byte; var x:array of real);
Var
  m,t: real;
Begin
  i:=1;
  s:=1;
  {Упрощение матрицы}
  repeat
    j:=i+1;
    k:=i;
    m:=abs(a[i,i]);
    {Находим самый большой элемент по модулю в первом столбце}
    repeat
      if m<abs(a[j,i]) then
      begin
        m:=abs(a[j,i]);
        k:=j;
      end;
      j:=j+1
    until not(j<=n);
    {Меняем местами строки, т.е. упрощаем матрицу}
    {Если элементы в первом столбце матрицы НЕ нулевые}
    if m<>0 then
    begin
      j:=i;
      repeat
        t:=a[i,j];
        a[i,j]:=a[k,j];
        a[k,j]:=t;
        j:=j+1;
      until not(j<=n+1);
      k:=i+1;
      {Теперь все элементы первой строки матрицы разделим на элемент a[i,i]}
      {а во всех остальных строках занулим первый элемент при помощи}
      {элементарных преобразований}
      repeat
        t:=a[k,i]/a[i,i];
        a[k,i]:=0;
        j:=i+1;
        repeat
          a[k,j]:=a[k,j]-t*a[i,j];
          j:=j+1;
        until not(j<=n+1);
        k:=k+1
      until not(k<=n);
    end
    else begin
      s:=0;
    end;
    i:=i+1
  until not((i<=n)and(s=1));
  {Получение значения "корней" уравнений}
  if s=1 then
  begin
    i:=n;
    repeat
      x[i]:=a[i,n+1];
      j:=i+1;
      while j<=n do
      begin
        x[i]:=x[i]-a[i,j]*x[j];
        j:=j+1;
      end;
      x[i]:=x[i]/a[i,i];
      i:=i-1;
    until not(i>=1);
  end;
End;

Procedure DecisionSLAE(z: integer);
Begin
  case z of
    1: begin
         {используем один из предложенных примеров}
         DisplayMatrixMenu;
         PrintMatrix(a,n,un);
         {ищем решения СЛАУ}
         Gauss(a,n,un,s,b);
         {вывод полученных решений на экран компьютера}
         PrintResult(un);
       end;
    2: begin
         {ввод матрицы с клавиатура, а после вывод}
         EnterMatrix(a,n,un);
         PrintMatrix(a,n,un);
         {предоставляем возможность исправить ошибки}
         writeln;
         writeln('Do you want to edit this matrix?(Y/N)');
         repeat
           readln(st);
         until ((st='Y') or (st='y')) or ((st='N') or (st='n'));
         EditMatrix(a,n,un,st);
         {ищем решения СЛАУ}
         Gauss(a,n,un,s,b);
         {вывод полученных решений на экран компьютера}
         PrintResult(un);
       end;
  end;
End;

Begin
  clrscr;
  {Отображение главного меню}
  DisplayMainMenu;
  {Решение СЛАУ методом Гаусса}
  DecisionSLAE(typeM);
  readkey;
End.