лаба2н3

Program Laba2_3;

Uses
    System.SysUtils;

Type
    TMatrix = Array Of Array Of Integer;
    TArr = Array Of Integer;

Const
    MIN_MAT = 1;
    MAX_MAT = 10;
    YES = 1;
    NO = 2;

Procedure WriteTask();
Begin
    Writeln('Данная программа находит количество хорошистов в группе (оценки не ниже шестерки, но  не все выше восьмерки).');
End;

Function ChooseFileInput(): Boolean;
Var
    IsFileInput: Integer;
    IsCorrect, Choose: Boolean;
Begin
    Repeat
        Writeln('Вы хотите вводить матрицу через файл? (Да - ', YES,
          ' / Нет - ', NO, ')');
        Try
            ReadLn(IsFileInput);
            IsCorrect := True;
        Except
            Writeln('Некорректный выбор!');
        End;
        If IsCorrect Then
        Begin
            If IsFileInput = YES Then
                Choose := True
            Else If IsFileInput = NO Then
                Choose := False
            Else
            Begin
                IsCorrect := False;
                Writeln('Некорректный выбор!');
            End;
        End;
    Until IsCorrect;
    ChooseFileInput := Choose;
End;

Function ChooseFileOutput(): Boolean;
Var
    IsFileInput: Integer;
    IsCorrect, Choose: Boolean;
Begin
    Repeat
        Writeln('Вы хотите выводить матрицу через файл? (Да - ', YES,
          ' / Нет - ', NO, ')');
        Try
            ReadLn(IsFileInput);
            IsCorrect := True;
        Except
            Writeln('Некорректный выбор!');
        End;
        If IsCorrect Then
        Begin
            If IsFileInput = YES Then
                Choose := True
            Else If IsFileInput = NO Then
                Choose := False
            Else
            Begin
                IsCorrect := False;
                Writeln('Некорректный выбор!');
            End;
        End;
    Until IsCorrect;
    ChooseFileOutput := Choose;
End;

Function FileInputPath(IsFileForRead: Boolean): String;
Var
    Path: String;
    IsCorrect: Boolean;
    F: TextFile;
Begin
    If (IsFileForRead) Then
        Write('Введите путь к файлу для чтения: ')
    Else
        Write('Введите путь к файлу для записи: ');
    Repeat
        IsCorrect := True;
        ReadLn(Path);
        AssignFile(F, Path);
        If Not(FileExists(Path)) Then
        Begin
            IsCorrect := False;
            Writeln('Файл не найден. Повторите попытку.');
        End;
    Until (IsCorrect);
    FileInputPath := Path;
End;

Function ReadInputMatrix(FilePath: String): TMatrix;
Var
    Rows, Cols, I, J: Integer;
    Matrix: TMatrix;
    F: TextFile;
    IsCorrect, IsFileForRead: Boolean;
Begin
    IsFileForRead := True;
    Repeat
        IsCorrect := True;
        AssignFile(F, FilePath);
        Reset(F);

        If IsCorrect Then
        Begin
            Try
                ReadLn(F, Rows, Cols);
                SetLength(Matrix, Rows, Cols);
            Except
                Writeln('Ошибка! Найдено некорректное значение элемента матрицы.');
                IsCorrect := False;
            End;
        End;

        I := 0;
        While (IsCorrect) and (I < Rows) Do
        Begin
            J := 0;
            While (IsCorrect) and (J < Cols) Do
            Begin
                Try
                    Read(F, Matrix[I][J]);
                Except
                    Writeln('Ошибка! Найдено некорректное значение элемента матрицы.');
                    IsCorrect := False;
                    Dec(I);
                End;
                Inc(J);
            End;
            ReadLn(F);
            Inc(I);
        End;

        If not IsCorrect Then
        Begin
            Writeln('Проверьте правильность введённых данных и повторите попытку.');
            FilePath := FileInputPath(IsFileForRead);
            AssignFile(F, FilePath);
        End;
    Until IsCorrect;

    CloseFile(F);
    ReadInputMatrix := Matrix;
End;

Function ConsoleMatrixCreation(): TMatrix;
Const
    MIN_ELEMENT = 1;
    MAX_ELEMENT = 10;
Var
    I, J, Order, Col: Integer;
    IsCorrect: Boolean;
    Matrix: TMatrix;
Begin
    repeat
        Writeln('Введите количество строк и столбцов матрицы.');
        IsCorrect := True;
        Try
            ReadLn(Order);
            ReadLn(Col);
        Except
            Writeln('Ошибка ввода! Повторите попытку.');
            IsCorrect := False;
        End;
        If IsCorrect And (Order <= 0) Then
        Begin
            Writeln('Ошибка ввода! Повторите попытку.');
            IsCorrect := False;
        End;
    Until IsCorrect;

    SetLength(Matrix, Order, Col);

    For I := 0 To High(Matrix) Do
    Begin
        For J := 0 to High(Matrix[I]) Do
        Begin
            Repeat
                Writeln('Введите ', J + 1, ' элемент ', I + 1, ' строки');
                IsCorrect := True;
                Try
                    ReadLn(Matrix[I][J]);
                Except
                    Writeln('Ошибка ввода! Повторите попытку...');
                    IsCorrect := False;
                End;
                If IsCorrect And ((Matrix[I][J] < MIN_ELEMENT) Or
                  (Matrix[I][J] > MAX_ELEMENT)) Then
                Begin
                    Writeln('Ошибка ввода! Введено число в неверном диапазоне.');
                    IsCorrect := False;
                End;
            Until IsCorrect;
        End;
    End;

    ConsoleMatrixCreation := Matrix;
