Program kursovik (Двунаправленный динамический список)
Описание файла
Документ из архива "Двунаправленный динамический список", который расположен в категории "". Всё это находится в предмете "информатика" из , которые можно найти в файловом архиве . Не смотря на прямую связь этого архива с , его также можно найти и в других разделах. Архив можно найти в разделе "рефераты, доклады и презентации", в предмете "информатика, программирование" в общих файлах.
Онлайн просмотр документа "Program kursovik"
Текст из документа "Program kursovik"
Листинг программного изделия на языке программирования “Pascal”.
Program kursovik;
uses crt;
type Ukazat=^Inform;
Inform=record fam:string[15];
name:string[15];
fanem:string[15];
bethday:string[21];
zodiak:string[8];
next:Ukazat;
prev:Ukazat;
end;
var temp,first,cut:Ukazat;
ch:char;
s1,s2:string;
n:integer;
m:boolean;
ffam,fname,ffanem:string[10];
Procedure Dobav;
begin
ClrScr;
new(temp);
write('Введите фамилию: ');
readln(temp^.fam);
write('Введите имя: ');
readln(temp^.name);
write('Введите отчество: ');
readln(temp^.fanem);
write('Введите дату рождения: ');
readln(temp^.bethday);
n:=1;
s2:=copy(temp^.bethday,n,1);
while ((s2'9')) and (n<10) do
begin
inc(n);
s2:=copy(temp^.bethday,n,1);
end;
inc(n);
s1:=copy(temp^.bethday,n,1);
if (s1>='0') and (s1<='9') then s2:=s2+s1
else s2:='0'+s2;
while ((s1'я')) and (n<10) do
begin
inc(n);
s1:=copy(temp^.bethday,n,1);
end;
s1:=copy(temp^.bethday,n,3);
temp^.zodiak:=' ';
if s1='апр' then
if s2<'21' then temp^.zodiak:='овен'
else temp^.zodiak:='телец';
if s1='мая' then
if s2<'21' then temp^.zodiak:='телец'
else temp^.zodiak:='близнецы';
if s1='июн' then
if s2<'22' then temp^.zodiak:='близнецы'
else temp^.zodiak:='рак';
if s1='июл' then
if s2<'23' then temp^.zodiak:='рак'
else temp^.zodiak:='лев';
if s1='авг' then
if s2<'24' then temp^.zodiak:='лев'
else temp^.zodiak:='дева';
if s1='сен' then
if s2<'24' then temp^.zodiak:='дева'
else temp^.zodiak:='весы';
if s1='окт' then
if s2<'24' then temp^.zodiak:='весы'
else temp^.zodiak:='скорпион';
if s1='ноя' then
if s2<'23' then temp^.zodiak:='скорпион'
else temp^.zodiak:='стрелец';
if s1='дек' then
if s2<'22' then temp^.zodiak:='стрелец'
else temp^.zodiak:='козерог';
if s1='янв' then
if s2<'21' then temp^.zodiak:='козерог'
else temp^.zodiak:='водолей';
if s1='фев'
then if s2<'21' then temp^.zodiak:='водолей'
else temp^.zodiak:='рыбы';
if s1='мар'
then if s2<'21' then temp^.zodiak:='рыбы'
else temp^.zodiak:='овен';
if first=nil then
begin
temp^.prev:=nil;
temp^.next:=nil;
first:=temp;
cut:=temp;
end
else begin
temp^.next:=nil;
temp^.prev:=cut;
cut^.next:=temp;
cut:=temp;
end;
end;{procedure}
Procedure Udal;
begin
ClrScr;
{1}if first=nil then
begin
writeln('Таблица пуста');
readln;
end
else
begin {else1}
write('Введите фамилию: ');
readln(ffam);
write('Введите имя: ');
readln(fname);
write('Введите отчество: ');
readln(ffanem);
temp:=first;
while ((ffam<>temp^.fam) or (fname<>temp^.name) or
(ffanem<>temp^.fanem)) and (temp<>nil) do
temp:=temp^.next;
{2}if temp=nil then
begin
write('Такого нет');
readln;
end
else
begin{else2}
{3}if first<>cut then
{4}if temp^.prev=nil then
begin
temp^.next^.prev:=temp^.prev;
first:=temp^.next;
end
else{4}
{5}if temp^.next=nil then
begin
temp^.prev^.next:=temp^.next;
cut:=temp^.prev;
end
else begin{else5}
temp^.prev^.next:=temp^.next;
temp^.next^.prev:=temp^.prev;
end{else5}
else {3} first:=nil;
dispose(temp);
end;{else2}
end;{else1}
end;{procedure}
Procedure Prosm;
begin
ClrScr;
temp:=first;
writeln('Фамилия Имя Отчество':27, 'Дата рождения':27,'Знак зодиака':20);
write('________________________________________________________________');
if first<>nil then
begin
while temp<>nil do
begin
n:=length(temp^.fam)+length(temp^.name)+length(temp^.fanem);
writeln(temp^.fam,' ',temp^.name,' ',temp^.fanem,
temp^.bethday:55-n,temp^.zodiak:15);
temp:=temp^.next;
end;
end
else writeln('Таблица пуста':40);
readln;
end;
Procedure Sortir;
var
tmp:ukazat;
begin
ClrScr;
if first<>nil then
begin
m:=true;
{0}while m=true do
begin
m:=false;
temp:=first;
while temp^.next<>nil do
begin{1}
if (temp^.fam>temp^.next^.fam) or
(temp^.fam=temp^.next^.fam) and
(temp^.name>temp^.next^.name) or
(temp^.fam=temp^.next^.fam) and
(temp^.name=temp^.next^.name) and
(temp^.fanem=temp^.next^.fanem) then
begin{2}
m:=true;
if temp=first then
first:=temp^.next
else temp^.prev^.next:=temp^.next;
if temp^.next=cut then
begin
cut:=temp;
tmp:=nil;
end
else begin{3}
temp^.next^.next^.prev:=temp;
tmp:=temp^.next^.next;
end;{3}
temp^.next^.next:=temp;
temp^.next^.prev:=temp^.prev;
temp^.prev:=temp^.next;
temp^.next:=tmp;
end{2}
else temp:=temp^.next;
end;{1}
m:=false;
temp:=cut;
while temp^.prev<>nil do
begin{2.1}
if (temp^.fam (temp^.fam=temp^.prev^.fam) and (temp^.name (temp^.fam=temp^.prev^.fam) and (temp^.name=temp^.prev^.name) and (temp^.fanem begin{2.2} m:=true; if temp=cut then cut:=temp^.prev else temp^.next^.prev:=temp^.prev; if temp^.prev=first then begin first:=temp; tmp:=nil; end else begin{2.3} temp^.prev^.prev^.next:=temp; tmp:=temp^.prev^.prev; end;{2.3} temp^.prev^.prev:=temp; temp^.prev^.next:=temp^.next; temp^.next:=temp^.prev; temp^.prev:=tmp; end{2.2} else temp:=temp^.prev; end;{2.1} end;{0} end else begin writeln('Таблица пуста'); readln; end; end; begin first:=nil; repeat ClrScr; writeln('Выберите действие:'); writeln('1-Добавить'); writeln('2-Удалить'); writeln('3-Просмотреть'); writeln('4-Сортировать'); writeln('0-Выход'); readln(ch); case ch of '1':Dobav; '2':Udal; '3':Prosm; '4':Sortir; end; until ch='0'; end.
