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

Program Lab1;

Uses
    System.SysUtils;

Type
    TArray = Array[0..3] Of Integer;

Const
    INPUT = 1;
    OUTPUT = 2;
    NULL_CODE = 48;
    NINE_CODE = 57;

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 InputFileName(Const InOrOut: Integer): String;
Var
    CheckFile: TextFile;
    FileName: String;
    IsCorrect: Boolean;
Begin
    Case (InOrOut) Of
        INPUT:
        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;
            InputFileName := FileName;
        End;
        OUTPUT:
        Begin
            Writeln('Введите имя файла, в который будут выводиться полученные данные (если файл вводится без расширения, то ему автоматически будет добавлено расширение .txt):');
            Repeat
                IsCorrect := True;
                Readln(FileName);
                If ExtractFileExt(FileName) = '' Then
                    FileName := FileName + '.txt';
                Try
                    Assign(CheckFile, FileName);
                    ReWrite(CheckFile);
                    Close(CheckFile);
                Except
                    Writeln('Невозможно открыть для записи файл с таким именем! Повторите ввод имени файла:');
                    IsCorrect := False;
                End;
            Until IsCorrect;
            InputFileName := FileName;
        End;
    End;
End;

Procedure InputFromFile(Var Text: String; Var FileName: String);
Var
    FileString: String;
    InputFile: TextFile;
Begin
    Text := '';
    Assign(InputFile, FileName);
    Reset(InputFile);
    While (Not EoF(InputFile)) Do
    Begin
        Readln(InputFile, FileString);
        Text := Text + FileString;
    End;
    Close(InputFile);
End;

Function CheckNum(VerifiableNum: Char): Boolean;
Var
    IsNum: Boolean;
    I: Integer;
Begin
    IsNum := False;
    I := NULL_CODE;
    While Not IsNum And (I <= NINE_CODE) Do
    Begin
        IsNum := (Ord(VerifiableNum) = I);
        Inc(I);
    End;
    CheckNum := IsNum;
End;

Function CheckText(Var Text: String): Boolean;
Var
    FoundedNum: String;
    IsCorrect: Boolean;
    QuantityNumbers, Position: Integer;
Begin
    QuantityNumbers := 0;
    Position := 1;
    IsCorrect := True;
    While IsCorrect And (Position <= Length(Text)) Do
    Begin
        If (CheckNum(Text[Position])) Then
        Begin
            FoundedNum := FoundedNum + Text[Position];
            Inc(QuantityNumbers);
            Inc(Position);
            While (QuantityNumbers <= 4) And (Position <= Length(Text)) And CheckNum(text[position]) Do
            Begin
                FoundedNum := FoundedNum + Text[Position];
                Inc(Position);
                Inc(QuantityNumbers);
            End;
            If (QuantityNumbers > 4) Or (StrToInt(FoundedNum) = 0) Or (StrToInt(FoundedNum) > 2000) Then
                IsCorrect := False;
            FoundedNum := '';
        End;
        Inc(Position);
    End;
    If (QuantityNumbers = 0) Then
        IsCorrect := False;
    CheckText := isCorrect;
End;

Procedure InputFromConsole(Var Text: String);
Var
    IsCorrect: Boolean;
Begin
    Repeat
        Writeln('Введите строку для обработки:');
        Readln(Text);
        IsCorrect := CheckText(Text);
        If Not IsCorrect Then
            Writeln('Введенная строка не соответствует условию! Повторите ввод.');
    Until IsCorrect;
End;

Procedure InputText(Var Text: String; Var Choice: Integer);
Var
    FileName: String;
    InputFile: TextFile;
    IsCorrect: Boolean;
Begin
    Case Choice Of
        1:
            Repeat
                FileName := InputFileName(INPUT);
                InputFromFile(Text, FileName);
                IsCorrect := CheckText(Text);
                If Not IsCorrect Then
                    Writeln('Введенный текст не соответствует условию! Повторите ввод имени файла.');
            Until IsCorrect;
        2:
             InputFromConsole(Text);
        End;
End;

