Лабораторная работа 2 АиСД

program Lab2_AISD;

uses
  System.SysUtils;

const
    SegmentCount = 10;
    MIN_PAGE_COUNT = 1;
    MAX_PAGE_COUNT = 10000;

type
    PTermListEl = ^TTermListEl;
    PPage = ^TPage;
    TTermListEl = record
        Term: String;
        SubtermList: PTermListEl;
        PagesList: PPage;
        NextTerm: PTermListEl;
    end;
    TPage = record
        Page: Integer;
        NextPage: PPage;
    end;
    TTermsArray = array of PTermListEl;

procedure AddSubterm(TermListPointer: PTermListEl; Term: String); forward;
procedure ProcessSubterm(Subterm: String; SubtermListElPointer: PTermListEl); forward;
procedure AddTerm(var TermArray: TTermsArray); forward;


function makeHash(HashString: String; BacketCount: Integer): Integer;
var
    I, Sum: Integer;
begin
    Sum := 0;
    for I := 1 to High(HashString) do
        Sum := Sum + Ord(HashString[I]);
    Result := Sum mod BacketCount;
end;

procedure HashTerm(var TermArray: TTermsArray; Term: String);
var
    Hash: Integer;
    NewTermPointer: PTermListEl;
begin
    Hash := makeHash(Term, Length(TermArray));
    if TermArray[Hash] <> nil then
    begin
        NewTermPointer := TermArray[Hash];
        while NewTermPointer^.NextTerm <> nil do
            NewTermPointer := NewTermPointer.NextTerm;
        New(NewTermPointer^.NextTerm);
        NewTermPointer^.NextTerm^.Term := Term;
        New(NewTermPointer^.NextTerm^.SubtermList);
        NewTermPointer^.NextTerm^.SubtermList^.NextTerm := nil;
        New(NewTermPointer^.NextTerm^.PagesList);
        NewTermPointer^.NextTerm^.PagesList^.NextPage := nil;
        NewTermPointer^.NextTerm^.NextTerm := nil;
    end
    else
    begin
        New(TermArray[Hash]);
        TermArray[Hash].Term := Term;
        New(TermArray[Hash].SubtermList);
        TermArray[Hash].SubtermList^.NextTerm := nil;
        New(TermArray[Hash].PagesList);
        TermArray[Hash].PagesList^.NextPage := nil;
        TermArray[Hash].NextTerm := nil;
    end;
end;

procedure MakeTermArray(var TermArray: TTermsArray);
var
    I: Integer;
begin
    SetLength(TermArray, SegmentCount);
    for I := 0 to High(TermArray) do
        TermArray[I] := nil;
end;

procedure OutputMainMenu;
begin
    Writeln('--------------------------------------------------------');
    Writeln('1. Просмотреть предметный указатель (по алфавиту)');
    Writeln('2. Просмотреть предметный указатель (отсортированный по номерам страниц)');
    Writeln('3. Добавить термин');
    Writeln('4. Редактировать термин');
    Writeln('5. Удалить термин');
    Writeln('6. Поиск терминов по подтермину');
    Writeln('7. Поиск подтермина по термину');
    Writeln('8. Выход');
    Writeln('--------------------------------------------------------');
    Writeln('Выберите желаемое действие:');
end;

procedure OutputEditTermMenu;
begin
    Writeln('--------------------------------------------------------');
    Writeln('1. Добавить подтермин');
    Writeln('2. Редактировать подтермин');
    Writeln('3. Удалить подтермин');
    Writeln('4. Добавить номер страницы');
    Writeln('5. Завершить');
    Writeln('--------------------------------------------------------');
    Writeln('Выберите желаемое действие:');
end;

function InputNum(Min, Max: Integer): Integer;
var
    Num: Integer;
    IsCorrect: Boolean;
begin
    repeat
        IsCorrect := True;
        try
            Readln(Num);
        except
            Writeln('Некорректный ввод! Попробуйте еще:');
            IsCorrect := False;
        end;
        if IsCorrect and ((Num < Min) or (Num > Max)) then
        begin
            Writeln('Некорректный ввод! Попробуйте еще:');
            IsCorrect := False;
        end;
    until IsCorrect;
    InputNum := Num;
end;

{Олег
    Никита
        Рустам
Блять
    Рустам}

procedure InsertElementInAlphabet(Header: PTermListEl; NewTermin : String; NewSubTermInList : PTermListEl; NewPageList : PPage);
var
    Curr, Temp: PTermListEl;
