Двунаправленный динамический список (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<'0') or (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<'А') or (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.


Случайные файлы

Файл
8623-1.rtf
133278.rtf
146411.doc
38570.rtf
115254.rtf




Чтобы не видеть здесь видео-рекламу достаточно стать зарегистрированным пользователем.
Чтобы не видеть никакую рекламу на сайте, нужно стать VIP-пользователем.
Это можно сделать совершенно бесплатно. Читайте подробности тут.