Procedure SearchNumbers(Var Text: String; Var ArrayNumbers: TArray);
Var
    FoundedNum: String;
    Position, ArrLength: Integer;
Begin
    Position := 1;
    ArrLength := 0;
    While Position <= Length(Text) Do
    Begin
        If (CheckNum(Text[Position])) Then
        Begin
            FoundedNum := FoundedNum + Text[Position];
            Inc(ArrLength);
            Inc(Position);
            While (Position <= Length(Text)) And CheckNum(Text[Position]) Do
            Begin
                FoundedNum := FoundedNum + Text[Position];
                Inc(Position);
            End;
            ArrayNumbers[ArrLength - 1] := StrToInt(FoundedNum);
            FoundedNum := '';
        End;
        Inc(Position);
    End;
End;

Function ConvertToRoman(Number: Integer): String;
Const RomanNumbers: Array[0..9] Of Array[0..3] Of String = (('', '', '', ''),
                                                            ('M', 'C', 'X', 'I'),
                                                            ('MM', 'CC', 'XX', 'II'),
                                                            ('', 'CCC', 'XXX', 'III'),
                                                            ('', 'CD', 'XL', 'IV'),
                                                            ('', 'D', 'L', 'V'),
                                                            ('', 'DC', 'LX', 'VI'),
                                                            ('', 'DCC', 'LXX', 'VII'),
                                                            ('', 'DCCC', 'LXXX', 'VIII'),
                                                            ('', 'CM', 'XC', 'IX'));
Var
    Counter: Integer;
    ConvertedNum: String;
Begin
    Counter := 3;
    While Number <> 0 Do
    Begin
        ConvertedNum := RomanNumbers[Number Mod 10][Counter] + ConvertedNum;
        Number := Number div 10;
        Dec(Counter);
    End;
    ConvertToRoman := ConvertedNum;
End;

Procedure OutputInFile(Var FileName: String; Var Numbers: TArray);
Var
    OutputFile: TextFile;
    I: Integer;
Begin
    Assign(OutputFile, FileName);
    ReWrite(OutputFile);
    I := 0;
    While (Numbers[I] <> 0) And (I < 4) Do
    Begin
        Write(OutputFile, Numbers[I], ' ');
        Inc(I);
    End;
    Writeln(OutputFile);
    I := 0;
    While (Numbers[I] <> 0) And (I < 4) Do
    Begin
        Write(OutputFile, ConvertToRoman(Numbers[I]), ' ');
        Inc(I);
    End;
    Close(OutputFile);
End;

Procedure OutputInConsole(Var Numbers: TArray);
Var
    I: Integer;
Begin
    Writeln('Искомые числа:');
    I := 0;
    While (Numbers[I] <> 0) And (I < 4) Do
    Begin
        Write(Numbers[I], ' ');
        Inc(I);
    End;
    Writeln;
    Writeln('Их представление в римской системе счисления:');
    I := 0;
    While (Numbers[I] <> 0) And (I < 4) Do
    Begin
        Write(ConvertToRoman(Numbers[I]), ' ');
        Inc(I);
    End;
End;

Procedure OutputNumbers(Var Numbers: TArray; Choice: Integer);
Var
    FileName: String;
Begin
    Case Choice Of
        1:
        Begin
            FileName := InputFileName(OUTPUT);
            OutputInFile(FileName, Numbers);
            Write('Искомые данные выведены в файл ');
            Writeln(FileName);
        End;
        2:
            OutputInConsole(Numbers);
    End;
End;

Var
    Text: String;
    Choice: Integer;
    Numbers: TArray = (0, 0, 0, 0);
Begin
    Writeln('Программа выводит содержащиеся в тексте (текст должен содержать от 1 до 4 цифровых символов, отображающих целые числа от 1 до 2000) числа в десятичной и римской системах счисления.');
    Choice := ChooseWay(INPUT);
    InputText(Text, Choice);
    SearchNumbers(Text, Numbers);
    Choice := ChooseWay(OUTPUT);
    OutputNumbers(Numbers, Choice);
    Readln;
End.