End;

Procedure ConsolMatrixOutput(Matrix: TMatrix);
Var
    I, J: Integer;
Begin
    Writeln('Исходная матрица:');
    For I := 0 To High(Matrix) Do
    Begin
        For J := 0 To High(Matrix[I]) Do
            Write(Matrix[I][J], ' ');
        Writeln;
    End;
End;

Procedure ConsolArrMarkOutput(MarkArr: TArr; Sum: Integer);
Var
    I, J: Integer;
Begin
    Writeln;
    Write('Номера хорошистов: ');
    For I := 0 To High(MarkArr) Do
    Begin
        Write(MarkArr[I], ' ');
    End;
    Writeln;
    Write('Сумма хорошистов: ', Sum);
End;

Function SearchGoodStudent(Matrix: TMatrix): TArr;
Var
    Rows, EightGradeCounter, SixGradeCounter, CheckGradeCounter, Search, I,
      J: Integer;
    GoodStudents: TArr;
Begin
    Search := 0;
    SetLength(GoodStudents, 0);

    For I := 0 to High(Matrix) Do
    Begin
        EightGradeCounter := 0;
        SixGradeCounter := 0;
        CheckGradeCounter := 0;
        For J := 0 to High(Matrix[0]) Do
        Begin
            If (Matrix[I][J] > 5) Then
            Begin
                Inc(SixGradeCounter);
            End;

            If (Matrix[I][J] <= 8) Then
            Begin
                Inc(EightGradeCounter);
            End;

            If (Matrix[I][J] <= 5) Then
            Begin
                Inc(CheckGradeCounter);
            End;

        End;
        If (SixGradeCounter > 0) And (EightGradeCounter > 0) And
          (CheckGradeCounter = 0) Then
        Begin
            SetLength(GoodStudents, Length(GoodStudents) + 1);
            GoodStudents[High(GoodStudents)] := I + 1;
        End
    End;

    SearchGoodStudent := GoodStudents;
End;

Function SearchForGoodStudents(Arr: TMatrix): Integer;
Var
    Rows, EightGradeCounter, SixGradeCounter, CheckGradeCounter, Search, I,
    J: Integer;
Begin
    Search := 0;
    For I := 0 To High(Arr) Do
    Begin
        EightGradeCounter := 0;
        SixGradeCounter := 0;
        CheckGradeCounter := 0;
        For J := 0 To High(Arr[0]) Do
        Begin
            If (Arr[I][J] > 5) Then
            Begin
                Inc(SixGradeCounter);
            End;

            If (Arr[I][J] < 9) Then
            Begin
                Inc(EightGradeCounter);
            End;

            If (Arr[I][J] < 6) Then
            Begin
                Inc(CheckGradeCounter);
            End;
        End;
        If ((SixGradeCounter = Length(Arr[0])) And (EightGradeCounter > 0) And
          (CheckGradeCounter = 0)) Then
            Inc(Search);
    End;
    SearchForGoodStudents := Search;
End;

Procedure SaveResultInFile(Matrix: TMatrix; MarkArr: TArr; FilePath: String;
  Sum: Integer);
Var
    F: TextFile;
    I, J: Integer;
    IsCorrect: Boolean;
Begin
    Repeat
        IsCorrect := True;
        AssignFile(F, FilePath);
        Try
            ReWrite(F);
        Except
            Writeln('Не удалось открыть файл. Повторите попытку.');
            IsCorrect := False;
        End;
    Until (IsCorrect);

    For I := 0 To High(Matrix) Do
    Begin
        For J := 0 To High(Matrix) Do
        Begin
            Write(F, Matrix[I][J], ' ');
        End;
        Writeln(F);
    End;

    Writeln;
    Write(F, 'Номера хорошистов: ');
    For I := 0 To High(MarkArr) Do
    Begin
        Write(F, MarkArr[I], ' ');
    End;
    Writeln(F);
    Write(F, 'Сумма хорошистов: ', Sum);
    Writeln;

    CloseFile(F);
End;

Procedure ChoiseInput();
Var
    Put, Putout: String;
    Art: TMatrix;
    AA: TArr;
    Sum: Integer;
    Input, Output: Boolean;
Begin
    Input := ChooseFileInput();

    If Input = True Then
    Begin
        Put := FileInputPath(Input);
        Art := ReadInputMatrix(Put);
        AA := SearchGoodStudent(Art);
    End;

    If Input = False Then
    Begin
        Art := ConsoleMatrixCreation();
        AA := SearchGoodStudent(Art);
    End;

    Output := ChooseFileOutput();

    If Output = True Then
    Begin
        Putout := FileInputPath(False);
        Sum := SearchForGoodStudents(Art);
        SaveResultInFile(Art, AA, Putout, Sum);
    End;

    If Output = False Then
    Begin
        ConsolMatrixOutput(Art);
        Sum := SearchForGoodStudents(Art);
        ConsolArrMarkOutput(AA, Sum);
    End;

End;

Begin
    WriteTask();
    ChoiseInput();
    ReadLn;

End.