begin
    Curr := Header;
    while (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.Term <= NewTermin) do
        Curr := Curr^.NextTerm;

    New(Temp);
    Temp^.NextTerm := Curr^.NextTerm;
    Curr^.NextTerm := Temp;
    Temp^.Term := NewTermin;
    Temp^.SubTermList := NewSubTermInList;
    Temp^.PagesList := NewPageList;
end;

function InitializeList(): PTermListEl;
var
    Header: PTermListEl;
begin
    New(Header);
    Header^.NextTerm := nil;
    InitializeList := Header;
end;

function TurnArrayToSortedAlpabetList(TermArray : TTermsArray) : PTermListEl;
Var
    I : Integer;
    SortedList : PTermListEl;
    TempArray : TTermsArray;
Begin
    SortedList := InitializeList();
    TempArray := Copy(TermArray);
    for I := 0 to High(TempArray) do
        if TempArray[I] <> nil then
        Repeat
            InsertElementInAlphabet(SortedList, TempArray[I]^.Term, TempArray[I]^.SubTermList,TempArray[I]^.PagesList);
            TempArray[I] := TempArray[I].NextTerm;
        Until TempArray[I] = Nil;
    Result := SortedList;
End;

procedure OutputSubterm(Subterm: PTermListEl; Padding: String);
var
    PageList: PPage;
    Temp: PTermListEl;
begin
    if Subterm = nil then
        Exit
    else
    begin
        Write(Padding + Subterm^.Term + '| ');
        PageList := Subterm^.PagesList^.NextPage;
        while PageList <> nil do
        begin
            Write(PageList^.Page, ' ');
            PageList := PageList^.NextPage;
        end;
        Writeln;
        Temp := Subterm^.SubTermList;
        while Temp^.NextTerm <> nil do
        begin
            OutputSubterm(Temp^.NextTerm, Padding + '    ');
            Temp := Temp^.NextTerm;
        end;
    end;
end;

procedure OutputList(Header: PTermListEl);
var
    Term, Subterm: PTermListEl;
    PageList: PPage;
begin
    if Header^.NextTerm = nil then
        Writeln('Предметный указатель не заполнен!')
    else
    begin
        Writeln('ПРЕДМЕТНЫЙ УКАЗАТЕЛЬ');
        Term := Header^.NextTerm;
        repeat
            Writeln('----------------------------');
            Write(Term^.Term + '| ');
            PageList := Term^.PagesList^.NextPage;
            while PageList <> nil do
            begin
                Write(PageList^.Page, ' ');
                PageList := PageList^.NextPage;
            end;
            if (Term^.SubtermList^.NextTerm <> nil) then
            begin
                Writeln;
                Subterm := Term^.SubtermList^.NextTerm;
                while Subterm <> nil do
                begin
                    OutputSubterm(Subterm, '    ');
                    Subterm := Subterm^.NextTerm;
                end;
            end
            else
                Writeln;
            Writeln('----------------------------');
            Term := Term^.NextTerm;
        until Term = nil;
    end;
end;

procedure OutputListInAlphabet(TermArray : TTermsArray);
Var
    SortedList : PTermListEl;
Begin
    SortedList := TurnArrayToSortedAlpabetList(TermArray);
    OutputList(SortedList);
End;

function IsInTermsArray(var TermArray: TTermsArray; CheckedTerm: String): Boolean;
var
    IsInArray: Boolean;
    I: Integer;
    CheckedTermPointer: PTermListEl;
begin
    I := 0;
    IsInArray := False;
    while not IsInArray and (I <= High(TermArray)) do
    begin
        CheckedTermPointer := TermArray[makeHash(CheckedTerm, Length(TermArray))];
        while not IsInArray and (CheckedTermPointer <> nil) do
        begin
            IsInArray := CheckedTerm = CheckedTermPointer.Term;
            CheckedTermPointer := CheckedTermPointer.NextTerm;
        end;
        Inc(I);
    end;
    Result := IsInArray;
end;

procedure InsertElementByPage(Header: PTermListEl; NewTermin : String; NewSubTermInList : PTermListEl; NewPageList : PPage);
var
    Curr, Temp: PTermListEl;
