Правила форума
Прочтите прежде чем задавать вопрос!
Критерий шахматы это нужно подсчитать сколько людей с одинаковым хобби
Вот код:
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;
