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

Program Lab3;

Uses
    System.SysUtils;

Type
    TArr = Array of Real;

Const
    INPUT = 1;
    OUTPUT = 2;
    MIN_QUANTITY = 1;
    MAX_QUANTITY = 100000;
    FILE_CHOICE = 1;
    CONSOLE_CHOICE = 2;

Procedure OutputInConsole(Var SortedArr: TArr);
Var
    I: Integer;
Begin
    For I := 0 To High(SortedArr) Do
        Write(SortedArr[I]:7:2, ' ');
End;

Procedure SortArr(Var SortableArr: TArr);
Var
    Position, CheckPosition, MoveNumPosition: Integer;
    CheckNum: Real;
Begin
    Writeln('Исходный массив:');
    OutputInConsole(SortableArr);
    Writeln;
    For CheckPosition := Length(SortableArr) - 2 Downto 0 Do
    Begin
        Position := Length(SortableArr) - 1;
        While (Position > CheckPosition) And (SortableArr[Position] > SortableArr[CheckPosition]) Do
            Dec(Position);
        CheckNum := SortableArr[CheckPosition];
        For MoveNumPosition := CheckPosition To Position - 1 Do
            SortableArr[MoveNumPosition] := SortableArr[moveNumPosition + 1];
        SortableArr[Position] := CheckNum;
        Writeln('Массив на ', High(SortableArr) - CheckPosition - 1, '-м шаге сортировки:');
        OutputInConsole(SortableArr);
        Writeln;
    End;
End;

Function ChooseFileOrConsole(Const InOrOutput: Integer): Integer;
Var
    Choice: Integer;
    IsCorrect: Boolean;
Begin
    Case InorOutput 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;
    ChooseFileOrConsole := Choice;
End;

Procedure InputInFileName(Var FileName: String);
Var
    CheckFile: TextFile;
    IsCorrect: Boolean;
Begin
    Writeln('Введите имя файла, из которого будут вводиться данные:');
    Repeat
        IsCorrect := True;
        Readln(FileName);
        If ExtractFileExt(FileName) = '.txt' Then
        Begin
            If Not FileExists(FileName) Then
            Begin
                Writeln('Файла с таким именем не существует. Повторите ввод имени файла.');
                IsCorrect := False;
            End
            Else
                Try
                    Assign(CheckFile, FileName);
                    Reset(CheckFile);
                    Close(CheckFile);
                Except
                    Writeln('Невозможно открыть файл с таким именем! Повторите ввод имени файла:');
                    IsCorrect := False;
                End;
        End
        Else
        Begin
            Writeln('Файл должен иметь расширение .txt! Повторите ввод имени файла.');
            IsCorrect := False;
        End;
    Until IsCorrect;
End;

Function CheckFile(Var FileName: String): Boolean;
Var
    IsCorrect: Boolean;
    ArrLength, I: Integer;
    InputFile: TextFile;
    ArrNumber: Real;
Begin
    Assign(InputFile, FileName);
    Reset(InputFile);
    IsCorrect := True;
    ArrNumber := 9;
    Try
        Read(InputFile, ArrLength);
    Except
        Writeln('В файле содержатся неверные данные! Измените содержание файла и повторите ввод его имени.');
        IsCorrect := False;
    End;
    If IsCorrect And ((ArrLength < MIN_QUANTITY) Or (ArrLength > MAX_QUANTITY)) Then
    Begin
        Writeln('В файле содержатся неверные данные! Измените содержание файла и повторите ввод его имени.');
        IsCorrect := False;
    End
    Else
    Begin
        I := 0;
        While IsCorrect And (I < ArrLength) Do
        Begin
            Try
                Read(InputFile, ArrNumber);
            Except
                Writeln('В файле содержатся неверные данные! Измените содержание файла и повторите ввод его имени.');
                IsCorrect := False;
            End;
            Inc(I);
        End;
        If IsCorrect And Not EoF(InputFile) Then
        Begin
            Writeln('В файле содержатся лишние данные! Измените содержание файла и повторите ввод его имени.');
            IsCorrect := False;
        End;
    End;
    Close(InputFile);
    CheckFile := IsCorrect;
End;