begin
    Curr := Header;
    while (Curr^.NextTerm <> nil) and (Curr^.NextTerm^.PagesList^.NextPage^.Page <= NewPageList^.NextPage^.Page) do
        Curr := Curr^.NextTerm;

    New(Temp);
    Temp^.NextTerm := Curr^.NextTerm;
    Curr^.NextTerm := Temp;
    Temp^.Term := NewTermin;
    Temp^.SubTermList := NewSubTermInList;
    Temp^.PagesList := NewPageList;
end;

function TurnArrayToSorteByPageList(TermArray : TTermsArray) : PTermListEl;
Var
    I : Integer;
    SortedList : PTermListEl;
    TempArray : TTermsArray;
Begin
    SortedList := InitializeList();
    TempArray := Copy(TermArray);
    for I := 0 to High(TempArray) do
        if TempArray[I] <> nil then
            Repeat
                InsertElementByPage(SortedList, TempArray[I]^.Term, TempArray[I]^.SubTermList, TempArray[I]^.PagesList);
                TempArray[I] := TempArray[I]^.NextTerm;
            Until TempArray[I] = Nil ;
    Result := SortedList;
End;

procedure OutputListByPages(TermArray : TTermsArray);
Var
    SortedList : PTermListEl;
Begin
    SortedList := TurnArrayToSorteByPageList(TermArray);
    OutputList(SortedList);
End;

{procedure AddSubterm(var TermListElPointer: PTermListEl);
var
    Term: PTermListEl;
begin
    Writeln('Введите подтермин: ');
    Readln(Term);
end;}

procedure SearchTermBySubTerm(TermArray : TTermsArray; SubTermin : String);
Var
    I, Count : Integer;
    TempArray : TTermsArray;
    Curr : PTermListEL;
    CurrSub : PTermListEl;
Begin
    Count := 0;
    Writeln('Термины, связанные с данным подтермином :');
    TempArray := Copy(TermArray);
    for I := 0 to High(TempArray) do
        if TempArray[I] <> Nil then
            Repeat
                Curr := TempArray[I]^.SubtermList;
                while Curr^.NextTerm <> Nil do
                Begin
                    If Curr^.NextTerm^.Term = SubTermin then
                    Begin
                        Inc(Count);
                        Writeln(TempArray[I]^.Term);
                        Break;
                    End;
                    CurrSub := Curr^.NextTerm^.SubtermList;
                    while CurrSub^.NextTerm <> Nil do
                    Begin
                        if CurrSub^.NextTerm^.Term = SubTermin then
                        Begin
                            Inc(Count);
                            Writeln(TempArray[I]^.Term);
                            break;
                        End;
                        CurrSub := CurrSub^.NextTerm;
                    End;
                    Curr := Curr^.NextTerm;
                End;
                TempArray[I] := TempArray[I]^.NextTerm;
            Until TempArray[I] = Nil;
        if Count = 0 then
            Writeln('Нет терминов, связанных с даннымм подтермином!');
End;

procedure SearhSubTermByTerm(TermArray : TTermsArray; Termin : String);
Var
    Hash : Integer;
    TempArray : TTermsArray;
    Curr, CurrSub : PTermListEl;
Begin
    Hash := MakeHash(Termin, Length(TermArray));
    TempArray := Copy(TermArray);
    if TempArray[Hash] = Nil then
        Writeln('Данного термина не существует')
    Else
    Begin
        Writeln('Подтермины ', Termin,':');
        Repeat
            Curr := TempArray[Hash]^.SubtermList;
            if Curr^.NextTerm = Nil then
            Begin
                Writeln('У термина нет подтерминов');
                break;
            End;
            while (Curr^.NextTerm <> Nil) do
            Begin
                Writeln('  ' + Curr^.NextTerm^.Term);
                CurrSub := Curr^.NextTerm^.SubtermList;
                while (CurrSub^.NextTerm <> Nil)  do
                Begin
                    Writeln('    ' + CurrSub^.NextTerm^.Term);
                    CurrSub := CurrSub^.NextTerm;
                End;
                Curr := Curr^.NextTerm;
            End;
            TempArray[Hash] := TempArray[Hash]^.NextTerm;
        Until TempArray[Hash] = Nil ;
    End;
End;

function FindPointerToTerm(TermArray : TTermsArray; Term : String) : PTermListEl;
Var
    Hash : Integer;
    TempArray : TTermsArray;
    IsFinded : Boolean;
    Res : PTermListEl;
