2.19.4 Delphi

Program Lab2194;

Uses
    System.SysUtils;

Type
    TArray = Array Of Integer;

Procedure PrintTask();
Begin
    Writeln('Эта программа находит количество всех возиожных треугольников по заданным точкам');
End;

Function ReadPathToFile() : String;
Var
    PathToFile: String;
    IsCorrect: Boolean;
Begin
    Repeat
        IsCorrect:=True;
        Write('Введите путь к файлу с расширением.txt с количеством точек и координатами точек: ');
        Readln(PathToFile);
        If ExtractFileExt(PathToFile) <> '.txt' Then
        Begin
            Writeln('Расширение файла не .txt!');
            IsCorrect := False;
        End;
    Until(IsCorrect);
    ReadPathToFile := PathToFile;
End;

Function IsExists(PathToFile : String) : Boolean;
Var
    IsRight: Boolean;
Begin
    IsRight := False;
    If FileExists(PathToFile) Then
        IsRight := True;
    IsExists := IsRight;
End;

Function IsNotAbleToReading(Var T: TextFile) : Boolean;
Var
    IsRight: Boolean;
Begin
    IsRight := False;
    Try
        Reset(T);
        CloseFile(T);
    Except
        IsRight := True;
    End;
    IsNotAbleToReading := IsRight;
End;

Function IsNotAbleToWriting(PathToFile: String) : Boolean;
Var
    IsRight: Boolean;
Begin
    IsRight := False;
    If FileIsReadOnly(PathToFile) Then
        IsRight := True;
    IsNotAbleToWriting := IsRight;
End;

Function IsEmpty(Var T: TextFile) : Boolean;
Var
    IsRight: Boolean;
Begin
    IsRight := False;
    Reset(T);
    If EOF(T) Then
        IsRight := True;
    CloseFile(T);
    IsEmpty := IsRight;
End;

Procedure GetFileNormalReading(Var PathToFile: String);
Var
    IsCorrect: Boolean;
    T : TextFile;
Begin
    Repeat
        IsCorrect := True;
        PathToFile := ReadPathToFile();
        If Not IsExists(PathToFile) Then
        Begin
            IsCorrect := False;
            Writeln('Проверьте корректность ввода пути к файлу!');
        End;
        If IsCorrect Then
            AssignFile(T, PathToFile);
        If IsCorrect And IsNotAbleToReading(T) Then
        Begin
            IsCorrect := False;
            Writeln('Файл закрыт для чтения!');
        End;
        If IsCorrect And IsEmpty(T) Then
        Begin
            IsCorrect := False;
            WriteLn('Файл пуст!');
        End;
    Until IsCorrect;
End;

Procedure GetFileNormalWriting(Var PathToFile: String);
Var
    T : TextFile;
    IsCorrect: Boolean;
Begin
    Repeat
        IsCorrect := True;
        PathToFile := ReadPathToFile();
        If Not IsExists(PathToFile) Then
        Begin
            IsCorrect := False;
            Writeln('Проверьте корректность ввода пути к файлу!');
        End;
        If IsCorrect Then
            AssignFile(T, PathToFile);
        If IsCorrect And IsNotAbleToWriting(PathToFile) Then
        Begin
            IsCorrect := False;
            WriteLn('Файл закрыт для записи!');
        End;
    Until IsCorrect;
End;

Function InputInt(Min, Max : Integer) : Integer;
Var
    IsCorrect : Boolean;
    Num : Integer;
Begin
    Repeat
        IsCorrect := True;
        Try
            Read(Num);
        Except
            IsCorrect := False;
        End;
        If(Not IsCorrect Or (Num < Min) Or (Num > Max)) Then
        Begin
            Writeln('Неверный ввод');
            IsCorrect := False;
        End;
    Until IsCorrect;
    InputInt := Num;
End;

Function InputIntWithText(S : String; Min, Max : Integer) : Integer;
Var
    IsCorrect : Boolean;
    Num : Integer;
Begin
    Repeat
        IsCorrect := True;
        Write(S, ' от ', Min, ' до ', Max, ' : ');
        Try
            Read(Num);
        Except
            IsCorrect := False;
        End;
        If(Not IsCorrect Or (Num < Min) Or (Num > Max)) Then
        Begin
            Writeln('Неверный ввод');
            IsCorrect := False;
        End;
    Until IsCorrect;
    InputIntWithText := Num;
