Задача на записи, Почти доделал но одну вещь незнаю как сделать Опции

[nblazhko]

Задачка такая: Написать программу,описывающую массив записей-телефонный справочник однокурсников-и обеспечивающую ввод данных, поиск фамилии по номеру телефона,и вывод абонентов по критерию "шахматы".В записи о каждом однокурснике содержатся следующие сведения:фамилия, имя,телефон, хобби.

Критерий шахматы это нужно подсчитать сколько людей с одинаковым хобби


Вот код:

Program Adress_Book;
uses
Crt;
type
    Adressitem = record
    Fio: String;
    Hob: String;
    Phone: LongInt;
    Email: String;
end;


var
   Book: Array [1..10] of Adressitem;
   hobbusovp:array[1..10] of string;
   Nums, I,Oh,k,mk: Byte;
   Code: Integer;
   ind:LongInt;
   C: Char;
   Quit: Boolean;
   StrNum,IntToStr:string;
   Phone1,Ph:LongInt;

Function Search(TelNum:LongInt):integer;
Var
 i:Integer;
 StrNum:String;
Begin
 Search:=-1;
 StrNum:=IntToStr;
 For i:=1 to 10 do
Begin
 If Book[i].Phone=Phone1 Then
  Begin
   Search:=i;
   Break;
  end;
 end;
end;




Procedure New_Item;
var
   F, A, Em: String;
   Ph: LongInt;
   begin
   ClrScr;
   Inc(Nums);
if Nums > 10 then
begin
     Write('MAx kol-vj zapisey!');
     exit;
end;

Writeln('Zapis N', Nums); Writeln;
Write('Vvedite FIO: ');
Readln(F);
Write('Vvedite Xobbu: ');
Readln(A);
Write('Vvedite telefon: ');
Readln(Ph);
Writeln;
with Book[Nums] do
begin
     Fio := F;
     Hob := A;
     Phone := Ph;
end;
Write('NEW Zapis dobavlena');
end;



Procedure List_Item(N: Byte);
begin
     if N > Nums then
     begin
          Write('Nevernui nomer');
          exit;
     end;

With Book[N] do
begin
     Writeln('Zapis N', N); Writeln;
     Writeln('FIO: ', Fio);
     Writeln('Hobbu: ', Hob);
     Writeln('Telefon: ', Phone);
     Writeln;
end;
Readln;
end;

begin
     Quit := False;
     Nums := 0;
     for I:=1 to 10 do book[i].phone:=0;
     repeat
ClrScr;
       Writeln('Telefonnau kniga"');
       Writeln('==========================='); Writeln;
       Writeln('Zapisu: ');
       Writeln('--------------------');
       if Nums = 0 then Writeln('Zapisey net') else
       For I := 1 to Nums do
       Writeln(I, ' - FIO: ', Book[I].Fio);
       Writeln('--------------------'); Writeln; Writeln;
       Writeln('''a'' - Dobavit zapis');
       WriteLn ('''b'' - Poisk zapisu');
       WriteLn ('''h'' - Sovpadeniya');
       Writeln('Nomer - pokazat zapis');
       Writeln('Esc - Exit');



       Writeln;
       Write('Vash vibor: ');
       C := ReadKey;
       case C of
       '1'..'9': begin
       Val(C, I, Code);
       List_Item(I);
end;
'a': New_Item;
'h': begin
If Nums<=0 then begin
 writeln('Zapisey net'); readln; end
  else
begin
     Oh:=0;
     for k:=1 to Nums do begin
     for i:=1 to Nums do begin
     if book[k].hob=book[i].Hob then
        begin
             oh:=oh+1;
             mk:=i;
        end;

end;

if k<>mk then
begin
  Writeln('Odinakovuh hobbu:',Oh);
  Readln;
  Oh:=0;
end;
 end;
 end;
 end;

'b': begin
Write ('Vvedite tel.:  ');
ReadLn(Phone1);
Ph:=Search(Phone1);
If Ph <> -1 then
List_Item(Search(Phone1));
End;
#27: Quit := true;
end;
until Quit;

end.

И я не могу сделать чтоб она находила людей с одинаковым хобби

я попробывал использовать вот такую конструкцию:

 begin
If Nums<=0 then begin
 writeln('Zapisey net'); readln; end
  else
begin
     Oh:=0;
     for k:=1 to Nums do begin
     for i:=1 to Nums do begin
     if book[k].hob=book[i].Hob then
        begin
             oh:=oh+1;
             mk:=i;
        end;

end;

if k<>mk then
begin
  Writeln('Odinakovuh hobbu:',Oh);
  Readln;
  Oh:=0;
end;
 end;
 end;
 end;