Begin
    IsFinded := False;
    Res := Nil;
    TempArray := Copy(TermArray);
    Hash := MakeHash(Term, Length(TempArray));
    if TempArray[Hash] = nil then
    Begin
        Writeln('Данного термина не существует');
        FindPointerToTerm := Res;
        Exit;
    End;
    Repeat
        if TempArray[Hash]^.Term = Term then
            Begin
                Res := TempArray[Hash];
                IsFinded := True;
            End;
        TempArray[Hash] := TempArray[Hash]^.NextTerm;
    Until (TempArray[Hash] = Nil) And (IsFinded);
    if Res = Nil then
        Writeln('Данного термина не существует');
    FindPointerToTerm := Res;
End;

function FindPointerToSubTerm(SubTermList : PTermListEl; Subterm : String) : PTermListEl;
Var
    Curr, Res : PTermListEl;
    IsFinded : Boolean;
Begin
    Curr := SubTermList;
    IsFinded := False;
    Res := Nil;
    while (Curr^.NextTerm <> Nil) And (Not IsFinded) do
    Begin
        if Curr^.NextTerm^.Term = Subterm then
        Begin
            IsFinded := True;
            Res := Curr^.NextTerm;
        End;
        Curr := Curr^.NextTerm;
    End;
    if Not IsFinded then
    Begin
        Writeln('Данного подтермина не существует');
        Res := Nil;
    End;
    FindPointerToSubTerm := Res;
End;

procedure AddInPageList(var PagesList: PPage; NewPage: Integer);
var
    Temp, LnkablePointer: PPage;
begin
    if PagesList <> nil then
    begin
        Temp := PagesList;
        while (Temp^.NextPage <> nil) and (Temp^.NextPage^.Page < NewPage) do
            Temp := Temp^.NextPage;
        LnkablePointer := Temp^.NextPage;
        New(Temp^.NextPage);
        Temp := Temp^.NextPage;
        Temp^.Page := NewPage;
        Temp^.NextPage := LnkablePointer;
    end
    else
    begin
        New(PagesList);
        PagesList^.Page := NewPage;
        PagesList^.NextPage := nil;
    end;
end;

function IsPageInList(PagesList: PPage; CheckedPage: Integer): Boolean;
var
    IsInList: Boolean;
begin
    IsInList := False;
    PagesList := PagesList^.NextPage;
    while PagesList <> nil do
    begin
        IsInList := PagesList^.Page = CheckedPage;
        PagesList := PagesList^.NextPage;
    end;
    Result := IsInList;
end;

procedure AddPage(var TermArray: TTermsArray; Term: String);
var
    Temp: PTermListEl;
    NewPage: Integer;
begin
    Writeln('Введите страницу: ');
    NewPage := InputNum(MIN_PAGE_COUNT, MAX_PAGE_COUNT);
    Temp := TermArray[makeHash(Term, Length(TermArray))];
    while Temp^.Term <> Term do
        Temp := Temp^.NextTerm;
    if not IsPageInList(Temp^.PagesList, NewPage) then
        AddInPageList(Temp^.PagesList, NewPage)
    else
        Writeln('Страница уже есть в списке, добавление невозможно.');
end;

function IsPage(TermArray: TTermsArray; Term: String): Boolean;
var
    IsPageInTerm: Boolean;
    Temp: PTermListEl;
begin
    Temp := TermArray[makeHash(Term, Length(TermArray))];
    while Temp^.Term <> Term do
        Temp := Temp^.NextTerm;
    IsPageInTerm := not (Temp^.PagesList^.NextPage = nil);
    IsPage := IsPageInTerm;
end;

function IsInSubtermList(TermListPointer : PTermListEl; Subterm : String) : Boolean;
Var
    Verdict : Boolean;
    Temp: PTermListEl;
Begin
    Verdict := False;
    Temp := TermListPointer^.SubtermList;
    While ((Temp^.NextTerm <> Nil) And (Not Verdict)) do
    Begin
        if (Temp^.NextTerm^.Term = Subterm) then
            Verdict := True;
        Temp := Temp^.NextTerm;
    End;
    IsInSubtermList := Verdict;
End;

procedure AddSubtermPage(PagesListPointer: PPage);
var
    NewPage: Integer;
begin
    Writeln('Введите страницу: ');
    NewPage := InputNum(MIN_PAGE_COUNT, MAX_PAGE_COUNT);
    if not IsPageInList(PagesListPointer, NewPage) then
        AddInPageList(PagesListPointer, NewPage)
    else
        Writeln('Страница уже есть в списке, добавление невозможно.');
end;