End;

Function InputIntArray(S : String; Size, Min, Max : Integer) : TArray;
Var
    Arr : TArray;
    IsCorrect : Boolean;
    I : Integer;
Begin
    SetLength(Arr, Size);
    For I := 0 To High(Arr) Do
    Begin
        Repeat
            Write(S, ' от ', Min, ' до ', Max, ' : ');
            IsCorrect := True;
            Try
                Read(Arr[I]);
            Except
                IsCorrect := False;
            End;
            If(Not IsCorrect Or (Arr[I] > Max) Or (Arr[I] < Min)) Then
            Begin
                Writeln('Неверный ввод');
                IsCorrect := False;
            End;
        Until IsCorrect;
    End;
    InputIntArray := Arr;
End;

Procedure ReadFileSizeOfArray(PathToFile : String; Var Size1 : Integer; Var Size2 : Integer; Min, Max : Integer);
Var
    T : TextFile;
    IsCorrect : Boolean;
Begin
    AssignFile(T, PathToFile);
    Reset(T);

    IsCorrect := True;
    Try
        Readln(T, Size1);
    Except
        IsCorrect := False;
    End;
    If(Not IsCorrect Or (Size1 > Max) Or (Size1 < Min)) Then
    Begin
        Writeln('Неверный ввод размера первого массива, введите с консоли');
        Size1 := InputInt(Min, Max);
        IsCorrect := False;
    End;

    For Var I := 0 To Size1 Do
      Read(T);
    Readln(T);
    IsCorrect := True;
    Try
        Readln(T, Size2);
    Except
        IsCorrect := False;
    End;
    If(Not IsCorrect Or (Size2 > Max) Or (Size2 < Min)) Then
    Begin
        Writeln('Неверный ввод размера второго массива, введите с консоли');
        Size2 := InputInt(Min, Max);
        IsCorrect := False;
    End;
    Close(T);
End;

procedure ReadFileIntArray(PathToFile: String; Var Array1, Array2: TArray; Size1, Size2, Min, Max : Integer);
Var
    T: TextFile;
    I: Integer;
    IsCorrect : Boolean;
Begin
    AssignFile(T, PathToFile);
    Reset(T);

    SetLength(Array1, Size1);
    SetLength(Array2, Size2);
    Readln(T);

    For I := 0 To Size1 - 1 Do
    Begin
        IsCorrect := True;
        Try
            Read(T, Array1[I]);
        Except
            IsCorrect := False;
        End;
        If (Not IsCorrect) Or (Array1[I] > Max) Or (Array1[I] < Min) Then
        Begin
            Write('Неверный ввод, введите с клавиатуры: ');
            Array1[I] := InputInt(Min, Max);
        End;
    End;
    Readln(T);
    Readln(T);

    For I := 0 To Size2 - 1 Do
    Begin
        IsCorrect := True;
        Try
            Read(T, Array2[I]);
        Except
            IsCorrect := False;
        End;
        If (Not IsCorrect) or (Array2[I] > Max) or (Array2[I] < Min) then
        Begin
            Write('Неверный ввод, введите с клавиатуры: ');
            Array1[I] := InputInt(Min, Max);
        End;
    End;
    CloseFile(T);
End;


Function SortArray(Arr : TArray) : TArray;
Var
    I, J, Temp : Integer;
Begin
    For I := 0 To High(Arr) Do
        For J := 0 To (High(Arr) - I - 1) Do
            If(Arr[J] > Arr[J + 1]) Then
            Begin
                Temp := Arr[J];
                Arr[J] := Arr[J + 1];
                Arr[J + 1] := Temp;
            End;
    SortArray := Arr;
End;

Function RemoveZeros(ResultArray : TArray; Var Size : Integer; IsOneZero : Boolean) : TArray;
Var
    NewSize, I, Index : Integer;
    NewArray : TArray;
