Matrix

 простопросотprogram Laba_2_3;

{$APPTYPE CONSOLE}

uses
  SysUtils,
  Windows;

const
   Max = 2147483647;
   Min = Low(Integer);
   Accuracy = 3;
   NotValidMatrix = 1;

type
   IntegerMatrix = array of array of Integer;

procedure ReadFName(var MyFile: TextFile);
var
   FName: String;
   IsValidInput: Boolean;
begin
   IsValidInput := False;
   repeat
      Writeln('Введите название файла для ввода данных в фомате Name.txt:');
      Readln(FName);
      if FileExists(FName) then
      begin
         AssignFile(MyFile, FName);
         Reset(MyFile);
         if Eof(MyFile) then
            Writeln('Файл пустой.')
         else
            IsValidInput := True;
      end
      else
         Writeln('Ошибка ввода. Данного файла не существует.');
   until IsValidInput;
end;

procedure ReadOutputName(var Output: TextFile);
var
   FName: String;
   IsValidInput: Boolean;
begin
   IsValidInput := False;
   repeat
      Writeln('Введите названия файла для вывода данных в формате Name.txt:');
      Readln(FName);
      if Copy(Fname, length(FName) - 3, 4) = '.txt' then
      begin
         AssignFile(Output, FName);
         try
            Rewrite(Output);
            IsValidInput := True;
         except
            Writeln('Не удалось создать файл с таким названием.')
         end;
      end
      else
         Writeln('Название файла введено в неверном формате.');
   until IsValidInput;
end;

function IsValidMatrix(var MyFile: TextFile; var LenMat: Integer): Boolean;
var
   i, j, k: Integer;
   Temp: String;
   IsSquareMatrix: Boolean;
begin
   i := 0;
   IsSquareMatrix := True;
   While not Eof(MyFile) do
   begin
      Readln(MyFile, Temp);
      Inc(i);
   end;
   if i = NotValidMatrix then
   begin
      IsValidMatrix := False;
      Writeln('Количество строк и столбцов матрице не может равняться 1.');
      CloseFile(MyFile);
   end
   else
   begin
      Reset(MyFile);
      While (not Eof(MyFile)) and (IsSquareMatrix) do
      begin
         Readln(MyFile, Temp);
         j := 0;
         Temp := Temp + ' ';
         for k := 2 to length(Temp) do
            if (Temp[k] = ' ') and (Temp[k - 1] <> ' ') then
                  Inc(j);
         if i <> j then
            IsSquareMatrix := False;
      end;
      if IsSquareMatrix then
      begin
         IsValidMatrix := True;
         LenMat := i;
      end
      else
      begin
         IsValidMatrix := False;
         Writeln('Матрица не является квадратной. Количество строк и столбцов должно совпадать.');
         CloseFile(MyFile);
      end;
   end;
end;

function ReadMatrix(var MyFile: TextFile; var IntMatrix: IntegerMatrix; LenMat: Integer): Boolean;
var
   i, j, Border: Integer;
   Error: String;
   IsValidMatrix: Boolean;
begin
   Reset(MyFile);
   Border := Max div LenMat;
   LenMat := LenMat - 1;
   IsValidMatrix := True;
   Error := ' ';
   for i := 0 to LenMat do
   begin
      for j := 0 to LenMat do
      begin
         try
            Read(MyFile, IntMatrix[i, j]);
            if IntMatrix[i, j] > Border then
            begin
               Error := Error + '[' + IntToStr(i + 1) + ', ' + IntToStr(j + 1) + '] ';
               IsValidMatrix := False;
            end;
         except
            Error := Error + '[' + IntToStr(i + 1) + ', ' + IntToStr(j + 1) + '] ';
            IsValidMatrix := False;
         end;
      end;
      Readln(MyFile);
   end;
   if not IsValidMatrix then
   begin
      Write('Ошибка ввода. Элементы матрицы должны принадлежать промежутку от ', Min, ' до ', Border, '. Номера элементов массива, не соответствующих условию:');
      Writeln(Error);
   end;
   CloseFile(MyFile);
   ReadMatrix := IsValidMatrix;
end;

procedure Main();

var
   MyFile, Output: TextFile;
   i, j, Len, Counter: Integer;
   Sum: Real;
   Matrix: IntegerMatrix;
   IsValidInput: Boolean;

begin
   SetConsoleCp(1251);
   SetConsoleOutputCp(1251);
   Len := 0;
   IsValidInput := False;
   Writeln('Данная программа вычисляет среднее арифметическое значение положительных элементов каждого столбца квадратной матрицы.');
   repeat
      repeat
         ReadFName(MyFile);
         IsValidInput:= IsValidMatrix(MyFile, Len);
      until IsValidInput;
   SetLength(Matrix, Len, Len);
   IsValidInput := ReadMatrix(MyFile, Matrix, Len);
   until IsValidInput;
   Dec(Len);
   ReadOutputName(Output);
   Writeln('Среднее арифметическое элементов:');
   for j := 0 to Len do
   begin
      Sum := 0;
      Counter := 0;
      for i := 0 to Len do
         if Matrix[i, j] > 0 then
         begin
            Sum := Sum + Matrix[i, j];
            Inc(Counter);
         end;
      Write(j + 1, ' столбец: ');
      if Counter = 0 then
      begin
         Writeln('в данном столбце отсутствуют положительные элементы.');
         Write(Output, -1, ' ')
      end
      else
      begin
         Sum := Sum / Counter;
         Writeln(Sum:Length(IntToStr(Trunc(Sum))) + Accuracy + 1: Accuracy);
         Write(Output, Sum:Length(IntToStr(Trunc(Sum))) + Accuracy + 1: Accuracy, ' ');
      end;
   end;
   CloseFile(Output);
end;

begin
   Main;
   Readln;
end.