Задание 3 Delphi (Лабораторная работа 2)

Program Lab3;

Uses
    System.SysUtils;

Type
    TMatrix = Array Of Array Of Integer;

Const
    INPUT = 1;
    OUTPUT = 2;

Function InputFromFile(Var InputFile: TextFile; Var Matrix: TMatrix): Boolean;
Var
    IsCorrect: Boolean;
    N, I, K: Integer;
Begin
    IsCorrect := True;
    Try
        Read(InputFile, N);
    Except
        Writeln('В файле содержатся неверные данные! Измените содержание файла и повторите ввод его имени.');
        IsCorrect := False;
    End;
    If IsCorrect And ((N < 1) Or (N > 20000)) Then
    Begin
        Writeln('Порядок матрицы вне допустимого диапазона! Измените содержание файла и повторите ввод его имени.');
        IsCorrect := False;
    End
    Else
    Begin
        SetLength(Matrix, N, N);
        K := 0;
        While IsCorrect And (K <= High(Matrix)) Do
        Begin
            I := 0;
            While IsCorrect And (I <= High(Matrix)) Do
            Begin
                Try
                    Read(InputFile, Matrix[K][I]);
                Except
                    Writeln('В файле содержатся неверные данные! Измените содержание файла и повторите ввод его имени.');
                    IsCorrect := False;
                End;
                Inc(I);
            End;
            Inc(K);
        End;
    End;
    InputFromFile := IsCorrect;
End;

Function InputFileName(Var CheckFile: TextFile; Const InOrOut: Integer): String;
Var
    FileName: String;
    IsCorrect: Boolean;
Begin
    Case (InOrOut) Of
        INPUT:
        Begin
            Writeln('Введите имя файла, из которого будут вводиться данные (все входные величины в файле должны быть разделены пробелами, сначала идет порядок матрицы, затем ее элементы):');
            Repeat
                IsCorrect := True;
                Readln(FileName);
                If Not FileExists(FileName) Then
                Begin
                    Writeln('Файла с таким именем не существует.');
                    IsCorrect := False;
                End
                Else
                    Try
                        Assign(CheckFile, FileName);
                        Reset(CheckFile);
                    Except
                        Writeln('Невозможно открыть файл с таким именем! Повторите ввод имени файла:');
                        IsCorrect := False;
                    End;
            Until IsCorrect;
            InputFileName := FileName;
        End;
        OUTPUT:
        Begin
            Writeln('Введите имя файла, в который будут выводиться данные:');
            Repeat
                IsCorrect := True;
                Readln(FileName);
                Try
                    Assign(CheckFile, FileName);
                    ReWrite(CheckFile);
                Except
                    Writeln('Невозможно открыть файл с таким именем! Повторите ввод имени файла:');
                    IsCorrect := False;
                End;
            Until IsCorrect;
            InputFileName := FileName;
        End;
    End;
End;

Function ChooseWay(Const IorOput: Integer): Integer;
Var
    Choice: Integer;
    IsCorrect: Boolean;
Begin
    Case IorOput Of
        INPUT:
        Begin
            Writeln('Выберите вариант ввода:');
            Writeln('1.Данные вводятся из текстового файла.');
            Writeln('2.Данные вводятся через консоль.');
        End;
        OUTPUT:
        Begin
            Writeln('Выберите вариант вывода:');
            Writeln('1.Данные выводятся в текстовый файл.');
            Writeln('2.Данные выводятся в консоль.');
        End;
    End;
    Repeat
        IsCorrect := True;
        Try
            Readln(Choice);
        Except
            Writeln('Ошибка ввода. Выберите вариант 1 или 2.');
            IsCorrect := False;
        End;
        If IsCorrect And ((Choice < 1) Or (Choice > 2)) Then
        Begin
            Writeln('Ошибка ввода. Выберите вариант 1 или 2.');
            IsCorrect := False;
        End;
    Until IsCorrect;
    ChooseWay := Choice;
End;