Begin
    NewSize := 0;
    For I := 0 To High(ResultArray) Do
        If(ResultArray[I] <> 0) Then
            Inc(NewSize);

    If (IsOneZero) Then
        Inc(NewSize);

    If(NewSize = 0) Then
    Begin
        SetLength(NewArray, 1);
        NewArray[1] := 0;
        Size := 1;
    End
    Else
    Begin
        SetLength(NewArray, NewSize);
        Index := 0;

        For I := 0 To High(ResultArray) Do
        Begin
            If(ResultArray[I] <> 0) Then
            Begin
                NewArray[Index] := ResultArray[I];
                Inc(Index);
            End
            Else
                If(ResultArray[I] = 0) And (IsOneZero) Then
                Begin
                    Inc(Index);
                    NewArray[Index]:= 0;
                    IsOneZero := False;
                End;
        End;
        Size := NewSize;
    End;

    RemoveZeros := NewArray;
End;


Procedure Unification(Arr1, Arr2 : TArray; Size1, Size2 : Integer; Var ResultArray : TArray; Var ResultSize : Integer);
Var
    IsUnic, IsFirst : Boolean;
    I, J : Integer;
Begin
    IsFirst := False;
    ResultSize:= Size1 + Size2;
    SortArray(Arr1);
    SortArray(Arr2);

    SetLength(ResultArray, ResultSize);
    For I := 0 To High(Arr1) Do
        ResultArray[I] := Arr1[I];

    For I := 0 To High(Arr2) Do
    Begin
        IsUnic := True;
        If(Not IsFirst) And (Arr2[I] = 0) Then
            IsFirst := True;
        For J := 0 to High(Arr1) do
        Begin
            If(Not IsFirst) And (Arr1[I] = 0) Then
                IsFirst := True;
            If(Arr1[J] = Arr2[I]) Then
                IsUnic := False;
        End;
        If(IsUnic) Then
            ResultArray[Size1 + I] := Arr2[I];
    End;

    ResultArray := RemoveZeros(ResultArray, ResultSize, IsFirst);
    ResultArray := SortArray(ResultArray);
End;

Procedure WriteSolveToFile(PathToFile : String; Arr : TArray);
Var
    T : TextFile;
Begin
    AssignFile(T, PathToFile);
    ReWrite(T);
    For Var I := 0 To High(Arr) Do
    Begin
        Write(T, Arr[I]);
        Write(T, ' ');
    End;
    Close(T);
End;

Function ChooseTheInput() : Integer;
Begin
    Write('Выберите ввод из консоли(1) или из файла(2): ');
    ChooseTheInput := InputInt(1, 2);
End;

Function ChooseTheOutput() : Integer;
Begin
    Write('Выберите вывод в консоль(1) или в файл(2): ');
    ChooseTheOutput := InputInt(1, 2);
End;

Procedure Input(Var Size1, Size2 : Integer; Var Array1, Array2 : TArray);
Var
    IntChooseTheInput : Integer;
    PathToFile : String;
Begin
    IntChooseTheInput := ChooseTheInput();
    If(IntChooseTheInput = 1) Then
    Begin
        Size1 := InputIntWithText('Введите количество элементов числовой последовательности', 1, 100);
        Array1 := InputIntArray('Введите члены числовой последовательности', size1, -10000, 10000);
        Size2 := InputIntWithText('Введите количество элементов числовой последовательности', 1, 100);
        Array2 := InputIntArray('Введите члены числовой последовательности', size2, -10000, 10000);
    End
    Else
    Begin
        GetFileNormalReading(PathtoFile);
        ReadFileSizeOfArray(PathToFile, Size1, Size2, 1, 100);
        ReadFileIntArray(PathToFile, Array1, Array2, Size1, Size2, -10000, 10000);
    End;
End;

procedure Output(Array3 : TArray);
Var
    IntChooseTheOutput : Integer;
    PathToFile : String;
Begin
    IntChooseTheOutput := ChooseTheOutput();
    If(IntChooseTheOutput = 1) Then
    Begin
        Write('Полученная числова последовательноть: ');
        For Var I := 0 To High(Array3) Do
            Write(Array3[I], ' ');
        Readln;
    End
    Else
    Begin
        GetFileNormalWriting(PathtoFile);
        Write('Полученная числова последовательноть: ');
        For Var I := 0 To High(Array3) Do
            Write(Array3[I], ' ');
        WriteSolveToFile(PathToFile, Array3);
    End;
    Readln;
End;


Var
    Size1, Size2, Size3 : Integer;
    Array1, Array2, Array3 : TArray;
Begin
    PrintTask();
    Input(Size1, Size2, Array1, Array2);
    Unification(Array1, Array2, Size1, Size2, Array3, Size3);
    Output(Array3);
End.