Laba 2.4 Delphi

program Project3;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

const
   MISTAKE_NOT_FOUND_MESSAGE = 'Error! File name can not be found. Please try again.';
   MISTAKE_NOT_OPEN_MESSAGE = 'Error! Unable to open this file. Please check the file and try again.';

type
   ToWorkArr = array of array of Integer;
   TInput = (ChooseKeyboard, ChooseFile);
   TOutput = (Yes, No);

function ChooseInput(): TInput;

var
   Symbol: Char;
   Input: TInput;
   IsCorrect: Boolean;

begin
   repeat
      WriteLn('If you want to fill the array from the keyboard, please enter "K", if you want to read ' + #10#13 + 'an array from a file, please enter "F":');
      ReadLn(Symbol);
      Symbol := UpCase(Symbol);
      if (Symbol <> 'K') and (Symbol <> 'F') then
          WriteLn('Attention, an error occurred while entering. Please try again.');
   until Symbol in ['K', 'F'];
   case Symbol of
      'K':  ChooseInput := ChooseKeyboard;
      'F':  ChooseInput := ChooseFile;
   end;
end;

procedure InputMatrixLength(var LengthOfMatrix: Integer);

const
   MIN_MATRIX_LENGTH = 1;
   MAX_MATRIX_LENGTH = 20;
   CHAR_MISTAKE_MESSAGE = 'Error! Enter a numeric value.';

var
   CorrectCheck: Boolean;

begin
   repeat
      CorrectCheck := False;
      Write('Please enter matrix order (value from ', MIN_MATRIX_LENGTH, ' to ', MAX_MATRIX_LENGTH, '): ');
      try
         ReadLn(LengthOfMatrix);
         CorrectCheck := True;
      except
         WriteLn(CHAR_MISTAKE_MESSAGE);
      end;
      if CorrectCheck and ((LengthOfMatrix < MIN_MATRIX_LENGTH) or (LengthOfMatrix > MAX_MATRIX_LENGTH)) then
      begin
         CorrectCheck := False;
         WriteLn('Error! The number does not satisfy the range of values from ', MIN_MATRIX_LENGTH, ' to ', MAX_MATRIX_LENGTH, '.');
      end;
   until (CorrectCheck);
end;

procedure FillMatrixFromKeyboard(var MethodMatrix: ToWorkArr; var LengthOfMatrix: Integer);

const
   MIN_INT = - MaxInt - 1;

var
   i, j: Integer;
   CorrectFilling: Boolean;

begin
   InputMatrixLength(LengthOfMatrix);
   SetLength(MethodMatrix, LengthOfMatrix, LengthOfMatrix);
   LengthOfMatrix := LengthOfMatrix - 1;
   WriteLn('Please enter array elements (values from ', MIN_INT, ' to ', MaxInt, '):');
   for i := 0 to LengthOfMatrix do
      for j := 0 to LengthOfMatrix do
      begin
         repeat
            CorrectFilling := False;
            Write('Array[', i, ', ', j, '] = ');
            try
               ReadLn(MethodMatrix[i, j]);
               CorrectFilling := True;
            except
               WriteLn('Error! Please enter a numerical value with a range from ', MIN_INT, ' to ', MaxInt, '.');
            end;
         until (CorrectFilling);
      end;
end;

procedure ConsoleOutput(Matrix: ToWorkArr; MatrixLength: Integer);

var
   i, j: Integer;

begin
   for i := 0 to MatrixLength do
   begin
      for j := 0 to MatrixLength do
         Write(Matrix[i, j]:5, '  ');
      Writeln;
   end;
end;

procedure InputMatrixFromFile(var MethodMatrix: ToWorkArr; var LengthOfMatrix: Integer);

const
   INPUT_MESSAGE = 'Please enter the name of the file from which the data will be read.' + #13#10 + 'For example, "C:\Users\Eugene\Desktop\Name.txt".';
   MIN_MATRIX_LENGTH = 1;
   MAX_MATRIX_LENGTH = 20;
   MIN_INT = - MaxInt - 1;

var
   IsInvalidInput: Boolean;
   UserFile: TextFile;
   FileName: String;
   i, j, Count, FullLengthOfMatrix: Integer;

begin
   repeat
      IsInvalidInput := True;
      WriteLn(INPUT_MESSAGE);
      ReadLn(FileName);
      if FileExists(FileName) then
      begin
         try
            Assign(UserFile, FileName);
            Reset(UserFile);
         except
            WriteLn(MISTAKE_NOT_OPEN_MESSAGE);
            IsInvalidInput := False;
         end;
         if IsInvalidInput then
         begin
            while not EOF(UserFile) do
            begin
               try
                  ReadLn(UserFile, LengthOfMatrix);
               except
                  WriteLn('Error! The file contains invalid data. Please check the file and try again.');
                  IsInvalidInput := False;
               end;
               if (IsInvalidInput) and ((LengthOfMatrix < MIN_MATRIX_LENGTH) or (LengthOfMatrix > MAX_MATRIX_LENGTH)) then
               begin
                  WriteLn('Error! The length of the array does not satisfy the range of values from ', MIN_MATRIX_LENGTH, ' to ', MAX_MATRIX_LENGTH, '.');
                  IsInvalidInput := False;
               end;
               if (IsInvalidInput) then
               begin
                  SetLength(MethodMatrix, LengthOfMatrix, LengthOfMatrix);
                  FullLengthOfMatrix := LengthOfMatrix;
                  LengthOfMatrix := LengthOfMatrix - 1;
                  for i := 0 to LengthOfMatrix do
                     if IsInvalidInput then
                     begin
                        j := 0;
                        while (not EOln(UserFile)) and (j < FullLengthOfMatrix) and (IsInvalidInput) do
                        begin
                           try
                              Read(UserFile, MethodMatrix[i, j]);
                           except
                              WriteLn('Error! Not all array elements are numerical or span ' + #13#10 + 'value from ', MIN_INT, ' to ', MaxInt, '.');
                              IsInvalidInput := False;
                           end;
                           Inc(j);
                        end;
                        ReadLn(UserFile);
                        if (j < LengthOfMatrix) and (IsInvalidInput) then
                        begin
                           WriteLn('Error! The length of the array does not match the number of array elements in the file.');
                           IsInvalidInput := False;
                        end;
                     end;
               end;
            end;
            CloseFile(UserFile);
         end;
      end
      else
      begin
         WriteLn(MISTAKE_NOT_FOUND_MESSAGE);
         IsInvalidInput := False;
      end;
   until IsInvalidInput;
end;

function ChooseOutput(): TOutput;

var
   Symbol: Char;
   IsCorrect: Boolean;

begin
   repeat
      WriteLn('If you want to put the result in a file, please enter "Y", otherwise, ' + #10#13 + 'please enter "N":');
      ReadLn(Symbol);
      Symbol := UpCase(Symbol);
      if (Symbol <> 'Y') and (Symbol <> 'N') then
          WriteLn('Attention, an error occurred while input. Please try again.');
   until Symbol in ['Y', 'N'];
   case Symbol of
      'Y':  ChooseOutput := Yes;
      'N':  ChooseOutput := No;
   end;
end;

procedure WriteToFile(Matrix: ToWorkArr; const LengthOfMatrix: Integer);

const
   OUTPUT_MESSAGE = 'Please enter the name of the file in which you want to write the result.' + #13#10 + 'For example, "C:\Users\Eugene\Desktop\Answer.txt".';

var
   IsInvalidOutput: Boolean;
   ResultFile: TextFile;
   FileName: String;
   i, j: Integer;

begin
   repeat
      IsInvalidOutput := True;
      Writeln(OUTPUT_MESSAGE);
      Readln(FileName);
      if FileExists(FileName) then
      begin
         try
            Assign(ResultFile, FileName);
            Rewrite(ResultFile);
         except
            WriteLn(MISTAKE_NOT_OPEN_MESSAGE);
            IsInvalidOutput := False;
         end;
         if IsInvalidOutput then
         begin
            Writeln(ResultFile, 'Result change lines matrix:');
            for i := 0 to LengthOfMatrix do
            begin
               for j := 0 to LengthOfMatrix do
                  Write(ResultFile, Matrix[i, j]:5, '  ');
               Writeln(ResultFile);
            end;
            CloseFile(ResultFile);
            WriteLn('Data recording completed successfully.');
         end;
      end
      else
      begin
         WriteLn(MISTAKE_NOT_FOUND_MESSAGE);
         IsInvalidOutput := False;
      end;
   until IsInvalidOutput;
end;

procedure ChangeLinesMatrix(var MethodMatrix: ToWorkArr; const LengthOfMatrix: Integer);

var
   i, j, Buffer, IncCounter, DivLengthOfMatrix, DecCounter: Integer;

begin
   DivLengthOfMatrix := LengthOfMatrix div 2;
   IncCounter := 0;
   DecCounter := LengthOfMatrix;
   for i := 1 to DivLengthOfMatrix do
   begin
      for j := 0 to LengthOfMatrix do
      begin
         Buffer := MethodMatrix[IncCounter, j];
         MethodMatrix[IncCounter, j] := MethodMatrix[DecCounter, j];
         MethodMatrix[DecCounter, j] := Buffer;
      end;
      Inc(IncCounter);
      Dec(DecCounter);
   end;
end;

procedure Main();

const
   THEME_MESSAGE = 'Topic: This program changes the rows of the matrix, the first with the last, '+ #10#13 + 'the second with the penultimate, etc.';
   DOTTED_LINE = '--------------------------------------------------------------------------------------';

var
   Matrix: ToWorkArr;
   i, j, MatrixLength, TaskAnswer: Integer;
   IsCorrect: Boolean;
   Input: TInput;
   Output: TOutput;

begin
   WriteLn(THEME_MESSAGE);
   WriteLn(DOTTED_LINE);
   Input := ChooseInput();
   case Input of
      ChooseKeyboard: FillMatrixFromKeyboard(Matrix, MatrixLength);
      ChooseFile: InputMatrixFromFile(Matrix, MatrixLength);
   end;
   Writeln('Entered matrix ', (MatrixLength + 1), ' x ', (MatrixLength + 1));
   ConsoleOutput(Matrix, MatrixLength);
   ChangeLinesMatrix(Matrix, MatrixLength);
   Writeln('Result change lines matrix:');
   ConsoleOutput(Matrix, MatrixLength);
   Output := ChooseOutput();
   if Output = Yes then
      WriteToFile(Matrix, MatrixLength);
   Writeln(DOTTED_LINE);
   Writeln('Program completed.');
   ReadLn;
end;

begin
   Main();
end.