Procedure InputFromFile(FileName: String; Var InputArray: TArr);
Var
    InputFile: TextFile;
    ArrayLength, I: Integer;
Begin
    Assign(InputFile, FileName);
    Reset(InputFile);
    Read(InputFile, ArrayLength);
    SetLength(InputArray, ArrayLength);
    For I := 0 To High(InputArray) Do
        Read(InputFile, InputArray[I]);
    Close(InputFile);
End;

Procedure InputFromConsole(Var InputArray: TArr);
Var
    ArrayLength, I: Integer;
    IsCorrect: Boolean;
Begin
    Writeln('Введите длину массива:');
    Repeat
        IsCorrect := True;
        Try
            Readln(ArrayLength);
        Except
            Writeln('Ошибка ввода. Введите натуральное число в диапазоне [', MIN_QUANTITY, '; ', MAX_QUANTITY, ']');
            IsCorrect := False;
        End;
        If IsCorrect And ((ArrayLength < MIN_QUANTITY) Or (ArrayLength > MAx_QUANTITY)) Then
        Begin
            Writeln('Ошибка ввода. Введите натуральное число в диапазоне [', MIN_QUANTITY, '; ', MAX_QUANTITY, ']');
            IsCorrect := False;
        End;
    Until IsCorrect;
    SetLength(InputArray, ArrayLength);
    Writeln('Введите элементы массива:');
    For I := 0 To High(InputArray) Do
        Repeat
            IsCorrect := True;
            Try
                Readln(InputArray[I]);
            Except
                IsCorrect := False;
                Writeln('Ошибка ввода! Введите действительное число:');
            End;
        Until IsCorrect;
End;

Procedure InputArr(Var InputArray: TArr; Var Choice: Integer);
Var
    FileName: String;
    IsCorrect: Boolean;
Begin
    Case Choice Of
        FILE_CHOICE:
        Begin
            Repeat
                InputInFileName(FileName);
                IsCorrect := CheckFile(FileName);
            Until IsCorrect;
            InputFromFile(FileName, InputArray);
        End;
        CONSOLE_CHOICE:
        Begin
            InputFromConsole(InputArray);
        End;
    End;
End;

Procedure InputOutFileName(Var FileName: String);
Var
    IsCorrect: Boolean;
    OutputFile: TextFile;
Begin
    Writeln('Введите имя файла, в который будут выводиться полученные данные (если файл вводится без расширения, то ему автоматически будет добавлено расширение .txt):');
    Repeat
        IsCorrect := True;
        Readln(FileName);
        If ExtractFileExt(FileName) = '' Then
            FileName := FileName + '.txt';
        Try
            Assign(OutputFile, FileName);
            ReWrite(OutputFile);
            Close(OutputFile);
        Except
            Writeln('Невозможно открыть для записи файл с таким именем! Повторите ввод имени файла:');
            IsCorrect := False;
        End;
    Until IsCorrect;
End;

Procedure OutputInFile(Var FileName: String; Var SortedArr: TArr);
Var
    OutputFile: TextFile;
    I: Integer;
Begin
    Assign(OutputFile, FileName);
    ReWrite(OutputFile);
    For I := 0 To High(SortedArr) Do
        Write(OutputFile, SortedArr[I]:7:2, ' ');
    Close(OutputFile);
End;

Procedure OutputArr(Var SortedArr: TArr; Var Choice: Integer);
Var
    FileName: String;
Begin
    Case Choice Of
        1:
        Begin
            InputOutFileName(FileName);
            OutputInFile(FileName, SortedArr);
            Write('Искомые данные выведены в файл ');
            Writeln(FileName);
        End;
        2:
        Begin
            Writeln('Отсортированный массив:');
            OutputInConsole(SortedArr);
        End;
    End;
End;

Var
    SortableArr: TArr;
    Choice: Integer;
Begin
    Writeln('Программа сортирует массив методом простых вставок.');
    Choice := ChooseFileOrConsole(INPUT);
    InputArr(SortableArr, Choice);
    SortArr(SortableArr);
    Choice := ChooseFileOrConsole(OUTPUT);
    OutputArr(SortableArr, Choice);
    Readln;
End.