2.19.3 Delphi

program Lab2193;

Uses
    System.SysUtils;

Type
    TArray = Array Of Double;

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 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;
    N : Integer;
Begin
    Repeat
        IsCorrect := True;
        Try
            Readln(N);
        Except
           IsCorrect := False;
        End;
        If(Not IsCorrect) Or (N > Max) Or (N < Min) Then
        Begin
            IsCorrect := False;
            Writeln('Неверный ввод');
        End;
    Until IsCorrect;
    InputInt := N;
End;

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

Function InputArrayOfDouble(S: String; CountOfPoints : Integer; Var Points: TArray; Min, Max : Double) : TArray;
Var
    IsCorrect : Boolean;
    Counter, I : Integer;
Begin
    I := 0;
    Counter := 0;
    SetLength(Points, CountOfPoints*2);
    While(I < countOfPoints * 2 - 1) Do
    Begin
        Repeat
            Write(S,' x', I + 1 - Counter, ' от ', Min:2:1, ' до ', Max:2:1, ' : ');
            IsCorrect := True;
            Try
                Readln(Points[i]);
            Except
               IsCorrect := False;
            End;
            If(Not IsCorrect) Or (Points[I] > Max) Or (Points[I] < Min) Then
            Begin
                IsCorrect := False;
                Writeln('Неверный ввод');
            End;
        Until IsCorrect;
        Repeat
            Write(S,' y', I + 1 - Counter, ' от ', Min:2:1, ' до ', Max:2:1, ' : ');
            IsCorrect := True;
            Try
                Readln(Points[I + 1]);
            Except
               IsCorrect := False;
            End;
            If(Not IsCorrect) Or (Points[I + 1] > Max) Or (Points[I + 1] < Min) Then
            Begin
                IsCorrect := False;
                Writeln('Неверный ввод');
            End;
        Until IsCorrect;
        Counter := Counter + 1;
        I := I + 2;
    End;
    InputArrayOfDouble := Points;
End;

Function ReadFileInt(Var PathToFile : String; Min, Max : Integer) : Integer;
Var
    N : Integer;
    S : String;
    IsCorrect : Boolean;
    T : TextFile;
Begin
    AssignFile(T,PathToFile);
    Reset(T);
    IsCorrect := True;
    Try
        Readln(T, N);
    Except
        IsCorrect := False;
    End;
    If(Not IsCorrect) Or (N > Max) Or (N < Min) Then
    Begin
        IsCorrect := False;
        Writeln('Неверный ввод');
    End;
    CloseFile(T);
    ReadFileInt := N;
End;

Function ReadFileArrayOfDouble(Var PathToFile : String; CountOfPoints : Integer; Points : TArray; Min, Max : Double) : TArray;
Var
    N, I, First, Second : Integer;
    IsCorrect : Boolean;
    S : String;
    T : TextFile;
Begin
    I := 0;
    First := 0;
    Second := 1;
    SetLength(Points, CountOfPoints*2);
    AssignFile(T,PathToFile);
    Reset(T);
    Readln(T,S);
    While(I < countOfPoints * 2 - 1) Do
    Begin
        IsCorrect := True;
        Try
            Read(T, Points[I]);
        Except
           IsCorrect := False;
        End;
        If(Not IsCorrect) Or (Points[I] > Max) Or (Points[I] < Min) Then
        Begin
            IsCorrect := False;
            Writeln('Неверный ввод');
        End;

        IsCorrect := True;
        Try
            Readln(N, Points[I + 1]);
        Except
           IsCorrect := False;
        End;
        If(Not IsCorrect) Or (Points[I + 1] > Max) Or (Points[I + 1] < Min) Then
        Begin
            IsCorrect := False;
            Writeln('Неверный ввод');
        End;
        I := I + 2;
    End;
    CloseFile(T);
    ReadFileArrayOfDouble := Points;
End;

Function SolveTheProblem(Var CountOfPoints : Integer; Var Points : Array Of Double) : Integer;
Var
    MaxCountOfTriangles, I, J, K : Integer;
    X1, X2, Y1, Y2 : Double;
Begin
    MaxCountOfTriangles := CountOfPoints * (CountOfPoints - 1) * (CountOfPoints - 2) Div 6;
    I := 0;
    While (I < CountOfPoints * 2 - 1) Do
    Begin
        J := I + 2;
        While(J < CountOfPoints * 2 - 3) Do
        Begin
            X1 := Points[J] - Points[I];
            Y1 := Points[J + 1] - Points[I + 1];
            K := J + 1;
            While(K < CountOfPoints - 1) Do
            Begin
                X2 := Points[K] - Points[J];
                Y2 := Points[K + 1] - Points[J + 1];
                If (X1 * Y2 = X2 * Y1) Then
                    MaxCountOfTriangles := MaxCountOfTriangles - 1;
                K := K + 2;
            End;
            J := J + 2;
        End;
        I := I + 2;
    End;
    SolveTheProblem := MaxCountOfTriangles;
End;

Procedure WriteSolveToFile(Var PathToFile : String; N : Integer);
Var
    T : TextFile;
Begin
    AssignFile(T, PathToFile);
    ReWrite(T);
    Writeln(T, 'Количество возможных треугольников: ', N);
    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 CountOfPoints : Integer; Var Points : TArray);
Var
    IntChooseTheInput : Integer;
    PathToFile : String;
Begin
    IntChooseTheInput := ChooseTheInput();
    If(IntChooseTheInput = 1) Then
    Begin
        CountOfPoints := InputIntWithText('Введите количество точек',1, 10);

        InputArrayOfDouble('Введите координату координату', CountOfPoints, Points, -10.0, 10.0);
    End
    Else
    Begin
        GetFileNormalReading(PathToFile);
        CountOfPoints := ReadFileInt(PathToFile, 1, 10);
        ReadFileArrayOfDouble(PathToFile, CountOfPoints, Points, -10.0, 10.0);
    End;
End;

Procedure Output(Var CountOfPoints : Integer; Var Points : TArray);
Var
    IntChooseTheInput : Integer;
    PathToFile : String;
    T : TextFile;
Begin
    IntChooseTheInput := ChooseTheInput();
    If(IntChooseTheInput = 1) Then
    Begin
         Writeln('Количество возможных треугольников: ', SolveTheProblem(CountOfPoints, Points));
         Readln;
    End
    Else
    Begin
        GetFileNormalWriting(PathToFile);
        WriteSolveToFile(pathToFile, solveTheProblem(countOfPoints, points));
    End;
End;

Var CountOfPoints : Integer;
    Points : TArray;
Begin
    PrintTask();
    Input(CountOfPoints, Points);
    Output(CountOfPoints, Points);
End.