function IsSubtermPage(PagesListPointer: PPage; Term: String): Boolean;
var
    IsPageInTerm: Boolean;
begin
    IsPageInTerm := not (PagesListPointer^.NextPage = nil);
    IsSubtermPage := IsPageInTerm;
end;

function AddInList(TermListPointer : PTermListEl; Subterm : String) : PTermListEl;
Var
    Curr, Temp: PTermListEl;
Begin
    Curr := TermListPointer^.SubtermList;
    while (Curr^.NextTerm <> Nil) And (Curr^.NextTerm^.Term <= Subterm) do
        Curr := Curr^.NextTerm;
    New(Temp);
    Temp^.NextTerm := Curr^.NextTerm;
    Curr^.NextTerm := Temp;
    Temp^.Term := Subterm;
    New(Temp^.SubtermList);
    Temp^.SubtermList^.NextTerm := nil;
    New(Temp^.PagesList);
    Temp^.PagesList^.NextPage := nil;
    AddInList := Temp;

End;

procedure AddSubterm(TermListPointer: PTermListEl; Term: String);
var
    Subterm: String;
    Choice: Integer;
    NewListElPointer: PTermListel;
    IsPageBeenAdded : Boolean;
begin
    while TermListPointer^.Term <> Term do
        TermListPointer := TermListPointer^.NextTerm;
    Writeln('Введите подтермин: ');
    Readln(Subterm);
    if not IsInSubtermList(TermListPointer, Term) then
    begin
        NewListElPointer := AddInList(TermListPointer, Subterm);
        ProcessSubterm(Subterm, NewListElPointer);
    end
    else
        Writeln ('Ошибка добавления! Такой термин уже есть в алфавитном указателе.')
end;

procedure EditSubterm(SubTermPointer: PTermListEl; Subterm: String);
var
    TermPointer: PTermListEl;
begin
    Writeln('Введите подтермин, который хотите изменить:');
    Readln(Subterm);
    TermPointer := FindPointerToSubTerm(SubTermPointer, Subterm);
    if TermPointer <> nil then
        ProcessSubterm(Subterm, SubTermPointer);
end;

procedure DelSubterm(SubtermList: PTermListEl; Subterm: String);
var
    Temp, Temp2: PTermListEl;
begin
    Temp := FindpointerToSubterm(SubtermList, Subterm);
    if Temp <> nil then
    begin
        Temp2 := SubtermList;
        while Temp2^.NextTerm <> Temp do
            Temp2 := Temp2^.NextTerm;
        Temp2^.NextTerm := Temp2^.NextTerm^.NextTerm;
        Dispose(Temp);
    end
end;

procedure DeleteSubterm(SubtermList: PTermListEl);
var
    Subterm: String;
begin
    Writeln('Введите термин, который хотите удалить:');
    Readln(Subterm);
    if FindPointerToSubterm(SubtermList, Subterm) <> nil then
        DelSubterm(SubtermList, Subterm);
end;

procedure ProcessSubterm(Subterm: String; SubtermListElPointer: PTermListEl);
var
    Choice: Integer;
    IsPageBeenAdded: Boolean;
begin
    repeat
        Writeln('--------------------------------------------------------');
        Writeln('РЕДАКТОР ПОДТЕРМИНА ' + Subterm);
        OutputEditTermMenu;
        Choice := InputNum(1, 5);
        case Choice of
            1: AddSubterm(SubtermListElPointer, Subterm);
            2: EditSubterm(SubtermListElPointer^.NextTerm^.SubtermList, Subterm);
            3: DeleteSubterm(SubtermListElPointer^.NextTerm^.SubtermList);
            4: AddSubtermPage(SubtermListElPointer^.PagesList);
            5:;
        end;
        IsPageBeenAdded := IsSubtermPage(SubtermListElPointer^.PagesList, Subterm);
        if (not IsPageBeenAdded) And (Choice = 5) then
                Writeln('Ошибка! Подтермин не может быть добавлен без страниц.');
    until (Choice = 5);
end;

procedure ProcessTerm(Term: String; TermArray: TTermsArray);
var
    Choice: Integer;
begin
    repeat
        Writeln('--------------------------------------------------------');
        Writeln('РЕДАКТОР ТЕРМИНА ' + Term);
        OutputEditTermMenu;
        Choice := InputNum(1, 5);
        case Choice of
            1: AddSubterm(TermArray[MakeHash(Term, Length(TermArray))], Term);
            2: EditSubterm(TermArray[MakeHash(Term, Length(TermArray))]^.SubtermList, Term);
            3: DeleteSubterm(TermArray[MakeHash(Term, Length(TermArray))]^.SubtermList);
            4: AddPage(TermArray, Term);
            5:;
        end;
    until (Choice = 5);
