Правила форума
Прочтите прежде чем задавать вопрос!
Спойлер (Показать/Скрыть)
Файл, содержащий сведения о животных зоопарка:
– Имя,
– Название,
– Номер вольера (клетки),
– Имя родителя.
Построить для каждого животного дерево потомков.
Программа должна выполнять следующие операции обработки данных: ввод новых данных, поиск данных по заданному значению, сортировка данных, редактирование данных. Также программа должна обеспечивать диалог с помощью меню и контроль ошибок при вводе.
– Имя,
– Название,
– Номер вольера (клетки),
– Имя родителя.
Построить для каждого животного дерево потомков.
Программа должна выполнять следующие операции обработки данных: ввод новых данных, поиск данных по заданному значению, сортировка данных, редактирование данных. Также программа должна обеспечивать диалог с помощью меню и контроль ошибок при вводе.
Нужна помощь в построение для каждого жтвотного дерева потомков.
Личтинг программы:
Спойлер (Показать/Скрыть)
program kursovaya;
uses crt;
type tinf=record
imya,nazv,nom,imyarod:string;
end;
list=^Tlist;
Tlist=record
data:Tinf;
next:List;
end;
var znom:tinf;
zn:string;
spis:list;
str:string;
I,j:integer;
ch:char;
f,g:text;
procedure addelem(var spis1:list;znom1:Tinf);
var
tmp:list;
begin
if spis1=nil then
begin
getmem(spis1,sizeof(Tlist));
tmp:=spis1;
end
else
begin
tmp:=spis1;
while tmp^.next<>nil do
tmp:=tmp^.next;
getmem(tmp^.next,sizeof(tlist));
tmp:=tmp^.next;
end;
tmp^.next:=nil;
tmp^.data:=znom1;
end;
procedure files(var spis1:list);
var tmp:list;
begin
if spis1=nil then begin writeln('spisok pyst');
exit;
end
else
tmp:=spis1;
while tmp<>nil do
begin
writeln(g,tmp^.data.imya,' ',tmp^.data.nazv,' ',tmp^.data.nom,' ',tmp^.data.imyarod);
tmp:=tmp^.next;
end;
end;
procedure vivod(spis1:list);
begin
writeln;
if spis1=nil then
begin
writeln('spisok pyst');
exit;
end;
while spis1<>nil do
begin
writeln(spis1^.data.imya,' ',spis1^.data.nazv,' ',spis1^.data.nom,' ',spis1^.data.imyarod);
spis1:=spis1^.next;
end;
writeln;
end;
procedure freestek(spis1:list);
var
tmp:list;
begin
while spis1<>nil do
begin
tmp:=spis1;
spis1:=spis1^.next;
freemem(tmp,sizeof(tList));
end;
end;
procedure poisk(spis1:list;znom1:string);
begin
while (spis1<>nil) do begin
if spis1^.data.imya=znom1 then
writeln(spis1^.data.imya,' ',spis1^.data.nazv,' ',spis1^.data.nom,' ',spis1^.data.imyarod);
spis1:=spis1^.next;
end;
writeln;
end;
procedure delelem(var spis1:list;tmp:list);
var
tmpi:list;
begin
if (spis1=nil) or (tmp=nil) then exit;
if tmp=spis1 then
begin
spis1:=tmp^.next;
freemem(tmp,sizeof(Tlist));
end
else
begin
tmpi:=spis1;
while tmpi^.next<>tmp do
tmpi:=tmpi^.next;
tmpi^.next:=tmp^.next;
freemem(tmp,sizeof(Tlist));
end;
end;
procedure delete(var spis1:list;posi:integer);
var i:integer; tmp:list;
begin
if posi<1 then
exit;
if spis1=nil then
begin
writeln('spisok pyst');
exit
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i)
end;
delelem(spis1,tmp);
end;
procedure sortirovka(nom:list);
var
tmp,rab:list;
tmps:tinf;
begin
getmem(tmp,sizeof(Tlist));
rab:=nom;
while rab<>nil do
begin
tmp:=rab^.next;
while tmp<>nil do
begin
if tmp^.data.imya<rab^.data.imya then
begin
tmps:=tmp^.data;
tmp^.data:=rab^.data;
rab^.data:=tmps;
end;
tmp:=tmp^.next
end;
rab:=rab^.next
end;
end;
procedure rednazv(var spis1:list;posi:integer);
var i:integer;
tmp:list;
st:string;
begin
if posi<1 then
exit;
if spis1=nil then
begin
write('spisok pyst');
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i);
end;
writeln('vvedite nazvanie');
readln(st);
tmp^.data.nazv:=st;
end;
procedure rednom(var spis1:list;posi:integer);
var i:integer;
tmp:list;
st:string;
begin
if posi<1 then
exit;
if spis1=nil then
begin
write('spisok pyst');
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i);
end;
writeln('vvedite nomer');
readln(st);
tmp^.data.nom:=st;
end;
procedure redimyarod(var spis1:list;posi:integer);
var i:integer;
tmp:list;
st:string;
begin
if posi<1 then
exit;
if spis1=nil then
begin
write('spisok pyst');
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i);
end;
writeln('vvedite imya roditelya');
readln(st);
tmp^.data.imyarod:=st;
end;
procedure redimya(var spis1:list;posi:integer);
var i:integer;
tmp:list;
st:string;
begin
if posi<1 then
exit;
if spis1=nil then
begin
write('spisok pyst');
end;
i:=1;
tmp:=spis1;
while (tmp<>nil) and (i<>posi) do
begin
tmp:=tmp^.next;
inc(i);
end;
writeln('vvedite imya');
readln(st);
tmp^.data.imya:=st;
end;
begin
spis:=nil;
clrscr;
assign(f,'D:\files.txt');
reset(f);
while not eof(f) do begin
readln(f,str);
znom.imya:=copy(str,1,6);
znom.nazv:=copy(str,8,4);
znom.nom:=copy(str,14,5);
znom.imyarod:=copy(str,19,2);
addelem(spis,znom);
end;
repeat
writeln('1-dobavlenie elementa');
writeln('2-vivod');
writeln('3-sortirovka');
writeln('4-clrscr');
writeln('5-poisk');
writeln('6-delete');
writeln('7-redaktirovanie');
writeln('8-zapisat v fail');
writeln('9-vihod');
readln(ch);
case ch of
'1':begin
writeln('vvedite imya');
readln(znom.imya);
writeln('vvedite nazvanie');
readln(znom.nazv);
writeln('vvedite nomer voliera');
readln(znom.nom);
writeln('vvedite imya roditelya');
readln(znom.imyarod);
addelem(spis,znom);
end;
'2':begin clrscr;
vivod(spis);
end;
'3':begin
sortirovka(spis);
end;
'4':begin clrscr;
end;
'5':begin
if spis=nil then
writeln('Spisok pyst')
else
begin
writeln('Vvedite imya');
readln(str);
poisk(spis,str);
end;
end;
'6':begin
writeln('vvedite nomer elementa kootoriy nado ydalit');
readln(i);
delete(spis,i);
end;
'7':begin
writeln('vvedite nomer elementa kotoriy hotite redaktirovat');
readln(i);
writeln('4to vi hotite redaktirovat? 1-imya,2-nazvanie,3-nomer voliera,4-imya roditelya');
readln(j);
case j of
1:begin
redimya(spis,i);
end;
2:begin rednazv(spis,i); end;
3:begin rednom(spis,i); end;
4:begin redimyarod(spis,i); end;
end;
end;
'8':begin assign(g,'D:\file2.txt');
rewrite(g);
files(spis);
writeln('Vvedite nazvanie faila v formate D:\***.txt');
readln(str);
rename(g,str);
close(g);
end;
end;
until ch='9';
close(f);
freestek(spis);
spis:=nil;
end.