Function InputFromConsole(): TMatrix;
Var
    Matrix: TMatrix;
    IsCorrect: Boolean;
    N, I, J: Integer;
Begin
    Writeln('Введите порядок матрицы:');
    Repeat
        IsCorrect := True;
        Try
            Readln(N);
        Except
            Writeln('Ошибка ввода. Введите натуральное число в диапазоне [1; 20 000]');
            IsCorrect := False;
        End;
        If IsCorrect And ((N < 1) Or (N > 20000)) Then
        Begin
            Writeln('Ошибка ввода. Введите натуральное число в диапазоне [1; 20 000]');
            IsCorrect := False;
        End;
    Until IsCorrect;
    SetLength(Matrix, N, N);
    Writeln('Введите элементы матрицы (построчно):');
    For I := 0 To High(Matrix) Do
        For J := 0 to High(Matrix) Do
            Repeat
                IsCorrect := True;
                Try
                    Readln(Matrix[I][J]);
                Except
                    IsCorrect := False;
                    Writeln('Ошибка ввода! Введите действительное число:');
                End;
            Until IsCorrect;
    InputFromConsole := Matrix;
End;

Procedure InputMatrix(Var Matrix: TMatrix; Var Choice: Integer);
Var
    FileName: String;
    InputFile: Text;
    IsCorrect: Boolean;
Begin
    Case Choice Of
        1:
        Begin
            Repeat
                FileName := InputFileName(InputFile, INPUT);
                IsCorrect := InputFromfile(InputFile, Matrix);
                If IsCorrect And Not EoF(InputFile) Then
                Begin
                    IsCorrect := False;
                    Writeln('В файле присутствуют лишние данные! Повторите ввод имени файла:');
                End;
                Close(InputFile);
            Until IsCorrect;
        End;
        2:
        Begin
            Matrix := InputFromConsole();
        End;
    End;
End;

Procedure OutputInFile(Var OutputFile: TextFile; Var Matrix: TMatrix);
Var I: Integer;
    J: Integer;
Begin
    For I := 0 To High(Matrix) Do
    Begin
        For J := 0 To High(Matrix) Do
            Write(OutputFile, Matrix[I][J], ' ');
        Writeln(OutputFile);
    End;
End;

Procedure ShowMatrix(Var Matrix: TMatrix);
Var
    I: Integer;
    J: Integer;
Begin
    For I := 0 To High(Matrix) Do
    Begin
        For J := 0 To High(Matrix) Do
            Write(Matrix[I][J], ' ');
        Writeln;
    End;
End;

Procedure OutputMatrix(Var MAtrix: TMatrix; Var Choice: Integer);
Var
    FileName: String;
    OutputFile: TextFile;
Begin
    Case Choice Of
        1:
        Begin
            FileName := InputFileName(OutputFile, OUTPUT);
            OutputInFile(OutputFile, Matrix);
            Close(OutputFile);
            Write('Искомые данные выведены в файл ');
            Writeln(FileName);
        End;
        2:
        Begin
            Writeln('Искомая матрица:');
            ShowMatrix(Matrix);
        End;
    End;
End;

Function TransposeMatrix(Var Matrix: TMatrix): TMatrix;
Var
    TrMatrix: TMatrix;
    I: Integer;
    J: Integer;
Begin
    SetLength(TrMatrix, Length(Matrix), Length(Matrix));
    For I := 0 To High(Matrix) Do
        For J := 0 To High(Matrix) Do
            TrMatrix[J][I] := Matrix[I][J];
    TransposeMatrix := TrMatrix;
End;

Var
    Choice: Integer;
    Matrix: TMatrix;
Begin
    Writeln('Программа транспонирует заданную квадратную матрицу порядка n.');
    Choice := ChooseWay(INPUT);
    InputMatrix(Matrix, Choice);
    Matrix := TransposeMatrix(Matrix);
    Choice := ChooseWay(OUTPUT);
    OutputMatrix(Matrix, Choice);
    Readln;
End.