end;

procedure AddTerm(var TermArray: TTermsArray);
var
    Term: String;
    IsPageBeenAdded : Boolean;
    NewTerm : PTermListEl;
    Choice: Integer;
begin
    IsPageBeenAdded := False;
    Writeln('Введите термин: ');
    Readln(Term);
    if not IsInTermsArray(TermArray, Term) then
    begin
        HashTerm(TermArray, Term);
        repeat
            Writeln('--------------------------------------------------------');
            Writeln('РЕДАКТОР ТЕРМИНА ' + Term);
            OutputEditTermMenu;
            Choice := InputNum(1, 6);
            case Choice of
                1: AddSubterm(TermArray[MakeHash(Term, Length(TermArray))], Term);
                2: EditSubterm(TermArray[MakeHash(Term, Length(TermArray))]^.SubtermList, Term);
                3: DeleteSubterm(TermArray[MakeHash(Term, Length(TermArray))]^.SubtermList);
                4: AddPage(TermArray, Term);
                5:;
            end;
            IsPageBeenAdded := IsPage(TermArray, Term);
            if (not IsPageBeenAdded) And (Choice = 5) then
                Writeln('Ошибка! Термин не может быть добавлен без страниц.');
        until (IsPageBeenAdded) And (Choice = 5);
    end
    else
        Writeln ('Ошибка добавления! Такой термин уже есть в алфавитном указателе.')
end;

procedure DeleteTerm(TermArray: TTermsArray; Term: String);
var
    Temp, Temp2: PTermListEl;
    Hash: Integer;
begin
    Temp := FindpointerToTerm(TermArray, Term);
    if Temp <> nil then
    begin
        Hash := makeHash(Term, Length(TermArray));
        if TermArray[Hash]^.Term = Term then
        begin
            Temp := TermArray[Hash];
            TermArray[Hash] := TermArray[Hash]^.NextTerm;
            Dispose(Temp);
        end
        else
        begin
            Temp := TermArray[Hash];
            while Temp^.NextTerm^.Term <> Term do
                Temp := Temp^.NextTerm;
            Temp2 := Temp^.NextTerm^.NextTerm;
            Dispose(Temp^.NextTerm);
            Temp^.NextTerm := Temp2;
        end;
    end
end;

procedure EditTerm(TermArray: TTermsArray);
var
    Term: String;
    TermPointer: PTermListEl;
begin
    Writeln('Введите термин, который хотите изменить:');
    Readln(Term);
    TermPointer := FindpointerToTerm(TermArray, Term);
    if TermPointer <> nil then
        ProcessTerm(Term, TermArray);
end;

procedure SearchByTerm(TermArray: TTermsArray);
var
    Term: String;
begin
    Writeln('Введите подтермин, по которому хотите производить поиск:');
    Readln(Term);
    SearchTermBySubTerm(TermArray, Term);
end;

procedure SearchBySuberm(TermArray: TTermsArray);
var
    Subterm: String;
begin
    Writeln('Введите термин, по которому хотите производить поиск:');
    Readln(Subterm);
    SearhSubTermByTerm(TermArray, Subterm);
end;

procedure DeleteTermAction(TermArray: TTermsArray);
var
    Term: String;
    TermPointer: PTermListEl;
begin
    Writeln('Введите термин, который хотите удалить:');
    Readln(Term);
    TermPointer := FindPointerToTerm(TermArray, Term);
    if TermPointer <> nil then
        DeleteTerm(TermArray, Term);
end;

var
    TermArray: TTermsArray;
    I, Choice: Integer;
    TermName: String;
begin
    MakeTermArray(TermArray);
    Writeln('Данная программа - предметный указатель');
    repeat
        OutputMainMenu;
        Choice := InputNum(1, 8);
        case Choice of
            1: OutputListInAlphabet(TermArray);
            2: OutputListByPages(TermArray);
            3: AddTerm(TermArray);
            4: EditTerm(TermArray);
            5: DeleteTermAction(TermArray);
            6: SearchByTerm(TermArray);
            7: SearchBySuberm(TermArray);
            8:;
        end;
    until Choice = 8;
end.