Гляньте пожалуйста что тут неправильно написано. Все данные вводятся, но при поиске, допустим, по фамилии, программа вновь возвращается в главное меню. При удалении аналогично.
program Phonebook; uses Crt; type Phone = record SurnameS : string[15]; NameS : string[15]; PhoneS : string[15]; AddressS: string[50]; end; var PhoneF : file of Phone; PhoneR : Phone; a : array[1..600] of Phone; procedure WritePhone; begin Assign(PhoneF,'phone.pas'); Reset(PhoneF); ClrScr; writeln('Все записи:'); writeln; while not Eof(PhoneF) do begin PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; read(PhoneF,PhoneR); writeln; write(PhoneR.SurnameS); write(' ',PhoneR.NameS); write('',PhoneR.PhoneS); write('',PhoneR.AddressS); end; Close(PhoneF); writeln; writeln; write('Нажмите любую клавишу...'); ReadKey; end; procedure AddPhone; begin Assign(PhoneF,'phone.pas'); Reset(PhoneF); while not Eof(PhoneF) do Read(PhoneF,PhoneR); PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; ClrScr; writeln('Добавление записи:'); writeln; Write('Введите Фамилию:'); readln(PhoneR.SurnameS); write('Введите Имя:'); readln(PhoneR.NameS); write('Введите номер телефона:'); readln(PhoneR.PhoneS); write('Введите адрес:'); readln(PhoneR.AddressS); write(PhoneF,PhoneR); Close(PhoneF); writeln; writeln('Запись успешно добавлена в базу!!!'); writeln; write('Нажмите любую клавишу...'); ReadKey; end; procedure DeletePhone; var temp : file of Phone; Nazv : string[15]; begin Assign(PhoneF,'phone.pas'); Reset(PhoneF); Assign(temp,'temp.pas'); Rewrite(temp); PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; ClrScr; writeln('Удаление записи:'); writeln; Write('Введите Фамилию:'); readln(Nazv); while not Eof(PhoneF) do begin Read(PhoneF,PhoneR); if PhoneR.SurnameS<>Nazv then Write(temp,PhoneR); end; Close(temp); Close(PhoneF); Erase(PhoneF); Rename(temp,'phone.pas'); writeln; writeln('Запись успешно удалена из базы!!!'); writeln; write('Нажмите любую клавишу...'); ReadKey; end; procedure EditPhone; var Nazv : string[15]; temp : file of Phone; begin Assign(PhoneF,'phone.pas'); Reset(PhoneF); Assign(temp,'temp.pas'); Rewrite(temp); PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; ClrScr; writeln('Редактирование записи:'); writeln; Write('Введите Фамилию, которую хотите изменить:'); readln(Nazv); while not Eof(PhoneF) do begin PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; Read(PhoneF,PhoneR); if PhoneR.SurnameS<>Nazv then Write(temp,PhoneR); end; writeln; write('Введите новую Фамилию:'); readln(PhoneR.SurnameS); write('Введите новое Имя:'); readln(PhoneR.NameS); write('Введите новый номер телефона:'); readln(PhoneR.PhoneS); write('Введите новый адрес:'); readln(PhoneR.AddressS); write(temp,PhoneR); Close(temp); Close(PhoneF); Erase(PhoneF); Rename(temp,'phone.pas'); writeln; writeln('Запись успешно изменена!!!'); writeln; write('Нажмите любую клавишу...'); ReadKey; end; procedure FindSurname; var Nazv : string[15]; k : integer; begin k:=0; Assign(PhoneF,'phone.pas'); Reset(PhoneF); ClrScr; writeln('Поиск записи по Фамилии:'); writeln; Write('Введите Фамилию:'); readln(Nazv); while not Eof(PhoneF) do begin PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; read(PhoneF,PhoneR); if PhoneR.SurnameS=Nazv then begin writeln; write(PhoneR.SurnameS); write(' ',PhoneR.NameS); write('',PhoneR.PhoneS); write('',PhoneR.AddressS); k:=k+1; end; end; Close(PhoneF); writeln; writeln; writeln('Поиск завершен, найдено записей: ',k); writeln; write('Нажмите любую клавишу...'); ReadKey; end; procedure FindPhone; var Nazv : string[15]; k : integer; begin k:=0; Assign(PhoneF,'phone.pas'); Reset(PhoneF); ClrScr; writeln('Поиск записи по номеру телефона:'); writeln; Write('Введите номер телефона:'); readln(Nazv); while not Eof(PhoneF) do begin PhoneR.SurnameS:=''; PhoneR.NameS:=''; PhoneR.PhoneS:=''; PhoneR.AddressS:=''; read(PhoneF,PhoneR); if PhoneR.PhoneS=Nazv then begin writeln; write(PhoneR.SurnameS); write(' ',PhoneR.NameS); write('',PhoneR.PhoneS); write('',PhoneR.AddressS); k:=k+1; end; end; Close(PhoneF); writeln; writeln; writeln('Поиск завершен, найдено записей: ',k); writeln; write('Нажмите любую клавишу...'); ReadKey; end; procedure SortSurname; var i,j,c: integer; tr: Phone; begin c:=0; Assign(PhoneF,'phone.pas'); Reset(PhoneF); ClrScr; writeln('Сортировка по Фамилии:'); writeln; while not Eof(PhoneF) do begin inc(c,1); read(PhoneF,a[c]); end; for i:=1 to c do for j:=1 to c-1 do begin if a[j].SurnameS>a[j+1].SurnameS then begin tr:=a[j+1]; a[j+1]:=a[j]; a[j]:=tr; end; end; for i:=1 to c do begin writeln; write(a[i].SurnameS); write(' ',a[i].NameS); write('',a[i].PhoneS); write('',a[i].AddressS); end; Close(PhoneF); writeln; writeln; write('Нажмите любую клавишу...'); ReadKey; end; procedure SortAddress; var i,j,c: integer; tr: Phone; begin c:=0; Assign(PhoneF,'phone.pas'); Reset(PhoneF); ClrScr; writeln('Сортировка по адресу:'); writeln; while not Eof(PhoneF) do begin inc(c,1); read(PhoneF,a[c]); end; for i:=1 to c do for j:=1 to c-1 do begin if a[j].AddressS>a[j+1].AddressS then begin tr:=a[j+1]; a[j+1]:=a[j]; a[j]:=tr; end; end; for i:=1 to c do begin writeln; write(a[i].SurnameS); write(' ',a[i].NameS); write('',a[i].PhoneS); write('',a[i].AddressS); end; Close(PhoneF); writeln; writeln; write('Нажмите любую клавишу...'); ReadKey; end; procedure SortPhone; var i,j,c: integer; tr: Phone; begin c:=0; Assign(PhoneF,'phone.pas'); Reset(PhoneF); ClrScr; writeln('Сортировка по адресу:'); writeln; while not Eof(PhoneF) do begin inc(c,1); read(PhoneF,a[c]); end; for i:=1 to c do for j:=1 to c-1 do begin if a[j].PhoneS>a[j+1].PhoneS then begin tr:=a[j+1]; a[j+1]:=a[j]; a[j]:=tr; end; end; for i:=1 to c do begin writeln; write(a[i].SurnameS); write(' ',a[i].NameS); write('',a[i].PhoneS); write('',a[i].AddressS); end; Close(PhoneF); writeln; writeln; write('Нажмите любую клавишу...'); ReadKey; end;
procedure SortType; var b: integer; begin repeat begin ClrScr; writeln('"Телефонный справочник" - меню сортировки'); writeln; writeln('1. Не сортировать'); writeln('2. Сортировать по Фамилии'); writeln('3. Сортировать по адресу'); writeln('4. Сортировать по номеру телефона'); writeln('----------------------------'); writeln('5. Возврат в главное меню'); writeln; write('Выберите пункт меню: '); readln(b); case b of 1 : WritePhone; 2 : SortSurname; 3 : SortAddress; 4 : SortPhone; end; end; until b=5; end; procedure PhoneMenu; var b: integer; begin repeat begin ClrScr; writeln('"Телефонный справочник" - Главное меню'); writeln; writeln('1. Показать все записи'); writeln('2. Добавить запись'); writeln('3. Удалить запись'); writeln('4. Редактировать запись'); writeln('5. Поиск по Фамилии'); writeln('6. Поиск по номеру телефона'); writeln('----------------------------'); writeln('7. Выход'); writeln; write('Выберите пункт меню: '); readln(b); case b of 1 : SortType; 2 : AddPhone; 3 : DeletePhone; 4 : EditPhone; 5 : FindSurname; 6 : FindPhone; end; end; until b=7; end; begin ClrScr; PhoneMenu; end.
Lapp
2.12.2010 3:12
М
Просьба выполнять правила! Правила Форума, п.4, и правила раздела Задачи, п.1
Переделай название, или тема будет закрыта!
and 1
4.12.2010 2:50
посмотрите кто-нибудь
Lapp
4.12.2010 4:31
Тема закрыта
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.